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-2023, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 SWI-Prolog Solutions b.v. 10 All rights reserved. 11 12 Redistribution and use in source and binary forms, with or without 13 modification, are permitted provided that the following conditions 14 are met: 15 16 1. Redistributions of source code must retain the above copyright 17 notice, this list of conditions and the following disclaimer. 18 19 2. Redistributions in binary form must reproduce the above copyright 20 notice, this list of conditions and the following disclaimer in 21 the documentation and/or other materials provided with the 22 distribution. 23 24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 27 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 28 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 29 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 30 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 31 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 32 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 33 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 34 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 35 POSSIBILITY OF SUCH DAMAGE. 36*/ 37 38:- module(prolog_xref, 39 [ xref_source/1, % +Source 40 xref_source/2, % +Source, +Options 41 xref_called/3, % ?Source, ?Callable, ?By 42 xref_called/4, % ?Source, ?Callable, ?By, ?Cond 43 xref_called/5, % ?Source, ?Callable, ?By, ?Cond, ?Line 44 xref_defined/3, % ?Source. ?Callable, -How 45 xref_definition_line/2, % +How, -Line 46 xref_exported/2, % ?Source, ?Callable 47 xref_module/2, % ?Source, ?Module 48 xref_uses_file/3, % ?Source, ?Spec, ?Path 49 xref_op/2, % ?Source, ?Op 50 xref_prolog_flag/4, % ?Source, ?Flag, ?Value, ?Line 51 xref_comment/3, % ?Source, ?Title, ?Comment 52 xref_comment/4, % ?Source, ?Head, ?Summary, ?Comment 53 xref_mode/3, % ?Source, ?Mode, ?Det 54 xref_option/2, % ?Source, ?Option 55 xref_clean/1, % +Source 56 xref_current_source/1, % ?Source 57 xref_done/2, % +Source, -When 58 xref_built_in/1, % ?Callable 59 xref_source_file/3, % +Spec, -Path, +Source 60 xref_source_file/4, % +Spec, -Path, +Source, +Options 61 xref_public_list/3, % +File, +Src, +Options 62 xref_public_list/4, % +File, -Path, -Export, +Src 63 xref_public_list/6, % +File, -Path, -Module, -Export, -Meta, +Src 64 xref_public_list/7, % +File, -Path, -Module, -Export, -Public, -Meta, +Src 65 xref_meta/3, % +Source, +Goal, -Called 66 xref_meta/2, % +Goal, -Called 67 xref_hook/1, % ?Callable 68 % XPCE class references 69 xref_used_class/2, % ?Source, ?ClassName 70 xref_defined_class/3 % ?Source, ?ClassName, -How 71 ]). 72:- autoload(library(apply),[maplist/2,partition/4,maplist/3]). 73:- use_module(library(debug),[debug/3]). 74:- autoload(library(dialect),[expects_dialect/1]). 75:- autoload(library(error),[must_be/2,instantiation_error/1]). 76:- autoload(library(lists),[member/2,append/2,append/3,select/3]). 77:- autoload(library(modules),[in_temporary_module/3]). 78:- autoload(library(operators),[push_op/3]). 79:- autoload(library(option),[option/2,option/3]). 80:- autoload(library(ordsets),[ord_intersect/2,ord_intersection/3]). 81:- autoload(library(prolog_code), [pi_head/2]). 82:- autoload(library(prolog_source), 83 [ prolog_canonical_source/2, 84 prolog_open_source/2, 85 prolog_close_source/1, 86 prolog_read_source_term/4 87 ]). 88 89:- if(exists_source(library(shlib))). 90:- autoload(library(shlib),[current_foreign_library/2]). 91:- endif. 92:- autoload(library(solution_sequences),[distinct/2,limit/2]). 93 94:- if(exists_source(library(pldoc))). 95:- use_module(library(pldoc), []). % Must be loaded before doc_process 96:- use_module(library(pldoc/doc_process)). 97 98:- endif. 99 100:- predicate_options(xref_source/2, 2, 101 [ silent(boolean), 102 module(atom), 103 register_called(oneof([all,non_iso,non_built_in])), 104 comments(oneof([store,collect,ignore])), 105 process_include(boolean) 106 ]). 107 108 109:- dynamic 110 called/5, % Head, Src, From, Cond, Line 111 (dynamic)/3, % Head, Src, Line 112 (thread_local)/3, % Head, Src, Line 113 (multifile)/3, % Head, Src, Line 114 (public)/3, % Head, Src, Line 115 defined/3, % Head, Src, Line 116 meta_goal/3, % Head, Called, Src 117 foreign/3, % Head, Src, Line 118 constraint/3, % Head, Src, Line 119 imported/3, % Head, Src, From 120 exported/2, % Head, Src 121 xmodule/2, % Module, Src 122 uses_file/3, % Spec, Src, Path 123 xop/2, % Src, Op 124 source/2, % Src, Time 125 used_class/2, % Name, Src 126 defined_class/5, % Name, Super, Summary, Src, Line 127 (mode)/2, % Mode, Src 128 xoption/2, % Src, Option 129 xflag/4, % Name, Value, Src, Line 130 grammar_rule/2, % Head, Src 131 module_comment/3, % Src, Title, Comment 132 pred_comment/4, % Head, Src, Summary, Comment 133 pred_comment_link/3, % Head, Src, HeadTo 134 pred_mode/3. % Head, Src, Det 135 136:- create_prolog_flag(xref, false, [type(boolean)]).
173:- predicate_options(xref_source_file/4, 4, 174 [ file_type(oneof([txt,prolog,directory])), 175 silent(boolean) 176 ]). 177:- predicate_options(xref_public_list/3, 3, 178 [ path(-atom), 179 module(-atom), 180 exports(-list(any)), 181 public(-list(any)), 182 meta(-list(any)), 183 silent(boolean) 184 ]). 185 186 187 /******************************* 188 * HOOKS * 189 *******************************/
216:- multifile 217 prolog:called_by/4, % +Goal, +Module, +Context, -Called 218 prolog:called_by/2, % +Goal, -Called 219 prolog:meta_goal/2, % +Goal, -Pattern 220 prolog:hook/1, % +Callable 221 prolog:generated_predicate/1, % :PI 222 prolog:no_autoload_module/1. % Module is not suitable for autoloading. 223 224:- meta_predicate 225 prolog:generated_predicate( ). 226 227:- dynamic 228 meta_goal/2. 229 230:- meta_predicate 231 process_predicates( , , ). 232 233 /******************************* 234 * BUILT-INS * 235 *******************************/
register_called
.243hide_called(Callable, Src) :- 244 xoption(Src, register_called(Which)), 245 !, 246 mode_hide_called(Which, Callable). 247hide_called(Callable, _) :- 248 mode_hide_called(non_built_in, Callable). 249 250mode_hide_called(all, _) :- !, fail. 251mode_hide_called(non_iso, _:Goal) :- 252 goal_name_arity(Goal, Name, Arity), 253 current_predicate(system:Name/Arity), 254 predicate_property(system:Goal, iso). 255mode_hide_called(non_built_in, _:Goal) :- 256 goal_name_arity(Goal, Name, Arity), 257 current_predicate(system:Name/Arity), 258 predicate_property(system:Goal, built_in). 259mode_hide_called(non_built_in, M:Goal) :- 260 goal_name_arity(Goal, Name, Arity), 261 current_predicate(M:Name/Arity), 262 predicate_property(M:Goal, built_in).
268system_predicate(Goal) :- 269 goal_name_arity(Goal, Name, Arity), 270 current_predicate(system:Name/Arity), % avoid autoloading 271 predicate_property(system:Goal, built_in), 272 !. 273 274 275 /******************************** 276 * TOPLEVEL * 277 ********************************/ 278 279verbose(Src) :- 280 \+ xoption(Src, silent(true)). 281 282:- thread_local 283 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
).311xref_source(Source) :- 312 xref_source(Source, []). 313 314xref_source(Source, Options) :- 315 prolog_canonical_source(Source, Src), 316 ( last_modified(Source, Modified) 317 -> ( source(Src, Modified) 318 -> true 319 ; xref_clean(Src), 320 assert(source(Src, Modified)), 321 do_xref(Src, Options) 322 ) 323 ; xref_clean(Src), 324 get_time(Now), 325 assert(source(Src, Now)), 326 do_xref(Src, Options) 327 ). 328 329do_xref(Src, Options) :- 330 must_be(list, Options), 331 setup_call_cleanup( 332 xref_setup(Src, In, Options, State), 333 collect(Src, Src, In, Options), 334 xref_cleanup(State)). 335 336last_modified(Source, Modified) :- 337 prolog:xref_source_time(Source, Modified), 338 !. 339last_modified(Source, Modified) :- 340 atom(Source), 341 \+ is_global_url(Source), 342 exists_file(Source), 343 time_file(Source, Modified). 344 345is_global_url(File) :- 346 sub_atom(File, B, _, _, '://'), 347 !, 348 B > 1, 349 sub_atom(File, 0, B, _, Scheme), 350 atom_codes(Scheme, Codes), 351 maplist(between(0'a, 0'z), Codes). 352 353xref_setup(Src, In, Options, state(In, Dialect, Xref, [SRef|HRefs])) :- 354 maplist(assert_option(Src), Options), 355 assert_default_options(Src), 356 current_prolog_flag(emulated_dialect, Dialect), 357 prolog_open_source(Src, In), 358 set_initial_mode(In, Options), 359 asserta(xref_input(Src, In), SRef), 360 set_xref(Xref), 361 ( verbose(Src) 362 -> HRefs = [] 363 ; asserta((user:thread_message_hook(_,Level,_) :- 364 hide_message(Level)), 365 Ref), 366 HRefs = [Ref] 367 ). 368 369hide_message(warning). 370hide_message(error). 371hide_message(informational). 372 373assert_option(_, Var) :- 374 var(Var), 375 !, 376 instantiation_error(Var). 377assert_option(Src, silent(Boolean)) :- 378 !, 379 must_be(boolean, Boolean), 380 assert(xoption(Src, silent(Boolean))). 381assert_option(Src, register_called(Which)) :- 382 !, 383 must_be(oneof([all,non_iso,non_built_in]), Which), 384 assert(xoption(Src, register_called(Which))). 385assert_option(Src, comments(CommentHandling)) :- 386 !, 387 must_be(oneof([store,collect,ignore]), CommentHandling), 388 assert(xoption(Src, comments(CommentHandling))). 389assert_option(Src, module(Module)) :- 390 !, 391 must_be(atom, Module), 392 assert(xoption(Src, module(Module))). 393assert_option(Src, process_include(Boolean)) :- 394 !, 395 must_be(boolean, Boolean), 396 assert(xoption(Src, process_include(Boolean))). 397 398assert_default_options(Src) :- 399 ( xref_option_default(Opt), 400 generalise_term(Opt, Gen), 401 ( xoption(Src, Gen) 402 -> true 403 ; assertz(xoption(Src, Opt)) 404 ), 405 fail 406 ; true 407 ). 408 409xref_option_default(silent(false)). 410xref_option_default(register_called(non_built_in)). 411xref_option_default(comments(collect)). 412xref_option_default(process_include(true)).
418xref_cleanup(state(In, Dialect, Xref, Refs)) :- 419 prolog_close_source(In), 420 set_prolog_flag(emulated_dialect, Dialect), 421 set_prolog_flag(xref, Xref), 422 maplist(erase, Refs). 423 424set_xref(Xref) :- 425 current_prolog_flag(xref, Xref), 426 set_prolog_flag(xref, true). 427 428:- meta_predicate 429 with_xref( ). 430 431with_xref(Goal) :- 432 current_prolog_flag(xref, Xref), 433 ( Xref == true 434 -> call(Goal) 435 ; setup_call_cleanup( 436 set_prolog_flag(xref, true), 437 Goal, 438 set_prolog_flag(xref, Xref)) 439 ).
449set_initial_mode(_Stream, Options) :- 450 option(module(Module), Options), 451 !, 452 '$set_source_module'(Module). 453set_initial_mode(Stream, _) :- 454 stream_property(Stream, file_name(Path)), 455 source_file_property(Path, load_context(M, _, Opts)), 456 !, 457 '$set_source_module'(M), 458 ( option(dialect(Dialect), Opts) 459 -> expects_dialect(Dialect) 460 ; true 461 ). 462set_initial_mode(_, _) :- 463 '$set_source_module'(user).
469xref_input_stream(Stream) :-
470 xref_input(_, Var),
471 !,
472 Stream = Var.
479xref_push_op(Src, P, T, N0) :- 480 '$current_source_module'(M0), 481 strip_module(M0:N0, M, N), 482 ( is_list(N), 483 N \== [] 484 -> maplist(push_op(Src, P, T, M), N) 485 ; push_op(Src, P, T, M, N) 486 ). 487 488push_op(Src, P, T, M0, N0) :- 489 strip_module(M0:N0, M, N), 490 Name = M:N, 491 valid_op(op(P,T,Name)), 492 push_op(P, T, Name), 493 assert_op(Src, op(P,T,Name)), 494 debug(xref(op), ':- ~w.', [op(P,T,Name)]). 495 496valid_op(op(P,T,M:N)) :- 497 atom(M), 498 valid_op_name(N), 499 integer(P), 500 between(0, 1200, P), 501 atom(T), 502 op_type(T). 503 504valid_op_name(N) :- 505 atom(N), 506 !. 507valid_op_name(N) :- 508 N == []. 509 510op_type(xf). 511op_type(yf). 512op_type(fx). 513op_type(fy). 514op_type(xfx). 515op_type(xfy). 516op_type(yfx).
522xref_set_prolog_flag(Flag, Value, Src, Line) :- 523 atom(Flag), 524 !, 525 assertz(xflag(Flag, Value, Src, Line)). 526xref_set_prolog_flag(_, _, _, _).
532xref_clean(Source) :- 533 prolog_canonical_source(Source, Src), 534 retractall(called(_, Src, _Origin, _Cond, _Line)), 535 retractall(dynamic(_, Src, Line)), 536 retractall(multifile(_, Src, Line)), 537 retractall(public(_, Src, Line)), 538 retractall(defined(_, Src, Line)), 539 retractall(meta_goal(_, _, Src)), 540 retractall(foreign(_, Src, Line)), 541 retractall(constraint(_, Src, Line)), 542 retractall(imported(_, Src, _From)), 543 retractall(exported(_, Src)), 544 retractall(uses_file(_, Src, _)), 545 retractall(xmodule(_, Src)), 546 retractall(xop(Src, _)), 547 retractall(grammar_rule(_, Src)), 548 retractall(xoption(Src, _)), 549 retractall(xflag(_Name, _Value, Src, Line)), 550 retractall(source(Src, _)), 551 retractall(used_class(_, Src)), 552 retractall(defined_class(_, _, _, Src, _)), 553 retractall(mode(_, Src)), 554 retractall(module_comment(Src, _, _)), 555 retractall(pred_comment(_, Src, _, _)), 556 retractall(pred_comment_link(_, Src, _)), 557 retractall(pred_mode(_, Src, _)). 558 559 560 /******************************* 561 * READ RESULTS * 562 *******************************/
568xref_current_source(Source) :-
569 source(Source, _Time).
576xref_done(Source, Time) :-
577 prolog_canonical_source(Source, Src),
578 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.
600xref_called(Source, Called, By) :- 601 xref_called(Source, Called, By, _). 602 603xref_called(Source, Called, By, Cond) :- 604 canonical_source(Source, Src), 605 distinct(Called-By, called(Called, Src, By, Cond, _)). 606 607xref_called(Source, Called, By, Cond, Line) :- 608 canonical_source(Source, Src), 609 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)
631xref_defined(Source, Called, How) :- 632 nonvar(Source), 633 !, 634 canonical_source(Source, Src), 635 xref_defined2(How, Src, Called). 636xref_defined(Source, Called, How) :- 637 xref_defined2(How, Src, Called), 638 canonical_source(Source, Src). 639 640xref_defined2(dynamic(Line), Src, Called) :- 641 dynamic(Called, Src, Line). 642xref_defined2(thread_local(Line), Src, Called) :- 643 thread_local(Called, Src, Line). 644xref_defined2(multifile(Line), Src, Called) :- 645 multifile(Called, Src, Line). 646xref_defined2(public(Line), Src, Called) :- 647 public(Called, Src, Line). 648xref_defined2(local(Line), Src, Called) :- 649 defined(Called, Src, Line). 650xref_defined2(foreign(Line), Src, Called) :- 651 foreign(Called, Src, Line). 652xref_defined2(constraint(Line), Src, Called) :- 653 constraint(Called, Src, Line). 654xref_defined2(imported(From), Src, Called) :- 655 imported(Called, Src, From). 656xref_defined2(dcg, Src, Called) :- 657 grammar_rule(Called, Src).
665xref_definition_line(local(Line), Line). 666xref_definition_line(dynamic(Line), Line). 667xref_definition_line(thread_local(Line), Line). 668xref_definition_line(multifile(Line), Line). 669xref_definition_line(public(Line), Line). 670xref_definition_line(constraint(Line), Line). 671xref_definition_line(foreign(Line), Line).
678xref_exported(Source, Called) :-
679 prolog_canonical_source(Source, Src),
680 exported(Called, Src).
686xref_module(Source, Module) :- 687 nonvar(Source), 688 !, 689 prolog_canonical_source(Source, Src), 690 xmodule(Module, Src). 691xref_module(Source, Module) :- 692 xmodule(Module, Src), 693 prolog_canonical_source(Source, Src).
703xref_uses_file(Source, Spec, Path) :-
704 prolog_canonical_source(Source, Src),
705 uses_file(Spec, Src, Path).
715xref_op(Source, Op) :-
716 prolog_canonical_source(Source, Src),
717 xop(Src, Op).
725xref_prolog_flag(Source, Flag, Value, Line) :- 726 prolog_canonical_source(Source, Src), 727 xflag(Flag, Value, Src, Line). 728 729xref_built_in(Head) :- 730 system_predicate(Head). 731 732xref_used_class(Source, Class) :- 733 prolog_canonical_source(Source, Src), 734 used_class(Class, Src). 735 736xref_defined_class(Source, Class, local(Line, Super, Summary)) :- 737 prolog_canonical_source(Source, Src), 738 defined_class(Class, Super, Summary, Src, Line), 739 integer(Line), 740 !. 741xref_defined_class(Source, Class, file(File)) :- 742 prolog_canonical_source(Source, Src), 743 defined_class(Class, _, _, Src, file(File)). 744 745:- thread_local 746 current_cond/1, 747 source_line/1, 748 current_test_unit/2. 749 750current_source_line(Line) :- 751 source_line(Var), 752 !, 753 Line = Var.
761collect(Src, File, In, Options) :- 762 ( Src == File 763 -> SrcSpec = Line 764 ; SrcSpec = (File:Line) 765 ), 766 ( current_prolog_flag(xref_store_comments, OldStore) 767 -> true 768 ; OldStore = false 769 ), 770 option(comments(CommentHandling), Options, collect), 771 ( CommentHandling == ignore 772 -> CommentOptions = [], 773 Comments = [] 774 ; CommentHandling == store 775 -> CommentOptions = [ process_comment(true) ], 776 Comments = [], 777 set_prolog_flag(xref_store_comments, true) 778 ; CommentOptions = [ comments(Comments) ] 779 ), 780 repeat, 781 catch(prolog_read_source_term( 782 In, Term, Expanded, 783 [ term_position(TermPos) 784 | CommentOptions 785 ]), 786 E, report_syntax_error(E, Src, [])), 787 update_condition(Term), 788 stream_position_data(line_count, TermPos, Line), 789 setup_call_cleanup( 790 asserta(source_line(SrcSpec), Ref), 791 catch(process(Expanded, Comments, Term, TermPos, Src, EOF), 792 E, print_message(error, E)), 793 erase(Ref)), 794 EOF == true, 795 !, 796 set_prolog_flag(xref_store_comments, OldStore). 797 798report_syntax_error(E, _, _) :- 799 fatal_error(E), 800 throw(E). 801report_syntax_error(_, _, Options) :- 802 option(silent(true), Options), 803 !, 804 fail. 805report_syntax_error(E, Src, _Options) :- 806 ( verbose(Src) 807 -> print_message(error, E) 808 ; true 809 ), 810 fail. 811 812fatal_error(time_limit_exceeded). 813fatal_error(error(resource_error(_),_)).
819update_condition((:-Directive)) :- 820 !, 821 update_cond(Directive). 822update_condition(_). 823 824update_cond(if(Cond)) :- 825 !, 826 asserta(current_cond(Cond)). 827update_cond(else) :- 828 retract(current_cond(C0)), 829 !, 830 assert(current_cond(\+C0)). 831update_cond(elif(Cond)) :- 832 retract(current_cond(C0)), 833 !, 834 assert(current_cond((\+C0,Cond))). 835update_cond(endif) :- 836 retract(current_cond(_)), 837 !. 838update_cond(_).
845current_condition(Condition) :- 846 \+ current_cond(_), 847 !, 848 Condition = true. 849current_condition(Condition) :- 850 findall(C, current_cond(C), List), 851 list_to_conj(List, Condition). 852 853list_to_conj([], true). 854list_to_conj([C], C) :- !. 855list_to_conj([H|T], (H,C)) :- 856 list_to_conj(T, C). 857 858 859 /******************************* 860 * PROCESS * 861 *******************************/
873process(Expanded, Comments, Term0, TermPos, Src, EOF) :- 874 is_list(Expanded), % term_expansion into list. 875 !, 876 ( member(Term, Expanded), 877 process(Term, Term0, Src), 878 Term == end_of_file 879 -> EOF = true 880 ; EOF = false 881 ), 882 xref_comments(Comments, TermPos, Src). 883process(end_of_file, _, _, _, _, true) :- 884 !. 885process(Term, Comments, Term0, TermPos, Src, false) :- 886 process(Term, Term0, Src), 887 xref_comments(Comments, TermPos, Src).
891process(_, Term0, _) :- 892 ignore_raw_term(Term0), 893 !. 894process(Head :- Body, Head0 --> _, Src) :- 895 pi_head(F/A, Head), 896 pi_head(F/A0, Head0), 897 A =:= A0 + 2, 898 !, 899 assert_grammar_rule(Src, Head), 900 process((Head :- Body), Src). 901process(Term, _Term0, Src) :- 902 process(Term, Src). 903 904ignore_raw_term((:- predicate_options(_,_,_))).
908process(Var, _) :- 909 var(Var), 910 !. % Warn? 911process(end_of_file, _) :- !. 912process((:- Directive), Src) :- 913 !, 914 process_directive(Directive, Src), 915 !. 916process((?- Directive), Src) :- 917 !, 918 process_directive(Directive, Src), 919 !. 920process((Head :- Body), Src) :- 921 !, 922 assert_defined(Src, Head), 923 process_body(Body, Head, Src). 924process((Left => Body), Src) :- 925 !, 926 ( nonvar(Left), 927 Left = (Head, Guard) 928 -> assert_defined(Src, Head), 929 process_body(Guard, Head, Src), 930 process_body(Body, Head, Src) 931 ; assert_defined(Src, Left), 932 process_body(Body, Left, Src) 933 ). 934process(?=>(Head, Body), Src) :- 935 !, 936 assert_defined(Src, Head), 937 process_body(Body, Head, Src). 938process('$source_location'(_File, _Line):Clause, Src) :- 939 !, 940 process(Clause, Src). 941process(Term, Src) :- 942 process_chr(Term, Src), 943 !. 944process(M:(Head :- Body), Src) :- 945 !, 946 process((M:Head :- M:Body), Src). 947process(Head, Src) :- 948 assert_defined(Src, Head). 949 950 951 /******************************* 952 * COMMENTS * 953 *******************************/
957xref_comments([], _Pos, _Src). 958:- if(current_predicate(parse_comment/3)). 959xref_comments([Pos-Comment|T], TermPos, Src) :- 960 ( Pos @> TermPos % comments inside term 961 -> true 962 ; stream_position_data(line_count, Pos, Line), 963 FilePos = Src:Line, 964 ( parse_comment(Comment, FilePos, Parsed) 965 -> assert_comments(Parsed, Src) 966 ; true 967 ), 968 xref_comments(T, TermPos, Src) 969 ). 970 971assert_comments([], _). 972assert_comments([H|T], Src) :- 973 assert_comment(H, Src), 974 assert_comments(T, Src). 975 976assert_comment(section(_Id, Title, Comment), Src) :- 977 assertz(module_comment(Src, Title, Comment)). 978assert_comment(predicate(PI, Summary, Comment), Src) :- 979 pi_to_head(PI, Src, Head), 980 assertz(pred_comment(Head, Src, Summary, Comment)). 981assert_comment(link(PI, PITo), Src) :- 982 pi_to_head(PI, Src, Head), 983 pi_to_head(PITo, Src, HeadTo), 984 assertz(pred_comment_link(Head, Src, HeadTo)). 985assert_comment(mode(Head, Det), Src) :- 986 assertz(pred_mode(Head, Src, Det)). 987 988pi_to_head(PI, Src, Head) :- 989 pi_to_head(PI, Head0), 990 ( Head0 = _:_ 991 -> strip_module(Head0, M, Plain), 992 ( xmodule(M, Src) 993 -> Head = Plain 994 ; Head = M:Plain 995 ) 996 ; Head = Head0 997 ). 998:- endif.
1004xref_comment(Source, Title, Comment) :-
1005 canonical_source(Source, Src),
1006 module_comment(Src, Title, Comment).
1012xref_comment(Source, Head, Summary, Comment) :-
1013 canonical_source(Source, Src),
1014 ( pred_comment(Head, Src, Summary, Comment)
1015 ; pred_comment_link(Head, Src, HeadTo),
1016 pred_comment(HeadTo, Src, Summary, Comment)
1017 ).
1024xref_mode(Source, Mode, Det) :-
1025 canonical_source(Source, Src),
1026 pred_mode(Mode, Src, Det).
1033xref_option(Source, Option) :- 1034 canonical_source(Source, Src), 1035 xoption(Src, Option). 1036 1037 1038 /******************************** 1039 * DIRECTIVES * 1040 ********************************/ 1041 1042process_directive(Var, _) :- 1043 var(Var), 1044 !. % error, but that isn't our business 1045process_directive(Dir, _Src) :- 1046 debug(xref(directive), 'Processing :- ~q', [Dir]), 1047 fail. 1048process_directive((A,B), Src) :- % TBD: what about other control 1049 !, 1050 process_directive(A, Src), % structures? 1051 process_directive(B, Src). 1052process_directive(List, Src) :- 1053 is_list(List), 1054 !, 1055 process_directive(consult(List), Src). 1056process_directive(use_module(File, Import), Src) :- 1057 process_use_module2(File, Import, Src, false). 1058process_directive(autoload(File, Import), Src) :- 1059 process_use_module2(File, Import, Src, false). 1060process_directive(require(Import), Src) :- 1061 process_requires(Import, Src). 1062process_directive(expects_dialect(Dialect), Src) :- 1063 process_directive(use_module(library(dialect/Dialect)), Src), 1064 expects_dialect(Dialect). 1065process_directive(reexport(File, Import), Src) :- 1066 process_use_module2(File, Import, Src, true). 1067process_directive(reexport(Modules), Src) :- 1068 process_use_module(Modules, Src, true). 1069process_directive(autoload(Modules), Src) :- 1070 process_use_module(Modules, Src, false). 1071process_directive(use_module(Modules), Src) :- 1072 process_use_module(Modules, Src, false). 1073process_directive(consult(Modules), Src) :- 1074 process_use_module(Modules, Src, false). 1075process_directive(ensure_loaded(Modules), Src) :- 1076 process_use_module(Modules, Src, false). 1077process_directive(load_files(Files, _Options), Src) :- 1078 process_use_module(Files, Src, false). 1079process_directive(include(Files), Src) :- 1080 process_include(Files, Src). 1081process_directive(dynamic(Dynamic), Src) :- 1082 process_predicates(assert_dynamic, Dynamic, Src). 1083process_directive(dynamic(Dynamic, _Options), Src) :- 1084 process_predicates(assert_dynamic, Dynamic, Src). 1085process_directive(thread_local(Dynamic), Src) :- 1086 process_predicates(assert_thread_local, Dynamic, Src). 1087process_directive(multifile(Dynamic), Src) :- 1088 process_predicates(assert_multifile, Dynamic, Src). 1089process_directive(public(Public), Src) :- 1090 process_predicates(assert_public, Public, Src). 1091process_directive(export(Export), Src) :- 1092 process_predicates(assert_export, Export, Src). 1093process_directive(import(Import), Src) :- 1094 process_import(Import, Src). 1095process_directive(module(Module, Export), Src) :- 1096 assert_module(Src, Module), 1097 assert_module_export(Src, Export). 1098process_directive(module(Module, Export, Import), Src) :- 1099 assert_module(Src, Module), 1100 assert_module_export(Src, Export), 1101 assert_module3(Import, Src). 1102process_directive(begin_tests(Unit, _Options), Src) :- 1103 enter_test_unit(Unit, Src). 1104process_directive(begin_tests(Unit), Src) :- 1105 enter_test_unit(Unit, Src). 1106process_directive(end_tests(Unit), Src) :- 1107 leave_test_unit(Unit, Src). 1108process_directive('$set_source_module'(system), Src) :- 1109 assert_module(Src, system). % hack for handling boot/init.pl 1110process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 1111 assert_defined_class(Src, Name, Meta, Super, Doc). 1112process_directive(pce_autoload(Name, From), Src) :- 1113 assert_defined_class(Src, Name, imported_from(From)). 1114 1115process_directive(op(P, A, N), Src) :- 1116 xref_push_op(Src, P, A, N). 1117process_directive(set_prolog_flag(Flag, Value), Src) :- 1118 ( Flag == character_escapes 1119 -> set_prolog_flag(character_escapes, Value) 1120 ; true 1121 ), 1122 current_source_line(Line), 1123 xref_set_prolog_flag(Flag, Value, Src, Line). 1124process_directive(style_check(X), _) :- 1125 style_check(X). 1126process_directive(encoding(Enc), _) :- 1127 ( xref_input_stream(Stream) 1128 -> catch(set_stream(Stream, encoding(Enc)), _, true) 1129 ; true % can this happen? 1130 ). 1131process_directive(pce_expansion:push_compile_operators, _) :- 1132 '$current_source_module'(SM), 1133 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 1134process_directive(pce_expansion:pop_compile_operators, _) :- 1135 call(pce_expansion:pop_compile_operators). 1136process_directive(meta_predicate(Meta), Src) :- 1137 process_meta_predicate(Meta, Src). 1138process_directive(arithmetic_function(FSpec), Src) :- 1139 arith_callable(FSpec, Goal), 1140 !, 1141 current_source_line(Line), 1142 assert_called(Src, '<directive>'(Line), Goal, Line). 1143process_directive(format_predicate(_, Goal), Src) :- 1144 !, 1145 current_source_line(Line), 1146 assert_called(Src, '<directive>'(Line), Goal, Line). 1147process_directive(if(Cond), Src) :- 1148 !, 1149 current_source_line(Line), 1150 assert_called(Src, '<directive>'(Line), Cond, Line). 1151process_directive(elif(Cond), Src) :- 1152 !, 1153 current_source_line(Line), 1154 assert_called(Src, '<directive>'(Line), Cond, Line). 1155process_directive(else, _) :- !. 1156process_directive(endif, _) :- !. 1157process_directive(Goal, Src) :- 1158 current_source_line(Line), 1159 process_body(Goal, '<directive>'(Line), Src).
1165process_meta_predicate((A,B), Src) :- 1166 !, 1167 process_meta_predicate(A, Src), 1168 process_meta_predicate(B, Src). 1169process_meta_predicate(Decl, Src) :- 1170 process_meta_head(Src, Decl). 1171 1172process_meta_head(Src, Decl) :- % swapped arguments for maplist 1173 compound(Decl), 1174 compound_name_arity(Decl, Name, Arity), 1175 compound_name_arity(Head, Name, Arity), 1176 meta_args(1, Arity, Decl, Head, Meta), 1177 ( ( prolog:meta_goal(Head, _) 1178 ; prolog:called_by(Head, _, _, _) 1179 ; prolog:called_by(Head, _) 1180 ; meta_goal(Head, _) 1181 ) 1182 -> true 1183 ; assert(meta_goal(Head, Meta, Src)) 1184 ). 1185 1186meta_args(I, Arity, _, _, []) :- 1187 I > Arity, 1188 !. 1189meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1190 arg(I, Decl, 0), 1191 !, 1192 arg(I, Head, H), 1193 I2 is I + 1, 1194 meta_args(I2, Arity, Decl, Head, T). 1195meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1196 arg(I, Decl, ^), 1197 !, 1198 arg(I, Head, EH), 1199 setof_goal(EH, H), 1200 I2 is I + 1, 1201 meta_args(I2, Arity, Decl, Head, T). 1202meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1203 arg(I, Decl, //), 1204 !, 1205 arg(I, Head, H), 1206 I2 is I + 1, 1207 meta_args(I2, Arity, Decl, Head, T). 1208meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1209 arg(I, Decl, A), 1210 integer(A), A > 0, 1211 !, 1212 arg(I, Head, H), 1213 I2 is I + 1, 1214 meta_args(I2, Arity, Decl, Head, T). 1215meta_args(I, Arity, Decl, Head, Meta) :- 1216 I2 is I + 1, 1217 meta_args(I2, Arity, Decl, Head, Meta). 1218 1219 1220 /******************************** 1221 * BODY * 1222 ********************************/
1231xref_meta(Source, Head, Called) :-
1232 canonical_source(Source, Src),
1233 xref_meta_src(Head, Called, Src).
1248xref_meta_src(Head, Called, Src) :- 1249 meta_goal(Head, Called, Src), 1250 !. 1251xref_meta_src(Head, Called, _) :- 1252 xref_meta(Head, Called), 1253 !. 1254xref_meta_src(Head, Called, _) :- 1255 compound(Head), 1256 compound_name_arity(Head, Name, Arity), 1257 apply_pred(Name), 1258 Arity > 5, 1259 !, 1260 Extra is Arity - 1, 1261 arg(1, Head, G), 1262 Called = [G+Extra]. 1263xref_meta_src(Head, Called, _) :- 1264 with_xref(predicate_property('$xref_tmp':Head, meta_predicate(Meta))), 1265 !, 1266 Meta =.. [_|Args], 1267 meta_args(Args, 1, Head, Called). 1268 1269meta_args([], _, _, []). 1270meta_args([H0|T0], I, Head, [H|T]) :- 1271 xargs(H0, N), 1272 !, 1273 arg(I, Head, A), 1274 ( N == 0 1275 -> H = A 1276 ; H = (A+N) 1277 ), 1278 I2 is I+1, 1279 meta_args(T0, I2, Head, T). 1280meta_args([_|T0], I, Head, T) :- 1281 I2 is I+1, 1282 meta_args(T0, I2, Head, T). 1283 1284xargs(N, N) :- integer(N), !. 1285xargs(//, 2). 1286xargs(^, 0). 1287 1288apply_pred(call). % built-in 1289apply_pred(maplist). % library(apply_macros) 1290 1291xref_meta((A, B), [A, B]). 1292xref_meta((A; B), [A, B]). 1293xref_meta((A| B), [A, B]). 1294xref_meta((A -> B), [A, B]). 1295xref_meta((A *-> B), [A, B]). 1296xref_meta(findall(_V,G,_L), [G]). 1297xref_meta(findall(_V,G,_L,_T), [G]). 1298xref_meta(findnsols(_N,_V,G,_L), [G]). 1299xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1300xref_meta(setof(_V, EG, _L), [G]) :- 1301 setof_goal(EG, G). 1302xref_meta(bagof(_V, EG, _L), [G]) :- 1303 setof_goal(EG, G). 1304xref_meta(forall(A, B), [A, B]). 1305xref_meta(maplist(G,_), [G+1]). 1306xref_meta(maplist(G,_,_), [G+2]). 1307xref_meta(maplist(G,_,_,_), [G+3]). 1308xref_meta(maplist(G,_,_,_,_), [G+4]). 1309xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1310xref_meta(map_assoc(G, _), [G+1]). 1311xref_meta(map_assoc(G, _, _), [G+2]). 1312xref_meta(checklist(G, _L), [G+1]). 1313xref_meta(sublist(G, _, _), [G+1]). 1314xref_meta(include(G, _, _), [G+1]). 1315xref_meta(exclude(G, _, _), [G+1]). 1316xref_meta(partition(G, _, _, _, _), [G+2]). 1317xref_meta(partition(G, _, _, _),[G+1]). 1318xref_meta(call(G), [G]). 1319xref_meta(call(G, _), [G+1]). 1320xref_meta(call(G, _, _), [G+2]). 1321xref_meta(call(G, _, _, _), [G+3]). 1322xref_meta(call(G, _, _, _, _), [G+4]). 1323xref_meta(not(G), [G]). 1324xref_meta(notrace(G), [G]). 1325xref_meta('$notrace'(G), [G]). 1326xref_meta(\+(G), [G]). 1327xref_meta(ignore(G), [G]). 1328xref_meta(once(G), [G]). 1329xref_meta(initialization(G), [G]). 1330xref_meta(initialization(G,_), [G]). 1331xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1332xref_meta(clause(G, _), [G]). 1333xref_meta(clause(G, _, _), [G]). 1334xref_meta(phrase(G, _A), [//(G)]). 1335xref_meta(phrase(G, _A, _R), [//(G)]). 1336xref_meta(call_dcg(G, _A, _R), [//(G)]). 1337xref_meta(phrase_from_file(G,_),[//(G)]). 1338xref_meta(catch(A, _, B), [A, B]). 1339xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1340xref_meta(thread_create(A,_,_), [A]). 1341xref_meta(thread_create(A,_), [A]). 1342xref_meta(thread_signal(_,A), [A]). 1343xref_meta(thread_idle(A,_), [A]). 1344xref_meta(thread_at_exit(A), [A]). 1345xref_meta(thread_initialization(A), [A]). 1346xref_meta(engine_create(_,A,_), [A]). 1347xref_meta(engine_create(_,A,_,_), [A]). 1348xref_meta(transaction(A), [A]). 1349xref_meta(transaction(A,B,_), [A,B]). 1350xref_meta(snapshot(A), [A]). 1351xref_meta(predsort(A,_,_), [A+3]). 1352xref_meta(call_cleanup(A, B), [A, B]). 1353xref_meta(call_cleanup(A, _, B),[A, B]). 1354xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1355xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1356xref_meta(call_residue_vars(A,_), [A]). 1357xref_meta(with_mutex(_,A), [A]). 1358xref_meta(assume(G), [G]). % library(debug) 1359xref_meta(assertion(G), [G]). % library(debug) 1360xref_meta(freeze(_, G), [G]). 1361xref_meta(when(C, A), [C, A]). 1362xref_meta(time(G), [G]). % development system 1363xref_meta(call_time(G, _), [G]). % development system 1364xref_meta(call_time(G, _, _), [G]). % development system 1365xref_meta(profile(G), [G]). 1366xref_meta(at_halt(G), [G]). 1367xref_meta(call_with_time_limit(_, G), [G]). 1368xref_meta(call_with_depth_limit(G, _, _), [G]). 1369xref_meta(call_with_inference_limit(G, _, _), [G]). 1370xref_meta(alarm(_, G, _), [G]). 1371xref_meta(alarm(_, G, _, _), [G]). 1372xref_meta('$add_directive_wic'(G), [G]). 1373xref_meta(with_output_to(_, G), [G]). 1374xref_meta(if(G), [G]). 1375xref_meta(elif(G), [G]). 1376xref_meta(meta_options(G,_,_), [G+1]). 1377xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1378xref_meta(distinct(G), [G]). % library(solution_sequences) 1379xref_meta(distinct(_, G), [G]). 1380xref_meta(order_by(_, G), [G]). 1381xref_meta(limit(_, G), [G]). 1382xref_meta(offset(_, G), [G]). 1383xref_meta(reset(G,_,_), [G]). 1384xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N). 1385xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N). 1386xref_meta(tnot(G), [G]). 1387xref_meta(not_exists(G), [G]). 1388xref_meta(with_tty_raw(G), [G]). 1389xref_meta(residual_goals(G), [G+2]). 1390 1391 % XPCE meta-predicates 1392xref_meta(pce_global(_, new(_)), _) :- !, fail. 1393xref_meta(pce_global(_, B), [B+1]). 1394xref_meta(ifmaintainer(G), [G]). % used in manual 1395xref_meta(listen(_, G), [G]). % library(broadcast) 1396xref_meta(listen(_, _, G), [G]). 1397xref_meta(in_pce_thread(G), [G]). 1398 1399xref_meta(G, Meta) :- % call user extensions 1400 prolog:meta_goal(G, Meta). 1401xref_meta(G, Meta) :- % Generated from :- meta_predicate 1402 meta_goal(G, Meta). 1403 1404setof_goal(EG, G) :- 1405 var(EG), !, G = EG. 1406setof_goal(_^EG, G) :- 1407 !, 1408 setof_goal(EG, G). 1409setof_goal(G, G). 1410 1411event_xargs(abort, 0). 1412event_xargs(erase, 1). 1413event_xargs(break, 3). 1414event_xargs(frame_finished, 1). 1415event_xargs(thread_exit, 1). 1416event_xargs(this_thread_exit, 0). 1417event_xargs(PI, 2) :- pi_to_head(PI, _).
1423head_of(Var, _) :- 1424 var(Var), !, fail. 1425head_of((Head :- _), Head). 1426head_of(Head, Head).
1434xref_hook(Hook) :- 1435 prolog:hook(Hook). 1436xref_hook(Hook) :- 1437 hook(Hook). 1438 1439 1440hook(attr_portray_hook(_,_)). 1441hook(attr_unify_hook(_,_)). 1442hook(attribute_goals(_,_,_)). 1443hook(goal_expansion(_,_)). 1444hook(term_expansion(_,_)). 1445hook(resource(_,_,_)). 1446hook('$pred_option'(_,_,_,_)). 1447 1448hook(emacs_prolog_colours:goal_classification(_,_)). 1449hook(emacs_prolog_colours:goal_colours(_,_)). 1450hook(emacs_prolog_colours:identify(_,_)). 1451hook(emacs_prolog_colours:style(_,_)). 1452hook(emacs_prolog_colours:term_colours(_,_)). 1453hook(pce_principal:get_implementation(_,_,_,_)). 1454hook(pce_principal:pce_class(_,_,_,_,_,_)). 1455hook(pce_principal:pce_lazy_get_method(_,_,_)). 1456hook(pce_principal:pce_lazy_send_method(_,_,_)). 1457hook(pce_principal:pce_uses_template(_,_)). 1458hook(pce_principal:send_implementation(_,_,_)). 1459hook(predicate_options:option_decl(_,_,_)). 1460hook(prolog:debug_control_hook(_)). 1461hook(prolog:error_message(_,_,_)). 1462hook(prolog:expand_answer(_,_,_)). 1463hook(prolog:general_exception(_,_)). 1464hook(prolog:help_hook(_)). 1465hook(prolog:locate_clauses(_,_)). 1466hook(prolog:message(_,_,_)). 1467hook(prolog:message_context(_,_,_)). 1468hook(prolog:message_line_element(_,_)). 1469hook(prolog:message_location(_,_,_)). 1470hook(prolog:predicate_summary(_,_)). 1471hook(prolog:prolog_exception_hook(_,_,_,_,_)). 1472hook(prolog:residual_goals(_,_)). 1473hook(prolog:show_profile_hook(_,_)). 1474hook(prolog_edit:load). 1475hook(prolog_edit:locate(_,_,_)). 1476hook(sandbox:safe_directive(_)). 1477hook(sandbox:safe_global_variable(_)). 1478hook(sandbox:safe_meta(_,_)). 1479hook(sandbox:safe_meta_predicate(_)). 1480hook(sandbox:safe_primitive(_)). 1481hook(sandbox:safe_prolog_flag(_,_)). 1482hook(shlib:unload_all_foreign_libraries). 1483hook(system:'$foreign_registered'(_, _)). 1484hook(user:exception(_,_,_)). 1485hook(user:expand_answer(_,_)). 1486hook(user:expand_query(_,_,_,_)). 1487hook(user:file_search_path(_,_)). 1488hook(user:library_directory(_)). 1489hook(user:message_hook(_,_,_)). 1490hook(user:portray(_)). 1491hook(user:prolog_clause_name(_,_)). 1492hook(user:prolog_list_goal(_)). 1493hook(user:prolog_predicate_name(_,_)). 1494hook(user:prolog_trace_interception(_,_,_,_)).
1500arith_callable(Var, _) :- 1501 var(Var), !, fail. 1502arith_callable(Module:Spec, Module:Goal) :- 1503 !, 1504 arith_callable(Spec, Goal). 1505arith_callable(Name/Arity, Goal) :- 1506 PredArity is Arity + 1, 1507 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1518process_body(Body, Origin, Src) :-
1519 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1520 true).
true
if there was a
partial evalation inside Goal that has bound variables.1527process_goal(Var, _, _, _) :- 1528 var(Var), 1529 !. 1530process_goal(_:Goal, _, _, _) :- 1531 var(Goal), 1532 !. 1533process_goal(Goal, Origin, Src, P) :- 1534 Goal = (_,_), % problems 1535 !, 1536 phrase(conjunction(Goal), Goals), 1537 process_conjunction(Goals, Origin, Src, P). 1538process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1539 Goal = (_;_), % problems 1540 !, 1541 phrase(disjunction(Goal), Goals), 1542 forall(member(G, Goals), 1543 process_body(G, Origin, Src)). 1544process_goal(Goal, Origin, Src, P) :- 1545 ( ( xmodule(M, Src) 1546 -> true 1547 ; M = user 1548 ), 1549 pi_head(PI, M:Goal), 1550 ( current_predicate(PI), 1551 predicate_property(M:Goal, imported_from(IM)) 1552 -> true 1553 ; PI = M:Name/Arity, 1554 '$find_library'(M, Name, Arity, IM, _Library) 1555 -> true 1556 ; IM = M 1557 ), 1558 prolog:called_by(Goal, IM, M, Called) 1559 ; prolog:called_by(Goal, Called) 1560 ), 1561 !, 1562 must_be(list, Called), 1563 current_source_line(Here), 1564 assert_called(Src, Origin, Goal, Here), 1565 process_called_list(Called, Origin, Src, P). 1566process_goal(Goal, Origin, Src, _) :- 1567 process_xpce_goal(Goal, Origin, Src), 1568 !. 1569process_goal(load_foreign_library(File), _Origin, Src, _) :- 1570 process_foreign(File, Src). 1571process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1572 process_foreign(File, Src). 1573process_goal(use_foreign_library(File), _Origin, Src, _) :- 1574 process_foreign(File, Src). 1575process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1576 process_foreign(File, Src). 1577process_goal(Goal, Origin, Src, P) :- 1578 xref_meta_src(Goal, Metas, Src), 1579 !, 1580 current_source_line(Here), 1581 assert_called(Src, Origin, Goal, Here), 1582 process_called_list(Metas, Origin, Src, P). 1583process_goal(Goal, Origin, Src, _) :- 1584 asserting_goal(Goal, Rule), 1585 !, 1586 current_source_line(Here), 1587 assert_called(Src, Origin, Goal, Here), 1588 process_assert(Rule, Origin, Src). 1589process_goal(Goal, Origin, Src, P) :- 1590 partial_evaluate(Goal, P), 1591 current_source_line(Here), 1592 assert_called(Src, Origin, Goal, Here). 1593 1594disjunction(Var) --> {var(Var), !}, [Var]. 1595disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1596disjunction(G) --> [G]. 1597 1598conjunction(Var) --> {var(Var), !}, [Var]. 1599conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1600conjunction(G) --> [G]. 1601 RVars, T) (:- 1603 term_variables(T, TVars0), 1604 sort(TVars0, TVars), 1605 ord_intersect(RVars, TVars). 1606 1607process_conjunction([], _, _, _). 1608process_conjunction([Disj|Rest], Origin, Src, P) :- 1609 nonvar(Disj), 1610 Disj = (_;_), 1611 Rest \== [], 1612 !, 1613 phrase(disjunction(Disj), Goals), 1614 term_variables(Rest, RVars0), 1615 sort(RVars0, RVars), 1616 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1617 forall(member(G, NonSHaring), 1618 process_body(G, Origin, Src)), 1619 ( Sharing == [] 1620 -> true 1621 ; maplist(term_variables, Sharing, GVars0), 1622 append(GVars0, GVars1), 1623 sort(GVars1, GVars), 1624 ord_intersection(GVars, RVars, SVars), 1625 VT =.. [v|SVars], 1626 findall(VT, 1627 ( member(G, Sharing), 1628 process_goal(G, Origin, Src, PS), 1629 PS == true 1630 ), 1631 Alts0), 1632 ( Alts0 == [] 1633 -> true 1634 ; ( true 1635 ; P = true, 1636 sort(Alts0, Alts1), 1637 variants(Alts1, 10, Alts), 1638 member(VT, Alts) 1639 ) 1640 ) 1641 ), 1642 process_conjunction(Rest, Origin, Src, P). 1643process_conjunction([H|T], Origin, Src, P) :- 1644 process_goal(H, Origin, Src, P), 1645 process_conjunction(T, Origin, Src, P). 1646 1647 1648process_called_list([], _, _, _). 1649process_called_list([H|T], Origin, Src, P) :- 1650 process_meta(H, Origin, Src, P), 1651 process_called_list(T, Origin, Src, P). 1652 1653process_meta(A+N, Origin, Src, P) :- 1654 !, 1655 ( extend(A, N, AX) 1656 -> process_goal(AX, Origin, Src, P) 1657 ; true 1658 ). 1659process_meta(//(A), Origin, Src, P) :- 1660 !, 1661 process_dcg_goal(A, Origin, Src, P). 1662process_meta(G, Origin, Src, P) :- 1663 process_goal(G, Origin, Src, P).
1670process_dcg_goal(Var, _, _, _) :- 1671 var(Var), 1672 !. 1673process_dcg_goal((A,B), Origin, Src, P) :- 1674 !, 1675 process_dcg_goal(A, Origin, Src, P), 1676 process_dcg_goal(B, Origin, Src, P). 1677process_dcg_goal((A;B), Origin, Src, P) :- 1678 !, 1679 process_dcg_goal(A, Origin, Src, P), 1680 process_dcg_goal(B, Origin, Src, P). 1681process_dcg_goal((A|B), Origin, Src, P) :- 1682 !, 1683 process_dcg_goal(A, Origin, Src, P), 1684 process_dcg_goal(B, Origin, Src, P). 1685process_dcg_goal((A->B), Origin, Src, P) :- 1686 !, 1687 process_dcg_goal(A, Origin, Src, P), 1688 process_dcg_goal(B, Origin, Src, P). 1689process_dcg_goal((A*->B), Origin, Src, P) :- 1690 !, 1691 process_dcg_goal(A, Origin, Src, P), 1692 process_dcg_goal(B, Origin, Src, P). 1693process_dcg_goal({Goal}, Origin, Src, P) :- 1694 !, 1695 process_goal(Goal, Origin, Src, P). 1696process_dcg_goal(List, _Origin, _Src, _) :- 1697 is_list(List), 1698 !. % terminal 1699process_dcg_goal(List, _Origin, _Src, _) :- 1700 string(List), 1701 !. % terminal 1702process_dcg_goal(Callable, Origin, Src, P) :- 1703 extend(Callable, 2, Goal), 1704 !, 1705 process_goal(Goal, Origin, Src, P). 1706process_dcg_goal(_, _, _, _). 1707 1708 1709extend(Var, _, _) :- 1710 var(Var), !, fail. 1711extend(M:G, N, M:GX) :- 1712 !, 1713 callable(G), 1714 extend(G, N, GX). 1715extend(G, N, GX) :- 1716 ( compound(G) 1717 -> compound_name_arguments(G, Name, Args), 1718 length(Rest, N), 1719 append(Args, Rest, NArgs), 1720 compound_name_arguments(GX, Name, NArgs) 1721 ; atom(G) 1722 -> length(NArgs, N), 1723 compound_name_arguments(GX, G, NArgs) 1724 ). 1725 1726asserting_goal(assert(Rule), Rule). 1727asserting_goal(asserta(Rule), Rule). 1728asserting_goal(assertz(Rule), Rule). 1729asserting_goal(assert(Rule,_), Rule). 1730asserting_goal(asserta(Rule,_), Rule). 1731asserting_goal(assertz(Rule,_), Rule). 1732 1733process_assert(0, _, _) :- !. % catch variables 1734process_assert((_:-Body), Origin, Src) :- 1735 !, 1736 process_body(Body, Origin, Src). 1737process_assert(_, _, _).
1741variants([], _, []). 1742variants([H|T], Max, List) :- 1743 variants(T, H, Max, List). 1744 1745variants([], H, _, [H]). 1746variants(_, _, 0, []) :- !. 1747variants([H|T], V, Max, List) :- 1748 ( H =@= V 1749 -> variants(T, V, Max, List) 1750 ; List = [V|List2], 1751 Max1 is Max-1, 1752 variants(T, H, Max1, List2) 1753 ).
T = hello(X), findall(T, T, List),
1767partial_evaluate(Goal, P) :- 1768 eval(Goal), 1769 !, 1770 P = true. 1771partial_evaluate(_, _). 1772 1773eval(X = Y) :- 1774 unify_with_occurs_check(X, Y). 1775 1776 /******************************* 1777 * PLUNIT SUPPORT * 1778 *******************************/ 1779 1780enter_test_unit(Unit, _Src) :- 1781 current_source_line(Line), 1782 asserta(current_test_unit(Unit, Line)). 1783 1784leave_test_unit(Unit, _Src) :- 1785 retractall(current_test_unit(Unit, _)). 1786 1787 1788 /******************************* 1789 * XPCE STUFF * 1790 *******************************/ 1791 1792pce_goal(new(_,_), new(-, new)). 1793pce_goal(send(_,_), send(arg, msg)). 1794pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1795pce_goal(get(_,_,_), get(arg, msg, -)). 1796pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1797pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1798pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1799 1800process_xpce_goal(G, Origin, Src) :- 1801 pce_goal(G, Process), 1802 !, 1803 current_source_line(Here), 1804 assert_called(Src, Origin, G, Here), 1805 ( arg(I, Process, How), 1806 arg(I, G, Term), 1807 process_xpce_arg(How, Term, Origin, Src), 1808 fail 1809 ; true 1810 ). 1811 1812process_xpce_arg(new, Term, Origin, Src) :- 1813 callable(Term), 1814 process_new(Term, Origin, Src). 1815process_xpce_arg(arg, Term, Origin, Src) :- 1816 compound(Term), 1817 process_new(Term, Origin, Src). 1818process_xpce_arg(msg, Term, Origin, Src) :- 1819 compound(Term), 1820 ( arg(_, Term, Arg), 1821 process_xpce_arg(arg, Arg, Origin, Src), 1822 fail 1823 ; true 1824 ). 1825 1826process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1827process_new(Term, Origin, Src) :- 1828 assert_new(Src, Origin, Term), 1829 ( compound(Term), 1830 arg(_, Term, Arg), 1831 process_xpce_arg(arg, Arg, Origin, Src), 1832 fail 1833 ; true 1834 ). 1835 1836assert_new(_, _, Term) :- 1837 \+ callable(Term), 1838 !. 1839assert_new(Src, Origin, Control) :- 1840 functor_name(Control, Class), 1841 pce_control_class(Class), 1842 !, 1843 forall(arg(_, Control, Arg), 1844 assert_new(Src, Origin, Arg)). 1845assert_new(Src, Origin, Term) :- 1846 compound(Term), 1847 arg(1, Term, Prolog), 1848 Prolog == @(prolog), 1849 ( Term =.. [message, _, Selector | T], 1850 atom(Selector) 1851 -> Called =.. [Selector|T], 1852 process_body(Called, Origin, Src) 1853 ; Term =.. [?, _, Selector | T], 1854 atom(Selector) 1855 -> append(T, [_R], T2), 1856 Called =.. [Selector|T2], 1857 process_body(Called, Origin, Src) 1858 ), 1859 fail. 1860assert_new(_, _, @(_)) :- !. 1861assert_new(Src, _, Term) :- 1862 functor_name(Term, Name), 1863 assert_used_class(Src, Name). 1864 1865 1866pce_control_class(and). 1867pce_control_class(or). 1868pce_control_class(if). 1869pce_control_class(not). 1870 1871 1872 /******************************** 1873 * INCLUDED MODULES * 1874 ********************************/
1878process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1879process_use_module([], _, _) :- !. 1880process_use_module([H|T], Src, Reexport) :- 1881 !, 1882 process_use_module(H, Src, Reexport), 1883 process_use_module(T, Src, Reexport). 1884process_use_module(library(pce), Src, Reexport) :- % bit special 1885 !, 1886 xref_public_list(library(pce), Path, Exports, Src), 1887 forall(member(Import, Exports), 1888 process_pce_import(Import, Src, Path, Reexport)). 1889process_use_module(File, Src, Reexport) :- 1890 load_module_if_needed(File), 1891 ( xoption(Src, silent(Silent)) 1892 -> Extra = [silent(Silent)] 1893 ; Extra = [silent(true)] 1894 ), 1895 ( xref_public_list(File, Src, 1896 [ path(Path), 1897 module(M), 1898 exports(Exports), 1899 public(Public), 1900 meta(Meta) 1901 | Extra 1902 ]) 1903 -> assert(uses_file(File, Src, Path)), 1904 assert_import(Src, Exports, _, Path, Reexport), 1905 assert_xmodule_callable(Exports, M, Src, Path), 1906 assert_xmodule_callable(Public, M, Src, Path), 1907 maplist(process_meta_head(Src), Meta), 1908 ( File = library(chr) % hacky 1909 -> assert(mode(chr, Src)) 1910 ; true 1911 ) 1912 ; assert(uses_file(File, Src, '<not_found>')) 1913 ). 1914 1915process_pce_import(Name/Arity, Src, Path, Reexport) :- 1916 atom(Name), 1917 integer(Arity), 1918 !, 1919 functor(Term, Name, Arity), 1920 ( \+ system_predicate(Term), 1921 \+ Term = pce_error(_) % hack!? 1922 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1923 ; true 1924 ). 1925process_pce_import(op(P,T,N), Src, _, _) :- 1926 xref_push_op(Src, P, T, N).
1932process_use_module2(File, Import, Src, Reexport) :-
1933 load_module_if_needed(File),
1934 ( xref_source_file(File, Path, Src)
1935 -> assert(uses_file(File, Src, Path)),
1936 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1937 -> assert_import(Src, Import, Export, Path, Reexport),
1938 forall(( member(Head, Meta),
1939 imported(Head, _, Path)
1940 ),
1941 process_meta_head(Src, Head))
1942 ; true
1943 )
1944 ; assert(uses_file(File, Src, '<not_found>'))
1945 ).
1954load_module_if_needed(File) :- 1955 prolog:no_autoload_module(File), 1956 !, 1957 use_module(File, []). 1958load_module_if_needed(_). 1959 1960prologno_autoload_module(library(apply_macros)). 1961prologno_autoload_module(library(arithmetic)). 1962prologno_autoload_module(library(record)). 1963prologno_autoload_module(library(persistency)). 1964prologno_autoload_module(library(pldoc)). 1965prologno_autoload_module(library(settings)). 1966prologno_autoload_module(library(debug)). 1967prologno_autoload_module(library(plunit)). 1968prologno_autoload_module(library(macros)). 1969prologno_autoload_module(library(yall)).
1974process_requires(Import, Src) :- 1975 is_list(Import), 1976 !, 1977 require_list(Import, Src). 1978process_requires(Var, _Src) :- 1979 var(Var), 1980 !. 1981process_requires((A,B), Src) :- 1982 !, 1983 process_requires(A, Src), 1984 process_requires(B, Src). 1985process_requires(PI, Src) :- 1986 requires(PI, Src). 1987 1988require_list([], _). 1989require_list([H|T], Src) :- 1990 requires(H, Src), 1991 require_list(T, Src). 1992 1993requires(PI, _Src) :- 1994 '$pi_head'(PI, Head), 1995 '$get_predicate_attribute'(system:Head, defined, 1), 1996 !. 1997requires(PI, Src) :- 1998 '$pi_head'(PI, Head), 1999 '$pi_head'(Name/Arity, Head), 2000 '$find_library'(_Module, Name, Arity, _LoadModule, Library), 2001 ( imported(Head, Src, Library) 2002 -> true 2003 ; assertz(imported(Head, Src, Library)) 2004 ).
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.
2035xref_public_list(File, Src, Options) :-
2036 option(path(Path), Options, _),
2037 option(module(Module), Options, _),
2038 option(exports(Exports), Options, _),
2039 option(public(Public), Options, _),
2040 option(meta(Meta), Options, _),
2041 xref_source_file(File, Path, Src, Options),
2042 public_list(Path, Module, Meta, Exports, Public, Options).
These predicates fail if File is not a module-file.
2064xref_public_list(File, Path, Export, Src) :- 2065 xref_source_file(File, Path, Src), 2066 public_list(Path, _, _, Export, _, []). 2067xref_public_list(File, Path, Module, Export, Meta, Src) :- 2068 xref_source_file(File, Path, Src), 2069 public_list(Path, Module, Meta, Export, _, []). 2070xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 2071 xref_source_file(File, Path, Src), 2072 public_list(Path, Module, Meta, Export, Public, []).
true
, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.2082:- dynamic public_list_cache/6. 2083:- volatile public_list_cache/6. 2084 2085public_list(Path, Module, Meta, Export, Public, _Options) :- 2086 public_list_cache(Path, Modified, 2087 Module0, Meta0, Export0, Public0), 2088 time_file(Path, ModifiedNow), 2089 ( abs(Modified-ModifiedNow) < 0.0001 2090 -> !, 2091 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 2092 ; retractall(public_list_cache(Path, _, _, _, _, _)), 2093 fail 2094 ). 2095public_list(Path, Module, Meta, Export, Public, Options) :- 2096 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 2097 ( Error = error(_,_), 2098 catch(time_file(Path, Modified), Error, fail) 2099 -> asserta(public_list_cache(Path, Modified, 2100 Module0, Meta0, Export0, Public0)) 2101 ; true 2102 ), 2103 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 2104 2105public_list_nc(Path, Module, Meta, Export, Public, Options) :- 2106 in_temporary_module( 2107 TempModule, 2108 true, 2109 public_list_diff(TempModule, Path, Module, 2110 Meta, [], Export, [], Public, [], Options)). 2111 2112 2113public_list_diff(TempModule, 2114 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 2115 setup_call_cleanup( 2116 public_list_setup(TempModule, Path, In, State), 2117 phrase(read_directives(In, Options, [true]), Directives), 2118 public_list_cleanup(In, State)), 2119 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 2120 2121public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 2122 prolog_open_source(Path, In), 2123 '$set_source_module'(OldM, TempModule), 2124 set_xref(OldXref). 2125 2126public_list_cleanup(In, state(OldM, OldXref)) :- 2127 '$set_source_module'(OldM), 2128 set_prolog_flag(xref, OldXref), 2129 prolog_close_source(In). 2130 2131 2132read_directives(In, Options, State) --> 2133 { repeat, 2134 catch(prolog_read_source_term(In, Term, Expanded, 2135 [ process_comment(true), 2136 syntax_errors(error) 2137 ]), 2138 E, report_syntax_error(E, -, Options)) 2139 -> nonvar(Term), 2140 Term = (:-_) 2141 }, 2142 !, 2143 terms(Expanded, State, State1), 2144 read_directives(In, Options, State1). 2145read_directives(_, _, _) --> []. 2146 2147terms(Var, State, State) --> { var(Var) }, !. 2148terms([H|T], State0, State) --> 2149 !, 2150 terms(H, State0, State1), 2151 terms(T, State1, State). 2152terms((:-if(Cond)), State0, [True|State0]) --> 2153 !, 2154 { eval_cond(Cond, True) }. 2155terms((:-elif(Cond)), [True0|State], [True|State]) --> 2156 !, 2157 { eval_cond(Cond, True1), 2158 elif(True0, True1, True) 2159 }. 2160terms((:-else), [True0|State], [True|State]) --> 2161 !, 2162 { negate(True0, True) }. 2163terms((:-endif), [_|State], State) --> !. 2164terms(H, State, State) --> 2165 ( {State = [true|_]} 2166 -> [H] 2167 ; [] 2168 ). 2169 2170eval_cond(Cond, true) :- 2171 catch(Cond, _, fail), 2172 !. 2173eval_cond(_, false). 2174 2175elif(true, _, else_false) :- !. 2176elif(false, true, true) :- !. 2177elif(True, _, True). 2178 2179negate(true, false). 2180negate(false, true). 2181negate(else_false, else_false). 2182 2183public_list([(:- module(Module, Export0))|Decls], Path, 2184 Module, Meta, MT, Export, Rest, Public, PT) :- 2185 !, 2186 ( is_list(Export0) 2187 -> append(Export0, Reexport, Export) 2188 ; Reexport = Export 2189 ), 2190 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 2191public_list([(:- encoding(_))|Decls], Path, 2192 Module, Meta, MT, Export, Rest, Public, PT) :- 2193 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 2194 2195public_list_([], _, Meta, Meta, Export, Export, Public, Public). 2196public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2197 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 2198 !, 2199 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 2200public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 2201 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 2202 2203public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 2204 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 2205public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 2206 public_from_import(Import, Spec, Path, Reexport, Rest). 2207public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 2208 phrase(meta_decls(Decl), Meta, MT). 2209public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 2210 phrase(public_decls(Decl), Public, PT).
2216reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 2217reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 2218 !, 2219 xref_source_file(H, Path, Src), 2220 public_list(Path, _Module, Meta0, Export0, Public0, []), 2221 append(Meta0, MT1, Meta), 2222 append(Export0, ET1, Export), 2223 append(Public0, PT1, Public), 2224 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 2225reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 2226 xref_source_file(Spec, Path, Src), 2227 public_list(Path, _Module, Meta0, Export0, Public0, []), 2228 append(Meta0, MT, Meta), 2229 append(Export0, ET, Export), 2230 append(Public0, PT, Public). 2231 2232public_from_import(except(Map), Path, Src, Export, Rest) :- 2233 !, 2234 xref_public_list(Path, _, AllExports, Src), 2235 except(Map, AllExports, NewExports), 2236 append(NewExports, Rest, Export). 2237public_from_import(Import, _, _, Export, Rest) :- 2238 import_name_map(Import, Export, Rest).
2243except([], Exports, Exports). 2244except([PI0 as NewName|Map], Exports0, Exports) :- 2245 !, 2246 canonical_pi(PI0, PI), 2247 map_as(Exports0, PI, NewName, Exports1), 2248 except(Map, Exports1, Exports). 2249except([PI0|Map], Exports0, Exports) :- 2250 canonical_pi(PI0, PI), 2251 select(PI2, Exports0, Exports1), 2252 same_pi(PI, PI2), 2253 !, 2254 except(Map, Exports1, Exports). 2255 2256 2257map_as([PI|T], Repl, As, [PI2|T]) :- 2258 same_pi(Repl, PI), 2259 !, 2260 pi_as(PI, As, PI2). 2261map_as([H|T0], Repl, As, [H|T]) :- 2262 map_as(T0, Repl, As, T). 2263 2264pi_as(_/Arity, Name, Name/Arity). 2265pi_as(_//Arity, Name, Name//Arity). 2266 2267import_name_map([], L, L). 2268import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2269 !, 2270 import_name_map(T0, T, Tail). 2271import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2272 !, 2273 import_name_map(T0, T, Tail). 2274import_name_map([H|T0], [H|T], Tail) :- 2275 import_name_map(T0, T, Tail). 2276 2277canonical_pi(Name//Arity0, PI) :- 2278 integer(Arity0), 2279 !, 2280 PI = Name/Arity, 2281 Arity is Arity0 + 2. 2282canonical_pi(PI, PI). 2283 2284same_pi(Canonical, PI2) :- 2285 canonical_pi(PI2, Canonical). 2286 2287meta_decls(Var) --> 2288 { var(Var) }, 2289 !. 2290meta_decls((A,B)) --> 2291 !, 2292 meta_decls(A), 2293 meta_decls(B). 2294meta_decls(A) --> 2295 [A]. 2296 2297public_decls(Var) --> 2298 { var(Var) }, 2299 !. 2300public_decls((A,B)) --> 2301 !, 2302 public_decls(A), 2303 public_decls(B). 2304public_decls(A) --> 2305 [A]. 2306 2307 /******************************* 2308 * INCLUDE * 2309 *******************************/ 2310 2311process_include([], _) :- !. 2312process_include([H|T], Src) :- 2313 !, 2314 process_include(H, Src), 2315 process_include(T, Src). 2316process_include(File, Src) :- 2317 callable(File), 2318 !, 2319 ( once(xref_input(ParentSrc, _)), 2320 xref_source_file(File, Path, ParentSrc) 2321 -> ( ( uses_file(_, Src, Path) 2322 ; Path == Src 2323 ) 2324 -> true 2325 ; assert(uses_file(File, Src, Path)), 2326 ( xoption(Src, process_include(true)) 2327 -> findall(O, xoption(Src, O), Options), 2328 setup_call_cleanup( 2329 open_include_file(Path, In, Refs), 2330 collect(Src, Path, In, Options), 2331 close_include(In, Refs)) 2332 ; true 2333 ) 2334 ) 2335 ; assert(uses_file(File, Src, '<not_found>')) 2336 ). 2337process_include(_, _).
include(File)
referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2345open_include_file(Path, In, [Ref]) :- 2346 once(xref_input(_, Parent)), 2347 stream_property(Parent, encoding(Enc)), 2348 '$push_input_context'(xref_include), 2349 catch(( prolog:xref_open_source(Path, In) 2350 -> catch(set_stream(In, encoding(Enc)), 2351 error(_,_), true) % deal with non-file input 2352 ; include_encoding(Enc, Options), 2353 open(Path, read, In, Options) 2354 ), E, 2355 ( '$pop_input_context', throw(E))), 2356 catch(( peek_char(In, #) % Deal with #! script 2357 -> skip(In, 10) 2358 ; true 2359 ), E, 2360 ( close_include(In, []), throw(E))), 2361 asserta(xref_input(Path, In), Ref). 2362 2363include_encoding(wchar_t, []) :- !. 2364include_encoding(Enc, [encoding(Enc)]). 2365 2366 2367close_include(In, Refs) :- 2368 maplist(erase, Refs), 2369 close(In, [force(true)]), 2370 '$pop_input_context'.
2376process_foreign(Spec, Src) :- 2377 ground(Spec), 2378 current_foreign_library(Spec, Defined), 2379 !, 2380 ( xmodule(Module, Src) 2381 -> true 2382 ; Module = user 2383 ), 2384 process_foreign_defined(Defined, Module, Src). 2385process_foreign(_, _). 2386 2387process_foreign_defined([], _, _). 2388process_foreign_defined([H|T], M, Src) :- 2389 ( H = M:Head 2390 -> assert_foreign(Src, Head) 2391 ; assert_foreign(Src, H) 2392 ), 2393 process_foreign_defined(T, M, Src). 2394 2395 2396 /******************************* 2397 * CHR SUPPORT * 2398 *******************************/ 2399 2400/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2401This part of the file supports CHR. Our choice is between making special 2402hooks to make CHR expansion work and then handle the (complex) expanded 2403code or process the CHR source directly. The latter looks simpler, 2404though I don't like the idea of adding support for libraries to this 2405module. A file is supposed to be a CHR file if it uses a 2406use_module(library(chr) or contains a :- constraint/1 directive. As an 2407extra bonus we get the source-locations right :-) 2408- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2409 2410process_chr(@(_Name, Rule), Src) :- 2411 mode(chr, Src), 2412 process_chr(Rule, Src). 2413process_chr(pragma(Rule, _Pragma), Src) :- 2414 mode(chr, Src), 2415 process_chr(Rule, Src). 2416process_chr(<=>(Head, Body), Src) :- 2417 mode(chr, Src), 2418 chr_head(Head, Src, H), 2419 chr_body(Body, H, Src). 2420process_chr(==>(Head, Body), Src) :- 2421 mode(chr, Src), 2422 chr_head(Head, H, Src), 2423 chr_body(Body, H, Src). 2424process_chr((:- chr_constraint(_)), Src) :- 2425 ( mode(chr, Src) 2426 -> true 2427 ; assert(mode(chr, Src)) 2428 ). 2429 2430chr_head(X, _, _) :- 2431 var(X), 2432 !. % Illegal. Warn? 2433chr_head(\(A,B), Src, H) :- 2434 chr_head(A, Src, H), 2435 process_body(B, H, Src). 2436chr_head((H0,B), Src, H) :- 2437 chr_defined(H0, Src, H), 2438 process_body(B, H, Src). 2439chr_head(H0, Src, H) :- 2440 chr_defined(H0, Src, H). 2441 2442chr_defined(X, _, _) :- 2443 var(X), 2444 !. 2445chr_defined(#(C,_Id), Src, C) :- 2446 !, 2447 assert_constraint(Src, C). 2448chr_defined(A, Src, A) :- 2449 assert_constraint(Src, A). 2450 2451chr_body(X, From, Src) :- 2452 var(X), 2453 !, 2454 process_body(X, From, Src). 2455chr_body('|'(Guard, Goals), H, Src) :- 2456 !, 2457 chr_body(Guard, H, Src), 2458 chr_body(Goals, H, Src). 2459chr_body(G, From, Src) :- 2460 process_body(G, From, Src). 2461 2462assert_constraint(_, Head) :- 2463 var(Head), 2464 !. 2465assert_constraint(Src, Head) :- 2466 constraint(Head, Src, _), 2467 !. 2468assert_constraint(Src, Head) :- 2469 generalise_term(Head, Term), 2470 current_source_line(Line), 2471 assert(constraint(Term, Src, Line)). 2472 2473 2474 /******************************** 2475 * PHASE 1 ASSERTIONS * 2476 ********************************/
2483assert_called(_, _, Var, _) :- 2484 var(Var), 2485 !. 2486assert_called(Src, From, Goal, Line) :- 2487 var(From), 2488 !, 2489 assert_called(Src, '<unknown>', Goal, Line). 2490assert_called(_, _, Goal, _) :- 2491 expand_hide_called(Goal), 2492 !. 2493assert_called(Src, Origin, M:G, Line) :- 2494 !, 2495 ( atom(M), 2496 callable(G) 2497 -> current_condition(Cond), 2498 ( xmodule(M, Src) % explicit call to own module 2499 -> assert_called(Src, Origin, G, Line) 2500 ; called(M:G, Src, Origin, Cond, Line) % already registered 2501 -> true 2502 ; hide_called(M:G, Src) % not interesting (now) 2503 -> true 2504 ; generalise(Origin, OTerm), 2505 generalise(G, GTerm) 2506 -> assert(called(M:GTerm, Src, OTerm, Cond, Line)) 2507 ; true 2508 ) 2509 ; true % call to variable module 2510 ). 2511assert_called(Src, _, Goal, _) :- 2512 ( xmodule(M, Src) 2513 -> M \== system 2514 ; M = user 2515 ), 2516 hide_called(M:Goal, Src), 2517 !. 2518assert_called(Src, Origin, Goal, Line) :- 2519 current_condition(Cond), 2520 ( called(Goal, Src, Origin, Cond, Line) 2521 -> true 2522 ; generalise(Origin, OTerm), 2523 generalise(Goal, Term) 2524 -> assert(called(Term, Src, OTerm, Cond, Line)) 2525 ; true 2526 ).
2534expand_hide_called(pce_principal:send_implementation(_, _, _)). 2535expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2536expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2537expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2538 2539assert_defined(Src, Goal) :- 2540 Goal = test(_Test), 2541 current_test_unit(Unit, Line), 2542 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2543 fail. 2544assert_defined(Src, Goal) :- 2545 Goal = test(_Test, _Options), 2546 current_test_unit(Unit, Line), 2547 assert_called(Src, '<test_unit>'(Unit), Goal, Line), 2548 fail. 2549assert_defined(Src, Goal) :- 2550 defined(Goal, Src, _), 2551 !. 2552assert_defined(Src, Goal) :- 2553 generalise(Goal, Term), 2554 current_source_line(Line), 2555 assert(defined(Term, Src, Line)). 2556 2557assert_foreign(Src, Goal) :- 2558 foreign(Goal, Src, _), 2559 !. 2560assert_foreign(Src, Goal) :- 2561 generalise(Goal, Term), 2562 current_source_line(Line), 2563 assert(foreign(Term, Src, Line)). 2564 2565assert_grammar_rule(Src, Goal) :- 2566 grammar_rule(Goal, Src), 2567 !. 2568assert_grammar_rule(Src, Goal) :- 2569 generalise(Goal, Term), 2570 assert(grammar_rule(Term, Src)).
true
, re-export the
imported predicates.
2583assert_import(_, [], _, _, _) :- !. 2584assert_import(Src, [H|T], Export, From, Reexport) :- 2585 !, 2586 assert_import(Src, H, Export, From, Reexport), 2587 assert_import(Src, T, Export, From, Reexport). 2588assert_import(Src, except(Except), Export, From, Reexport) :- 2589 !, 2590 is_list(Export), 2591 !, 2592 except(Except, Export, Import), 2593 assert_import(Src, Import, _All, From, Reexport). 2594assert_import(Src, Import as Name, Export, From, Reexport) :- 2595 !, 2596 pi_to_head(Import, Term0), 2597 rename_goal(Term0, Name, Term), 2598 ( in_export_list(Term0, Export) 2599 -> assert(imported(Term, Src, From)), 2600 assert_reexport(Reexport, Src, Term) 2601 ; current_source_line(Line), 2602 assert_called(Src, '<directive>'(Line), Term0, Line) 2603 ). 2604assert_import(Src, Import, Export, From, Reexport) :- 2605 pi_to_head(Import, Term), 2606 !, 2607 ( in_export_list(Term, Export) 2608 -> assert(imported(Term, Src, From)), 2609 assert_reexport(Reexport, Src, Term) 2610 ; current_source_line(Line), 2611 assert_called(Src, '<directive>'(Line), Term, Line) 2612 ). 2613assert_import(Src, op(P,T,N), _, _, _) :- 2614 xref_push_op(Src, P,T,N). 2615 2616in_export_list(_Head, Export) :- 2617 var(Export), 2618 !. 2619in_export_list(Head, Export) :- 2620 member(PI, Export), 2621 pi_to_head(PI, Head). 2622 2623assert_reexport(false, _, _) :- !. 2624assert_reexport(true, Src, Term) :- 2625 assert(exported(Term, Src)).
2631process_import(M:PI, Src) :- 2632 pi_to_head(PI, Head), 2633 !, 2634 ( atom(M), 2635 current_module(M), 2636 module_property(M, file(From)) 2637 -> true 2638 ; From = '<unknown>' 2639 ), 2640 assert(imported(Head, Src, From)). 2641process_import(_, _).
2650assert_xmodule_callable([], _, _, _). 2651assert_xmodule_callable([PI|T], M, Src, From) :- 2652 ( pi_to_head(M:PI, Head) 2653 -> assert(imported(Head, Src, From)) 2654 ; true 2655 ), 2656 assert_xmodule_callable(T, M, Src, From).
2663assert_op(Src, op(P,T,M:N)) :-
2664 ( '$current_source_module'(M)
2665 -> Name = N
2666 ; Name = M:N
2667 ),
2668 ( xop(Src, op(P,T,Name))
2669 -> true
2670 ; assert(xop(Src, op(P,T,Name)))
2671 ).
2678assert_module(Src, Module) :- 2679 xmodule(Module, Src), 2680 !. 2681assert_module(Src, Module) :- 2682 '$set_source_module'(Module), 2683 assert(xmodule(Module, Src)), 2684 ( module_property(Module, class(system)) 2685 -> retractall(xoption(Src, register_called(_))), 2686 assert(xoption(Src, register_called(all))) 2687 ; true 2688 ). 2689 2690assert_module_export(_, []) :- !. 2691assert_module_export(Src, [H|T]) :- 2692 !, 2693 assert_module_export(Src, H), 2694 assert_module_export(Src, T). 2695assert_module_export(Src, PI) :- 2696 pi_to_head(PI, Term), 2697 !, 2698 assert(exported(Term, Src)). 2699assert_module_export(Src, op(P, A, N)) :- 2700 xref_push_op(Src, P, A, N).
2706assert_module3([], _) :- !. 2707assert_module3([H|T], Src) :- 2708 !, 2709 assert_module3(H, Src), 2710 assert_module3(T, Src). 2711assert_module3(Option, Src) :- 2712 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src)
. Handles both lists of specifications and (PI,...)
specifications.2721process_predicates(Closure, Preds, Src) :- 2722 is_list(Preds), 2723 !, 2724 process_predicate_list(Preds, Closure, Src). 2725process_predicates(Closure, as(Preds, _Options), Src) :- 2726 !, 2727 process_predicates(Closure, Preds, Src). 2728process_predicates(Closure, Preds, Src) :- 2729 process_predicate_comma(Preds, Closure, Src). 2730 2731process_predicate_list([], _, _). 2732process_predicate_list([H|T], Closure, Src) :- 2733 ( nonvar(H) 2734 -> call(Closure, H, Src) 2735 ; true 2736 ), 2737 process_predicate_list(T, Closure, Src). 2738 2739process_predicate_comma(Var, _, _) :- 2740 var(Var), 2741 !. 2742process_predicate_comma(M:(A,B), Closure, Src) :- 2743 !, 2744 process_predicate_comma(M:A, Closure, Src), 2745 process_predicate_comma(M:B, Closure, Src). 2746process_predicate_comma((A,B), Closure, Src) :- 2747 !, 2748 process_predicate_comma(A, Closure, Src), 2749 process_predicate_comma(B, Closure, Src). 2750process_predicate_comma(as(Spec, _Options), Closure, Src) :- 2751 !, 2752 process_predicate_comma(Spec, Closure, Src). 2753process_predicate_comma(A, Closure, Src) :- 2754 call(Closure, A, Src). 2755 2756 2757assert_dynamic(PI, Src) :- 2758 pi_to_head(PI, Term), 2759 ( thread_local(Term, Src, _) % dynamic after thread_local has 2760 -> true % no effect 2761 ; current_source_line(Line), 2762 assert(dynamic(Term, Src, Line)) 2763 ). 2764 2765assert_thread_local(PI, Src) :- 2766 pi_to_head(PI, Term), 2767 current_source_line(Line), 2768 assert(thread_local(Term, Src, Line)). 2769 2770assert_multifile(PI, Src) :- % :- multifile(Spec) 2771 pi_to_head(PI, Term), 2772 current_source_line(Line), 2773 assert(multifile(Term, Src, Line)). 2774 2775assert_public(PI, Src) :- % :- public(Spec) 2776 pi_to_head(PI, Term), 2777 current_source_line(Line), 2778 assert_called(Src, '<public>'(Line), Term, Line), 2779 assert(public(Term, Src, Line)). 2780 2781assert_export(PI, Src) :- % :- export(Spec) 2782 pi_to_head(PI, Term), 2783 !, 2784 assert(exported(Term, Src)).
2791pi_to_head(Var, _) :- 2792 var(Var), !, fail. 2793pi_to_head(M:PI, M:Term) :- 2794 !, 2795 pi_to_head(PI, Term). 2796pi_to_head(Name/Arity, Term) :- 2797 functor(Term, Name, Arity). 2798pi_to_head(Name//DCGArity, Term) :- 2799 Arity is DCGArity+2, 2800 functor(Term, Name, Arity). 2801 2802 2803assert_used_class(Src, Name) :- 2804 used_class(Name, Src), 2805 !. 2806assert_used_class(Src, Name) :- 2807 assert(used_class(Name, Src)). 2808 2809assert_defined_class(Src, Name, _Meta, _Super, _) :- 2810 defined_class(Name, _, _, Src, _), 2811 !. 2812assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2813assert_defined_class(Src, Name, Meta, Super, Summary) :- 2814 current_source_line(Line), 2815 ( Summary == @(default) 2816 -> Atom = '' 2817 ; is_list(Summary) 2818 -> atom_codes(Atom, Summary) 2819 ; string(Summary) 2820 -> atom_concat(Summary, '', Atom) 2821 ), 2822 assert(defined_class(Name, Super, Atom, Src, Line)), 2823 ( Meta = @(_) 2824 -> true 2825 ; assert_used_class(Src, Meta) 2826 ), 2827 assert_used_class(Src, Super). 2828 2829assert_defined_class(Src, Name, imported_from(_File)) :- 2830 defined_class(Name, _, _, Src, _), 2831 !. 2832assert_defined_class(Src, Name, imported_from(File)) :- 2833 assert(defined_class(Name, _, '', Src, file(File))). 2834 2835 2836 /******************************** 2837 * UTILITIES * 2838 ********************************/
2844generalise(Var, Var) :- 2845 var(Var), 2846 !. % error? 2847generalise(pce_principal:send_implementation(Id, _, _), 2848 pce_principal:send_implementation(Id, _, _)) :- 2849 atom(Id), 2850 !. 2851generalise(pce_principal:get_implementation(Id, _, _, _), 2852 pce_principal:get_implementation(Id, _, _, _)) :- 2853 atom(Id), 2854 !. 2855generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2856generalise(test(Test), test(Test)) :- 2857 current_test_unit(_,_), 2858 ground(Test), 2859 !. 2860generalise(test(Test, _), test(Test, _)) :- 2861 current_test_unit(_,_), 2862 ground(Test), 2863 !. 2864generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !. 2865generalise(Module:Goal0, Module:Goal) :- 2866 atom(Module), 2867 !, 2868 generalise(Goal0, Goal). 2869generalise(Term0, Term) :- 2870 callable(Term0), 2871 generalise_term(Term0, Term). 2872 2873 2874 /******************************* 2875 * SOURCE MANAGEMENT * 2876 *******************************/ 2877 2878/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2879This section of the file contains hookable predicates to reason about 2880sources. The built-in code here can only deal with files. The XPCE 2881library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2882can do cross-referencing on PceEmacs edit buffers. Other examples for 2883hooking can be databases, (HTTP) URIs, etc. 2884- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2885 2886:- multifile 2887 prolog:xref_source_directory/2, % +Source, -Dir 2888 prolog:xref_source_file/3. % +Spec, -Path, +Options
2896xref_source_file(Plain, File, Source) :- 2897 xref_source_file(Plain, File, Source, []). 2898 2899xref_source_file(QSpec, File, Source, Options) :- 2900 nonvar(QSpec), QSpec = _:Spec, 2901 !, 2902 must_be(acyclic, Spec), 2903 xref_source_file(Spec, File, Source, Options). 2904xref_source_file(Spec, File, Source, Options) :- 2905 nonvar(Spec), 2906 prolog:xref_source_file(Spec, File, 2907 [ relative_to(Source) 2908 | Options 2909 ]), 2910 !. 2911xref_source_file(Plain, File, Source, Options) :- 2912 atom(Plain), 2913 \+ is_absolute_file_name(Plain), 2914 ( prolog:xref_source_directory(Source, Dir) 2915 -> true 2916 ; atom(Source), 2917 file_directory_name(Source, Dir) 2918 ), 2919 atomic_list_concat([Dir, /, Plain], Spec0), 2920 absolute_file_name(Spec0, Spec), 2921 do_xref_source_file(Spec, File, Options), 2922 !. 2923xref_source_file(Spec, File, Source, Options) :- 2924 do_xref_source_file(Spec, File, 2925 [ relative_to(Source) 2926 | Options 2927 ]), 2928 !. 2929xref_source_file(_, _, _, Options) :- 2930 option(silent(true), Options), 2931 !, 2932 fail. 2933xref_source_file(Spec, _, Src, _Options) :- 2934 verbose(Src), 2935 print_message(warning, error(existence_error(file, Spec), _)), 2936 fail. 2937 2938do_xref_source_file(Spec, File, Options) :- 2939 nonvar(Spec), 2940 option(file_type(Type), Options, prolog), 2941 absolute_file_name(Spec, File, 2942 [ file_type(Type), 2943 access(read), 2944 file_errors(fail) 2945 ]), 2946 !.
2952canonical_source(Source, Src) :-
2953 ( ground(Source)
2954 -> prolog_canonical_source(Source, Src)
2955 ; Source = Src
2956 ).
name()
goals.2963goal_name_arity(Goal, Name, Arity) :- 2964 ( compound(Goal) 2965 -> compound_name_arity(Goal, Name, Arity) 2966 ; atom(Goal) 2967 -> Name = Goal, Arity = 0 2968 ). 2969 2970generalise_term(Specific, General) :- 2971 ( compound(Specific) 2972 -> compound_name_arity(Specific, Name, Arity), 2973 compound_name_arity(General, Name, Arity) 2974 ; General = Specific 2975 ). 2976 2977functor_name(Term, Name) :- 2978 ( compound(Term) 2979 -> compound_name_arity(Term, Name, _) 2980 ; atom(Term) 2981 -> Name = Term 2982 ). 2983 2984rename_goal(Goal0, Name, Goal) :- 2985 ( compound(Goal0) 2986 -> compound_name_arity(Goal0, _, Arity), 2987 compound_name_arity(Goal, Name, Arity) 2988 ; Goal = Name 2989 )
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.