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-2018, 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_defined/3, % ?Source. ?Callable, -How 43 xref_definition_line/2, % +How, -Line 44 xref_exported/2, % ?Source, ?Callable 45 xref_module/2, % ?Source, ?Module 46 xref_uses_file/3, % ?Source, ?Spec, ?Path 47 xref_op/2, % ?Source, ?Op 48 xref_prolog_flag/4, % ?Source, ?Flag, ?Value, ?Line 49 xref_comment/3, % ?Source, ?Title, ?Comment 50 xref_comment/4, % ?Source, ?Head, ?Summary, ?Comment 51 xref_mode/3, % ?Source, ?Mode, ?Det 52 xref_option/2, % ?Source, ?Option 53 xref_clean/1, % +Source 54 xref_current_source/1, % ?Source 55 xref_done/2, % +Source, -When 56 xref_built_in/1, % ?Callable 57 xref_source_file/3, % +Spec, -Path, +Source 58 xref_source_file/4, % +Spec, -Path, +Source, +Options 59 xref_public_list/3, % +File, +Src, +Options 60 xref_public_list/4, % +File, -Path, -Export, +Src 61 xref_public_list/6, % +File, -Path, -Module, -Export, -Meta, +Src 62 xref_public_list/7, % +File, -Path, -Module, -Export, -Public, -Meta, +Src 63 xref_meta/3, % +Source, +Goal, -Called 64 xref_meta/2, % +Goal, -Called 65 xref_hook/1, % ?Callable 66 % XPCE class references 67 xref_used_class/2, % ?Source, ?ClassName 68 xref_defined_class/3 % ?Source, ?ClassName, -How 69 ]). 70:- use_module(library(debug), [debug/3]). 71:- use_module(library(lists), [append/3, append/2, member/2, select/3]). 72:- use_module(library(operators), [push_op/3]). 73:- use_module(library(shlib), [current_foreign_library/2]). 74:- use_module(library(ordsets)). 75:- use_module(library(prolog_source)). 76:- use_module(library(option)). 77:- use_module(library(error)). 78:- use_module(library(apply)). 79:- use_module(library(debug)). 80:- if(exists_source(library(pldoc))). 81:- use_module(library(pldoc), []). % Must be loaded before doc_process 82:- use_module(library(pldoc/doc_process)). 83:- endif. 84:- use_module(library(solution_sequences)). 85:- use_module(library(modules)). 86 87:- predicate_options(xref_source/2, 2, 88 [ silent(boolean), 89 module(atom), 90 register_called(oneof([all,non_iso,non_built_in])), 91 comments(oneof([store,collect,ignore])), 92 process_include(boolean) 93 ]). 94 95 96:- dynamic 97 called/4, % Head, Src, From, Cond 98 (dynamic)/3, % Head, Src, Line 99 (thread_local)/3, % Head, Src, Line 100 (multifile)/3, % Head, Src, Line 101 (public)/3, % Head, Src, Line 102 defined/3, % Head, Src, Line 103 meta_goal/3, % Head, Called, Src 104 foreign/3, % Head, Src, Line 105 constraint/3, % Head, Src, Line 106 imported/3, % Head, Src, From 107 exported/2, % Head, Src 108 xmodule/2, % Module, Src 109 uses_file/3, % Spec, Src, Path 110 xop/2, % Src, Op 111 source/2, % Src, Time 112 used_class/2, % Name, Src 113 defined_class/5, % Name, Super, Summary, Src, Line 114 (mode)/2, % Mode, Src 115 xoption/2, % Src, Option 116 xflag/4, % Name, Value, Src, Line 117 118 module_comment/3, % Src, Title, Comment 119 pred_comment/4, % Head, Src, Summary, Comment 120 pred_comment_link/3, % Head, Src, HeadTo 121 pred_mode/3. % Head, Src, Det 122 123:- create_prolog_flag(xref, false, [type(boolean)]).
141:- predicate_options(xref_source_file/4, 4, 142 [ file_type(oneof([txt,prolog,directory])), 143 silent(boolean) 144 ]). 145:- predicate_options(xref_public_list/3, 3, 146 [ path(-atom), 147 module(-atom), 148 exports(-list(any)), 149 public(-list(any)), 150 meta(-list(any)), 151 silent(boolean) 152 ]). 153 154 155 /******************************* 156 * HOOKS * 157 *******************************/
184:- multifile 185 prolog:called_by/4, % +Goal, +Module, +Context, -Called 186 prolog:called_by/2, % +Goal, -Called 187 prolog:meta_goal/2, % +Goal, -Pattern 188 prolog:hook/1, % +Callable 189 prolog:generated_predicate/1. % :PI 190 191:- meta_predicate 192 prolog:generated_predicate(). 193 194:- dynamic 195 meta_goal/2. 196 197:- meta_predicate 198 process_predicates(, , ). 199 200 /******************************* 201 * BUILT-INS * 202 *******************************/
register_called.210hide_called(Callable, Src) :- 211 xoption(Src, register_called(Which)), 212 !, 213 mode_hide_called(Which, Callable). 214hide_called(Callable, _) :- 215 mode_hide_called(non_built_in, Callable). 216 217mode_hide_called(all, _) :- !, fail. 218mode_hide_called(non_iso, _:Goal) :- 219 goal_name_arity(Goal, Name, Arity), 220 current_predicate(system:Name/Arity), 221 predicate_property(system:Goal, iso). 222mode_hide_called(non_built_in, _:Goal) :- 223 goal_name_arity(Goal, Name, Arity), 224 current_predicate(system:Name/Arity), 225 predicate_property(system:Goal, built_in). 226mode_hide_called(non_built_in, M:Goal) :- 227 goal_name_arity(Goal, Name, Arity), 228 current_predicate(M:Name/Arity), 229 predicate_property(M:Goal, built_in).
235system_predicate(Goal) :- 236 goal_name_arity(Goal, Name, Arity), 237 current_predicate(system:Name/Arity), % avoid autoloading 238 predicate_property(system:Goal, built_in), 239 !. 240 241 242 /******************************** 243 * TOPLEVEL * 244 ********************************/ 245 246verbose(Src) :- 247 \+ xoption(Src, silent(true)). 248 249:- thread_local 250 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).278xref_source(Source) :- 279 xref_source(Source, []). 280 281xref_source(Source, Options) :- 282 prolog_canonical_source(Source, Src), 283 ( last_modified(Source, Modified) 284 -> ( source(Src, Modified) 285 -> true 286 ; xref_clean(Src), 287 assert(source(Src, Modified)), 288 do_xref(Src, Options) 289 ) 290 ; xref_clean(Src), 291 get_time(Now), 292 assert(source(Src, Now)), 293 do_xref(Src, Options) 294 ). 295 296do_xref(Src, Options) :- 297 must_be(list, Options), 298 setup_call_cleanup( 299 xref_setup(Src, In, Options, State), 300 collect(Src, Src, In, Options), 301 xref_cleanup(State)). 302 303last_modified(Source, Modified) :- 304 prolog:xref_source_time(Source, Modified), 305 !. 306last_modified(Source, Modified) :- 307 atom(Source), 308 \+ is_global_url(Source), 309 exists_file(Source), 310 time_file(Source, Modified). 311 312is_global_url(File) :- 313 sub_atom(File, B, _, _, '://'), 314 !, 315 B > 1, 316 sub_atom(File, 0, B, _, Scheme), 317 atom_codes(Scheme, Codes), 318 maplist(between(0'a, 0'z), Codes). 319 320xref_setup(Src, In, Options, state(In, Dialect, Xref, [SRef|HRefs])) :- 321 maplist(assert_option(Src), Options), 322 assert_default_options(Src), 323 current_prolog_flag(emulated_dialect, Dialect), 324 prolog_open_source(Src, In), 325 set_initial_mode(In, Options), 326 asserta(xref_input(Src, In), SRef), 327 set_xref(Xref), 328 ( verbose(Src) 329 -> HRefs = [] 330 ; asserta(user:thread_message_hook(_,_,_), Ref), 331 HRefs = [Ref] 332 ). 333 334assert_option(_, Var) :- 335 var(Var), 336 !, 337 instantiation_error(Var). 338assert_option(Src, silent(Boolean)) :- 339 !, 340 must_be(boolean, Boolean), 341 assert(xoption(Src, silent(Boolean))). 342assert_option(Src, register_called(Which)) :- 343 !, 344 must_be(oneof([all,non_iso,non_built_in]), Which), 345 assert(xoption(Src, register_called(Which))). 346assert_option(Src, comments(CommentHandling)) :- 347 !, 348 must_be(oneof([store,collect,ignore]), CommentHandling), 349 assert(xoption(Src, comments(CommentHandling))). 350assert_option(Src, module(Module)) :- 351 !, 352 must_be(atom, Module), 353 assert(xoption(Src, module(Module))). 354assert_option(Src, process_include(Boolean)) :- 355 !, 356 must_be(boolean, Boolean), 357 assert(xoption(Src, process_include(Boolean))). 358 359assert_default_options(Src) :- 360 ( xref_option_default(Opt), 361 generalise_term(Opt, Gen), 362 ( xoption(Src, Gen) 363 -> true 364 ; assertz(xoption(Src, Opt)) 365 ), 366 fail 367 ; true 368 ). 369 370xref_option_default(silent(false)). 371xref_option_default(register_called(non_built_in)). 372xref_option_default(comments(collect)). 373xref_option_default(process_include(true)).
379xref_cleanup(state(In, Dialect, Xref, Refs)) :- 380 prolog_close_source(In), 381 set_prolog_flag(emulated_dialect, Dialect), 382 set_prolog_flag(xref, Xref), 383 maplist(erase, Refs). 384 385set_xref(Xref) :- 386 current_prolog_flag(xref, Xref), 387 set_prolog_flag(xref, true).
396set_initial_mode(_Stream, Options) :- 397 option(module(Module), Options), 398 !, 399 '$set_source_module'(Module). 400set_initial_mode(Stream, _) :- 401 stream_property(Stream, file_name(Path)), 402 source_file_property(Path, load_context(M, _, Opts)), 403 !, 404 '$set_source_module'(M), 405 ( option(dialect(Dialect), Opts) 406 -> expects_dialect(Dialect) 407 ; true 408 ). 409set_initial_mode(_, _) :- 410 '$set_source_module'(user).
416xref_input_stream(Stream) :-
417 xref_input(_, Var),
418 !,
419 Stream = Var.426xref_push_op(Src, P, T, N0) :- 427 '$current_source_module'(M0), 428 strip_module(M0:N0, M, N), 429 ( is_list(N), 430 N \== [] 431 -> maplist(push_op(Src, P, T, M), N) 432 ; push_op(Src, P, T, M, N) 433 ). 434 435push_op(Src, P, T, M0, N0) :- 436 strip_module(M0:N0, M, N), 437 Name = M:N, 438 valid_op(op(P,T,Name)), 439 push_op(P, T, Name), 440 assert_op(Src, op(P,T,Name)), 441 debug(xref(op), ':- ~w.', [op(P,T,Name)]). 442 443valid_op(op(P,T,M:N)) :- 444 atom(M), 445 valid_op_name(N), 446 integer(P), 447 between(0, 1200, P), 448 atom(T), 449 op_type(T). 450 451valid_op_name(N) :- 452 atom(N), 453 !. 454valid_op_name(N) :- 455 N == []. 456 457op_type(xf). 458op_type(yf). 459op_type(fx). 460op_type(fy). 461op_type(xfx). 462op_type(xfy). 463op_type(yfx).
469xref_set_prolog_flag(Flag, Value, Src, Line) :- 470 atom(Flag), 471 !, 472 assertz(xflag(Flag, Value, Src, Line)). 473xref_set_prolog_flag(_, _, _, _).
479xref_clean(Source) :- 480 prolog_canonical_source(Source, Src), 481 retractall(called(_, Src, _Origin, _Cond)), 482 retractall(dynamic(_, Src, Line)), 483 retractall(multifile(_, Src, Line)), 484 retractall(public(_, Src, Line)), 485 retractall(defined(_, Src, Line)), 486 retractall(meta_goal(_, _, Src)), 487 retractall(foreign(_, Src, Line)), 488 retractall(constraint(_, Src, Line)), 489 retractall(imported(_, Src, _From)), 490 retractall(exported(_, Src)), 491 retractall(uses_file(_, Src, _)), 492 retractall(xmodule(_, Src)), 493 retractall(xop(Src, _)), 494 retractall(xoption(Src, _)), 495 retractall(xflag(_Name, _Value, Src, Line)), 496 retractall(source(Src, _)), 497 retractall(used_class(_, Src)), 498 retractall(defined_class(_, _, _, Src, _)), 499 retractall(mode(_, Src)), 500 retractall(module_comment(Src, _, _)), 501 retractall(pred_comment(_, Src, _, _)), 502 retractall(pred_comment_link(_, Src, _)), 503 retractall(pred_mode(_, Src, _)). 504 505 506 /******************************* 507 * READ RESULTS * 508 *******************************/
514xref_current_source(Source) :-
515 source(Source, _Time).
522xref_done(Source, Time) :-
523 prolog_canonical_source(Source, Src),
524 source(Src, Time).533xref_called(Source, Called, By) :- 534 xref_called(Source, Called, By, _). 535 536xref_called(Source, Called, By, Cond) :- 537 canonical_source(Source, Src), 538 called(Called, Src, By, Cond).
include(File)) directive.
dynamic(Location)thread_local(Location)multifile(Location)public(Location)local(Location)foreign(Location)constraint(Location)imported(From)560xref_defined(Source, Called, How) :- 561 nonvar(Source), 562 !, 563 canonical_source(Source, Src), 564 xref_defined2(How, Src, Called). 565xref_defined(Source, Called, How) :- 566 xref_defined2(How, Src, Called), 567 canonical_source(Source, Src). 568 569xref_defined2(dynamic(Line), Src, Called) :- 570 dynamic(Called, Src, Line). 571xref_defined2(thread_local(Line), Src, Called) :- 572 thread_local(Called, Src, Line). 573xref_defined2(multifile(Line), Src, Called) :- 574 multifile(Called, Src, Line). 575xref_defined2(public(Line), Src, Called) :- 576 public(Called, Src, Line). 577xref_defined2(local(Line), Src, Called) :- 578 defined(Called, Src, Line). 579xref_defined2(foreign(Line), Src, Called) :- 580 foreign(Called, Src, Line). 581xref_defined2(constraint(Line), Src, Called) :- 582 constraint(Called, Src, Line). 583xref_defined2(imported(From), Src, Called) :- 584 imported(Called, Src, From).
592xref_definition_line(local(Line), Line). 593xref_definition_line(dynamic(Line), Line). 594xref_definition_line(thread_local(Line), Line). 595xref_definition_line(multifile(Line), Line). 596xref_definition_line(public(Line), Line). 597xref_definition_line(constraint(Line), Line). 598xref_definition_line(foreign(Line), Line).
605xref_exported(Source, Called) :-
606 prolog_canonical_source(Source, Src),
607 exported(Called, Src).613xref_module(Source, Module) :- 614 nonvar(Source), 615 !, 616 prolog_canonical_source(Source, Src), 617 xmodule(Module, Src). 618xref_module(Source, Module) :- 619 xmodule(Module, Src), 620 prolog_canonical_source(Source, Src).
630xref_uses_file(Source, Spec, Path) :-
631 prolog_canonical_source(Source, Src),
632 uses_file(Spec, Src, Path).
642xref_op(Source, Op) :-
643 prolog_canonical_source(Source, Src),
644 xop(Src, Op).652xref_prolog_flag(Source, Flag, Value, Line) :- 653 prolog_canonical_source(Source, Src), 654 xflag(Flag, Value, Src, Line). 655 656xref_built_in(Head) :- 657 system_predicate(Head). 658 659xref_used_class(Source, Class) :- 660 prolog_canonical_source(Source, Src), 661 used_class(Class, Src). 662 663xref_defined_class(Source, Class, local(Line, Super, Summary)) :- 664 prolog_canonical_source(Source, Src), 665 defined_class(Class, Super, Summary, Src, Line), 666 integer(Line), 667 !. 668xref_defined_class(Source, Class, file(File)) :- 669 prolog_canonical_source(Source, Src), 670 defined_class(Class, _, _, Src, file(File)). 671 672:- thread_local 673 current_cond/1, 674 source_line/1. 675 676current_source_line(Line) :- 677 source_line(Var), 678 !, 679 Line = Var.
687collect(Src, File, In, Options) :- 688 ( Src == File 689 -> SrcSpec = Line 690 ; SrcSpec = (File:Line) 691 ), 692 option(comments(CommentHandling), Options, collect), 693 ( CommentHandling == ignore 694 -> CommentOptions = [], 695 Comments = [] 696 ; CommentHandling == store 697 -> CommentOptions = [ process_comment(true) ], 698 Comments = [] 699 ; CommentOptions = [ comments(Comments) ] 700 ), 701 repeat, 702 catch(prolog_read_source_term( 703 In, Term, Expanded, 704 [ term_position(TermPos) 705 | CommentOptions 706 ]), 707 E, report_syntax_error(E, Src, [])), 708 update_condition(Term), 709 stream_position_data(line_count, TermPos, Line), 710 setup_call_cleanup( 711 asserta(source_line(SrcSpec), Ref), 712 catch(process(Expanded, Comments, TermPos, Src, EOF), 713 E, print_message(error, E)), 714 erase(Ref)), 715 EOF == true, 716 !. 717 718report_syntax_error(E, _, _) :- 719 fatal_error(E), 720 throw(E). 721report_syntax_error(_, _, Options) :- 722 option(silent(true), Options), 723 !, 724 fail. 725report_syntax_error(E, Src, _Options) :- 726 ( verbose(Src) 727 -> print_message(error, E) 728 ; true 729 ), 730 fail. 731 732fatal_error(time_limit_exceeded). 733fatal_error(error(resource_error(_),_)).
739update_condition((:-Directive)) :- 740 !, 741 update_cond(Directive). 742update_condition(_). 743 744update_cond(if(Cond)) :- 745 !, 746 asserta(current_cond(Cond)). 747update_cond(else) :- 748 retract(current_cond(C0)), 749 !, 750 assert(current_cond(\+C0)). 751update_cond(elif(Cond)) :- 752 retract(current_cond(C0)), 753 !, 754 assert(current_cond((\+C0,Cond))). 755update_cond(endif) :- 756 retract(current_cond(_)), 757 !. 758update_cond(_).
765current_condition(Condition) :- 766 \+ current_cond(_), 767 !, 768 Condition = true. 769current_condition(Condition) :- 770 findall(C, current_cond(C), List), 771 list_to_conj(List, Condition). 772 773list_to_conj([], true). 774list_to_conj([C], C) :- !. 775list_to_conj([H|T], (H,C)) :- 776 list_to_conj(T, C). 777 778 779 /******************************* 780 * PROCESS * 781 *******************************/
793process(Expanded, Comments, TermPos, Src, EOF) :- 794 is_list(Expanded), % term_expansion into list. 795 !, 796 ( member(Term, Expanded), 797 process(Term, Src), 798 Term == end_of_file 799 -> EOF = true 800 ; EOF = false 801 ), 802 xref_comments(Comments, TermPos, Src). 803process(end_of_file, _, _, _, true) :- 804 !. 805process(Term, Comments, TermPos, Src, false) :- 806 process(Term, Src), 807 xref_comments(Comments, TermPos, Src).
811process(Var, _) :- 812 var(Var), 813 !. % Warn? 814process(end_of_file, _) :- !. 815process((:- Directive), Src) :- 816 !, 817 process_directive(Directive, Src), 818 !. 819process((?- Directive), Src) :- 820 !, 821 process_directive(Directive, Src), 822 !. 823process((Head :- Body), Src) :- 824 !, 825 assert_defined(Src, Head), 826 process_body(Body, Head, Src). 827process('$source_location'(_File, _Line):Clause, Src) :- 828 !, 829 process(Clause, Src). 830process(Term, Src) :- 831 process_chr(Term, Src), 832 !. 833process(M:(Head :- Body), Src) :- 834 !, 835 process((M:Head :- M:Body), Src). 836process(Head, Src) :- 837 assert_defined(Src, Head). 838 839 840 /******************************* 841 * COMMENTS * 842 *******************************/
846xref_comments([], _Pos, _Src). 847:- if(current_predicate(parse_comment/3)). 848xref_comments([Pos-Comment|T], TermPos, Src) :- 849 ( Pos @> TermPos % comments inside term 850 -> true 851 ; stream_position_data(line_count, Pos, Line), 852 FilePos = Src:Line, 853 ( parse_comment(Comment, FilePos, Parsed) 854 -> assert_comments(Parsed, Src) 855 ; true 856 ), 857 xref_comments(T, TermPos, Src) 858 ). 859 860assert_comments([], _). 861assert_comments([H|T], Src) :- 862 assert_comment(H, Src), 863 assert_comments(T, Src). 864 865assert_comment(section(_Id, Title, Comment), Src) :- 866 assertz(module_comment(Src, Title, Comment)). 867assert_comment(predicate(PI, Summary, Comment), Src) :- 868 pi_to_head(PI, Src, Head), 869 assertz(pred_comment(Head, Src, Summary, Comment)). 870assert_comment(link(PI, PITo), Src) :- 871 pi_to_head(PI, Src, Head), 872 pi_to_head(PITo, Src, HeadTo), 873 assertz(pred_comment_link(Head, Src, HeadTo)). 874assert_comment(mode(Head, Det), Src) :- 875 assertz(pred_mode(Head, Src, Det)). 876 877pi_to_head(PI, Src, Head) :- 878 pi_to_head(PI, Head0), 879 ( Head0 = _:_ 880 -> strip_module(Head0, M, Plain), 881 ( xmodule(M, Src) 882 -> Head = Plain 883 ; Head = M:Plain 884 ) 885 ; Head = Head0 886 ). 887:- endif.
893xref_comment(Source, Title, Comment) :-
894 canonical_source(Source, Src),
895 module_comment(Src, Title, Comment).
901xref_comment(Source, Head, Summary, Comment) :-
902 canonical_source(Source, Src),
903 ( pred_comment(Head, Src, Summary, Comment)
904 ; pred_comment_link(Head, Src, HeadTo),
905 pred_comment(HeadTo, Src, Summary, Comment)
906 ).
913xref_mode(Source, Mode, Det) :-
914 canonical_source(Source, Src),
915 pred_mode(Mode, Src, Det).922xref_option(Source, Option) :- 923 canonical_source(Source, Src), 924 xoption(Src, Option). 925 926 927 /******************************** 928 * DIRECTIVES * 929 ********************************/ 930 931process_directive(Var, _) :- 932 var(Var), 933 !. % error, but that isn't our business 934process_directive(Dir, _Src) :- 935 debug(xref(directive), 'Processing :- ~q', [Dir]), 936 fail. 937process_directive((A,B), Src) :- % TBD: what about other control 938 !, 939 process_directive(A, Src), % structures? 940 process_directive(B, Src). 941process_directive(List, Src) :- 942 is_list(List), 943 !, 944 process_directive(consult(List), Src). 945process_directive(use_module(File, Import), Src) :- 946 process_use_module2(File, Import, Src, false). 947process_directive(expects_dialect(Dialect), Src) :- 948 process_directive(use_module(library(dialect/Dialect)), Src), 949 expects_dialect(Dialect). 950process_directive(reexport(File, Import), Src) :- 951 process_use_module2(File, Import, Src, true). 952process_directive(reexport(Modules), Src) :- 953 process_use_module(Modules, Src, true). 954process_directive(use_module(Modules), Src) :- 955 process_use_module(Modules, Src, false). 956process_directive(consult(Modules), Src) :- 957 process_use_module(Modules, Src, false). 958process_directive(ensure_loaded(Modules), Src) :- 959 process_use_module(Modules, Src, false). 960process_directive(load_files(Files, _Options), Src) :- 961 process_use_module(Files, Src, false). 962process_directive(include(Files), Src) :- 963 process_include(Files, Src). 964process_directive(dynamic(Dynamic), Src) :- 965 process_predicates(assert_dynamic, Dynamic, Src). 966process_directive(thread_local(Dynamic), Src) :- 967 process_predicates(assert_thread_local, Dynamic, Src). 968process_directive(multifile(Dynamic), Src) :- 969 process_predicates(assert_multifile, Dynamic, Src). 970process_directive(public(Public), Src) :- 971 process_predicates(assert_public, Public, Src). 972process_directive(export(Export), Src) :- 973 process_predicates(assert_export, Export, Src). 974process_directive(import(Import), Src) :- 975 process_import(Import, Src). 976process_directive(module(Module, Export), Src) :- 977 assert_module(Src, Module), 978 assert_module_export(Src, Export). 979process_directive(module(Module, Export, Import), Src) :- 980 assert_module(Src, Module), 981 assert_module_export(Src, Export), 982 assert_module3(Import, Src). 983process_directive('$set_source_module'(system), Src) :- 984 assert_module(Src, system). % hack for handling boot/init.pl 985process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 986 assert_defined_class(Src, Name, Meta, Super, Doc). 987process_directive(pce_autoload(Name, From), Src) :- 988 assert_defined_class(Src, Name, imported_from(From)). 989 990process_directive(op(P, A, N), Src) :- 991 xref_push_op(Src, P, A, N). 992process_directive(set_prolog_flag(Flag, Value), Src) :- 993 ( Flag == character_escapes 994 -> set_prolog_flag(character_escapes, Value) 995 ; true 996 ), 997 current_source_line(Line), 998 xref_set_prolog_flag(Flag, Value, Src, Line). 999process_directive(style_check(X), _) :- 1000 style_check(X). 1001process_directive(encoding(Enc), _) :- 1002 ( xref_input_stream(Stream) 1003 -> catch(set_stream(Stream, encoding(Enc)), _, true) 1004 ; true % can this happen? 1005 ). 1006process_directive(pce_expansion:push_compile_operators, _) :- 1007 '$current_source_module'(SM), 1008 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 1009process_directive(pce_expansion:pop_compile_operators, _) :- 1010 call(pce_expansion:pop_compile_operators). 1011process_directive(meta_predicate(Meta), Src) :- 1012 process_meta_predicate(Meta, Src). 1013process_directive(arithmetic_function(FSpec), Src) :- 1014 arith_callable(FSpec, Goal), 1015 !, 1016 current_source_line(Line), 1017 assert_called(Src, '<directive>'(Line), Goal). 1018process_directive(format_predicate(_, Goal), Src) :- 1019 !, 1020 current_source_line(Line), 1021 assert_called(Src, '<directive>'(Line), Goal). 1022process_directive(if(Cond), Src) :- 1023 !, 1024 current_source_line(Line), 1025 assert_called(Src, '<directive>'(Line), Cond). 1026process_directive(elif(Cond), Src) :- 1027 !, 1028 current_source_line(Line), 1029 assert_called(Src, '<directive>'(Line), Cond). 1030process_directive(else, _) :- !. 1031process_directive(endif, _) :- !. 1032process_directive(Goal, Src) :- 1033 current_source_line(Line), 1034 process_body(Goal, '<directive>'(Line), Src).
1040process_meta_predicate((A,B), Src) :- 1041 !, 1042 process_meta_predicate(A, Src), 1043 process_meta_predicate(B, Src). 1044process_meta_predicate(Decl, Src) :- 1045 process_meta_head(Src, Decl). 1046 1047process_meta_head(Src, Decl) :- % swapped arguments for maplist 1048 compound(Decl), 1049 compound_name_arity(Decl, Name, Arity), 1050 compound_name_arity(Head, Name, Arity), 1051 meta_args(1, Arity, Decl, Head, Meta), 1052 ( ( prolog:meta_goal(Head, _) 1053 ; prolog:called_by(Head, _, _, _) 1054 ; prolog:called_by(Head, _) 1055 ; meta_goal(Head, _) 1056 ) 1057 -> true 1058 ; assert(meta_goal(Head, Meta, Src)) 1059 ). 1060 1061meta_args(I, Arity, _, _, []) :- 1062 I > Arity, 1063 !. 1064meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1065 arg(I, Decl, 0), 1066 !, 1067 arg(I, Head, H), 1068 I2 is I + 1, 1069 meta_args(I2, Arity, Decl, Head, T). 1070meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1071 arg(I, Decl, ^), 1072 !, 1073 arg(I, Head, EH), 1074 setof_goal(EH, H), 1075 I2 is I + 1, 1076 meta_args(I2, Arity, Decl, Head, T). 1077meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1078 arg(I, Decl, //), 1079 !, 1080 arg(I, Head, H), 1081 I2 is I + 1, 1082 meta_args(I2, Arity, Decl, Head, T). 1083meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1084 arg(I, Decl, A), 1085 integer(A), A > 0, 1086 !, 1087 arg(I, Head, H), 1088 I2 is I + 1, 1089 meta_args(I2, Arity, Decl, Head, T). 1090meta_args(I, Arity, Decl, Head, Meta) :- 1091 I2 is I + 1, 1092 meta_args(I2, Arity, Decl, Head, Meta). 1093 1094 1095 /******************************** 1096 * BODY * 1097 ********************************/
1106xref_meta(Source, Head, Called) :-
1107 canonical_source(Source, Src),
1108 xref_meta_src(Head, Called, Src).1123xref_meta_src(Head, Called, Src) :- 1124 meta_goal(Head, Called, Src), 1125 !. 1126xref_meta_src(Head, Called, _) :- 1127 xref_meta(Head, Called), 1128 !. 1129xref_meta_src(Head, Called, _) :- 1130 compound(Head), 1131 compound_name_arity(Head, Name, Arity), 1132 apply_pred(Name), 1133 Arity > 5, 1134 !, 1135 Extra is Arity - 1, 1136 arg(1, Head, G), 1137 Called = [G+Extra]. 1138 1139apply_pred(call). % built-in 1140apply_pred(maplist). % library(apply_macros) 1141 1142xref_meta((A, B), [A, B]). 1143xref_meta((A; B), [A, B]). 1144xref_meta((A| B), [A, B]). 1145xref_meta((A -> B), [A, B]). 1146xref_meta((A *-> B), [A, B]). 1147xref_meta(findall(_V,G,_L), [G]). 1148xref_meta(findall(_V,G,_L,_T), [G]). 1149xref_meta(findnsols(_N,_V,G,_L), [G]). 1150xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1151xref_meta(setof(_V, EG, _L), [G]) :- 1152 setof_goal(EG, G). 1153xref_meta(bagof(_V, EG, _L), [G]) :- 1154 setof_goal(EG, G). 1155xref_meta(forall(A, B), [A, B]). 1156xref_meta(maplist(G,_), [G+1]). 1157xref_meta(maplist(G,_,_), [G+2]). 1158xref_meta(maplist(G,_,_,_), [G+3]). 1159xref_meta(maplist(G,_,_,_,_), [G+4]). 1160xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1161xref_meta(map_assoc(G, _), [G+1]). 1162xref_meta(map_assoc(G, _, _), [G+2]). 1163xref_meta(checklist(G, _L), [G+1]). 1164xref_meta(sublist(G, _, _), [G+1]). 1165xref_meta(include(G, _, _), [G+1]). 1166xref_meta(exclude(G, _, _), [G+1]). 1167xref_meta(partition(G, _, _, _, _), [G+2]). 1168xref_meta(partition(G, _, _, _),[G+1]). 1169xref_meta(call(G), [G]). 1170xref_meta(call(G, _), [G+1]). 1171xref_meta(call(G, _, _), [G+2]). 1172xref_meta(call(G, _, _, _), [G+3]). 1173xref_meta(call(G, _, _, _, _), [G+4]). 1174xref_meta(not(G), [G]). 1175xref_meta(notrace(G), [G]). 1176xref_meta(\+(G), [G]). 1177xref_meta(ignore(G), [G]). 1178xref_meta(once(G), [G]). 1179xref_meta(initialization(G), [G]). 1180xref_meta(initialization(G,_), [G]). 1181xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1182xref_meta(clause(G, _), [G]). 1183xref_meta(clause(G, _, _), [G]). 1184xref_meta(phrase(G, _A), [//(G)]). 1185xref_meta(phrase(G, _A, _R), [//(G)]). 1186xref_meta(call_dcg(G, _A, _R), [//(G)]). 1187xref_meta(phrase_from_file(G,_),[//(G)]). 1188xref_meta(catch(A, _, B), [A, B]). 1189xref_meta(catch_with_backtrace(A, _, B), [A, B]). 1190xref_meta(thread_create(A,_,_), [A]). 1191xref_meta(thread_create(A,_), [A]). 1192xref_meta(thread_signal(_,A), [A]). 1193xref_meta(thread_at_exit(A), [A]). 1194xref_meta(thread_initialization(A), [A]). 1195xref_meta(engine_create(_,A,_), [A]). 1196xref_meta(engine_create(_,A,_,_), [A]). 1197xref_meta(predsort(A,_,_), [A+3]). 1198xref_meta(call_cleanup(A, B), [A, B]). 1199xref_meta(call_cleanup(A, _, B),[A, B]). 1200xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1201xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1202xref_meta(call_residue_vars(A,_), [A]). 1203xref_meta(with_mutex(_,A), [A]). 1204xref_meta(assume(G), [G]). % library(debug) 1205xref_meta(assertion(G), [G]). % library(debug) 1206xref_meta(freeze(_, G), [G]). 1207xref_meta(when(C, A), [C, A]). 1208xref_meta(time(G), [G]). % development system 1209xref_meta(profile(G), [G]). 1210xref_meta(at_halt(G), [G]). 1211xref_meta(call_with_time_limit(_, G), [G]). 1212xref_meta(call_with_depth_limit(G, _, _), [G]). 1213xref_meta(call_with_inference_limit(G, _, _), [G]). 1214xref_meta(alarm(_, G, _), [G]). 1215xref_meta(alarm(_, G, _, _), [G]). 1216xref_meta('$add_directive_wic'(G), [G]). 1217xref_meta(with_output_to(_, G), [G]). 1218xref_meta(if(G), [G]). 1219xref_meta(elif(G), [G]). 1220xref_meta(meta_options(G,_,_), [G+1]). 1221xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1222xref_meta(distinct(G), [G]). % library(solution_sequences) 1223xref_meta(distinct(_, G), [G]). 1224xref_meta(order_by(_, G), [G]). 1225xref_meta(limit(_, G), [G]). 1226xref_meta(offset(_, G), [G]). 1227xref_meta(reset(G,_,_), [G]). 1228 1229 % XPCE meta-predicates 1230xref_meta(pce_global(_, new(_)), _) :- !, fail. 1231xref_meta(pce_global(_, B), [B+1]). 1232xref_meta(ifmaintainer(G), [G]). % used in manual 1233xref_meta(listen(_, G), [G]). % library(broadcast) 1234xref_meta(listen(_, _, G), [G]). 1235xref_meta(in_pce_thread(G), [G]). 1236 1237xref_meta(G, Meta) :- % call user extensions 1238 prolog:meta_goal(G, Meta). 1239xref_meta(G, Meta) :- % Generated from :- meta_predicate 1240 meta_goal(G, Meta). 1241 1242setof_goal(EG, G) :- 1243 var(EG), !, G = EG. 1244setof_goal(_^EG, G) :- 1245 !, 1246 setof_goal(EG, G). 1247setof_goal(G, G).
1254head_of(Var, _) :- 1255 var(Var), !, fail. 1256head_of((Head :- _), Head). 1257head_of(Head, Head).
1265xref_hook(Hook) :- 1266 prolog:hook(Hook). 1267xref_hook(Hook) :- 1268 hook(Hook). 1269 1270 1271hook(attr_portray_hook(_,_)). 1272hook(attr_unify_hook(_,_)). 1273hook(attribute_goals(_,_,_)). 1274hook(goal_expansion(_,_)). 1275hook(term_expansion(_,_)). 1276hook(resource(_,_,_)). 1277hook('$pred_option'(_,_,_,_)). 1278 1279hook(emacs_prolog_colours:goal_classification(_,_)). 1280hook(emacs_prolog_colours:term_colours(_,_)). 1281hook(emacs_prolog_colours:goal_colours(_,_)). 1282hook(emacs_prolog_colours:style(_,_)). 1283hook(emacs_prolog_colours:identify(_,_)). 1284hook(pce_principal:pce_class(_,_,_,_,_,_)). 1285hook(pce_principal:send_implementation(_,_,_)). 1286hook(pce_principal:get_implementation(_,_,_,_)). 1287hook(pce_principal:pce_lazy_get_method(_,_,_)). 1288hook(pce_principal:pce_lazy_send_method(_,_,_)). 1289hook(pce_principal:pce_uses_template(_,_)). 1290hook(prolog:locate_clauses(_,_)). 1291hook(prolog:message(_,_,_)). 1292hook(prolog:error_message(_,_,_)). 1293hook(prolog:message_location(_,_,_)). 1294hook(prolog:message_context(_,_,_)). 1295hook(prolog:message_line_element(_,_)). 1296hook(prolog:debug_control_hook(_)). 1297hook(prolog:help_hook(_)). 1298hook(prolog:show_profile_hook(_,_)). 1299hook(prolog:general_exception(_,_)). 1300hook(prolog:predicate_summary(_,_)). 1301hook(prolog:residual_goals(_,_)). 1302hook(prolog_edit:load). 1303hook(prolog_edit:locate(_,_,_)). 1304hook(shlib:unload_all_foreign_libraries). 1305hook(system:'$foreign_registered'(_, _)). 1306hook(predicate_options:option_decl(_,_,_)). 1307hook(user:exception(_,_,_)). 1308hook(user:file_search_path(_,_)). 1309hook(user:library_directory(_)). 1310hook(user:message_hook(_,_,_)). 1311hook(user:portray(_)). 1312hook(user:prolog_clause_name(_,_)). 1313hook(user:prolog_list_goal(_)). 1314hook(user:prolog_predicate_name(_,_)). 1315hook(user:prolog_trace_interception(_,_,_,_)). 1316hook(user:prolog_event_hook(_)). 1317hook(user:prolog_exception_hook(_,_,_,_)). 1318hook(sandbox:safe_primitive(_)). 1319hook(sandbox:safe_meta_predicate(_)). 1320hook(sandbox:safe_meta(_,_)). 1321hook(sandbox:safe_global_variable(_)). 1322hook(sandbox:safe_directive(_)).
1329arith_callable(Var, _) :- 1330 var(Var), !, fail. 1331arith_callable(Module:Spec, Module:Goal) :- 1332 !, 1333 arith_callable(Spec, Goal). 1334arith_callable(Name/Arity, Goal) :- 1335 PredArity is Arity + 1, 1336 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1347process_body(Body, Origin, Src) :-
1348 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1349 true).true if there was a
partial evalation inside Goal that has bound variables.1356process_goal(Var, _, _, _) :- 1357 var(Var), 1358 !. 1359process_goal(Goal, Origin, Src, P) :- 1360 Goal = (_,_), % problems 1361 !, 1362 phrase(conjunction(Goal), Goals), 1363 process_conjunction(Goals, Origin, Src, P). 1364process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1365 Goal = (_;_), % problems 1366 !, 1367 phrase(disjunction(Goal), Goals), 1368 forall(member(G, Goals), 1369 process_body(G, Origin, Src)). 1370process_goal(Goal, Origin, Src, P) :- 1371 ( ( xmodule(M, Src) 1372 -> true 1373 ; M = user 1374 ), 1375 ( predicate_property(M:Goal, imported_from(IM)) 1376 -> true 1377 ; IM = M 1378 ), 1379 prolog:called_by(Goal, IM, M, Called) 1380 ; prolog:called_by(Goal, Called) 1381 ), 1382 !, 1383 must_be(list, Called), 1384 assert_called(Src, Origin, Goal), 1385 process_called_list(Called, Origin, Src, P). 1386process_goal(Goal, Origin, Src, _) :- 1387 process_xpce_goal(Goal, Origin, Src), 1388 !. 1389process_goal(load_foreign_library(File), _Origin, Src, _) :- 1390 process_foreign(File, Src). 1391process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1392 process_foreign(File, Src). 1393process_goal(use_foreign_library(File), _Origin, Src, _) :- 1394 process_foreign(File, Src). 1395process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1396 process_foreign(File, Src). 1397process_goal(Goal, Origin, Src, P) :- 1398 xref_meta_src(Goal, Metas, Src), 1399 !, 1400 assert_called(Src, Origin, Goal), 1401 process_called_list(Metas, Origin, Src, P). 1402process_goal(Goal, Origin, Src, _) :- 1403 asserting_goal(Goal, Rule), 1404 !, 1405 assert_called(Src, Origin, Goal), 1406 process_assert(Rule, Origin, Src). 1407process_goal(Goal, Origin, Src, P) :- 1408 partial_evaluate(Goal, P), 1409 assert_called(Src, Origin, Goal). 1410 1411disjunction(Var) --> {var(Var), !}, [Var]. 1412disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1413disjunction(G) --> [G]. 1414 1415conjunction(Var) --> {var(Var), !}, [Var]. 1416conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1417conjunction(G) --> [G]. 1418 (RVars, T) :- 1420 term_variables(T, TVars0), 1421 sort(TVars0, TVars), 1422 ord_intersect(RVars, TVars). 1423 1424process_conjunction([], _, _, _). 1425process_conjunction([Disj|Rest], Origin, Src, P) :- 1426 nonvar(Disj), 1427 Disj = (_;_), 1428 Rest \== [], 1429 !, 1430 phrase(disjunction(Disj), Goals), 1431 term_variables(Rest, RVars0), 1432 sort(RVars0, RVars), 1433 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1434 forall(member(G, NonSHaring), 1435 process_body(G, Origin, Src)), 1436 ( Sharing == [] 1437 -> true 1438 ; maplist(term_variables, Sharing, GVars0), 1439 append(GVars0, GVars1), 1440 sort(GVars1, GVars), 1441 ord_intersection(GVars, RVars, SVars), 1442 VT =.. [v|SVars], 1443 findall(VT, 1444 ( member(G, Sharing), 1445 process_goal(G, Origin, Src, PS), 1446 PS == true 1447 ), 1448 Alts0), 1449 ( Alts0 == [] 1450 -> true 1451 ; ( true 1452 ; P = true, 1453 sort(Alts0, Alts1), 1454 variants(Alts1, 10, Alts), 1455 member(VT, Alts) 1456 ) 1457 ) 1458 ), 1459 process_conjunction(Rest, Origin, Src, P). 1460process_conjunction([H|T], Origin, Src, P) :- 1461 process_goal(H, Origin, Src, P), 1462 process_conjunction(T, Origin, Src, P). 1463 1464 1465process_called_list([], _, _, _). 1466process_called_list([H|T], Origin, Src, P) :- 1467 process_meta(H, Origin, Src, P), 1468 process_called_list(T, Origin, Src, P). 1469 1470process_meta(A+N, Origin, Src, P) :- 1471 !, 1472 ( extend(A, N, AX) 1473 -> process_goal(AX, Origin, Src, P) 1474 ; true 1475 ). 1476process_meta(//(A), Origin, Src, P) :- 1477 !, 1478 process_dcg_goal(A, Origin, Src, P). 1479process_meta(G, Origin, Src, P) :- 1480 process_goal(G, Origin, Src, P).
1487process_dcg_goal(Var, _, _, _) :- 1488 var(Var), 1489 !. 1490process_dcg_goal((A,B), Origin, Src, P) :- 1491 !, 1492 process_dcg_goal(A, Origin, Src, P), 1493 process_dcg_goal(B, Origin, Src, P). 1494process_dcg_goal((A;B), Origin, Src, P) :- 1495 !, 1496 process_dcg_goal(A, Origin, Src, P), 1497 process_dcg_goal(B, Origin, Src, P). 1498process_dcg_goal((A|B), Origin, Src, P) :- 1499 !, 1500 process_dcg_goal(A, Origin, Src, P), 1501 process_dcg_goal(B, Origin, Src, P). 1502process_dcg_goal((A->B), Origin, Src, P) :- 1503 !, 1504 process_dcg_goal(A, Origin, Src, P), 1505 process_dcg_goal(B, Origin, Src, P). 1506process_dcg_goal((A*->B), Origin, Src, P) :- 1507 !, 1508 process_dcg_goal(A, Origin, Src, P), 1509 process_dcg_goal(B, Origin, Src, P). 1510process_dcg_goal({Goal}, Origin, Src, P) :- 1511 !, 1512 process_goal(Goal, Origin, Src, P). 1513process_dcg_goal(List, _Origin, _Src, _) :- 1514 is_list(List), 1515 !. % terminal 1516process_dcg_goal(List, _Origin, _Src, _) :- 1517 string(List), 1518 !. % terminal 1519process_dcg_goal(Callable, Origin, Src, P) :- 1520 extend(Callable, 2, Goal), 1521 !, 1522 process_goal(Goal, Origin, Src, P). 1523process_dcg_goal(_, _, _, _). 1524 1525 1526extend(Var, _, _) :- 1527 var(Var), !, fail. 1528extend(M:G, N, M:GX) :- 1529 !, 1530 callable(G), 1531 extend(G, N, GX). 1532extend(G, N, GX) :- 1533 ( compound(G) 1534 -> compound_name_arguments(G, Name, Args), 1535 length(Rest, N), 1536 append(Args, Rest, NArgs), 1537 compound_name_arguments(GX, Name, NArgs) 1538 ; atom(G) 1539 -> length(NArgs, N), 1540 compound_name_arguments(GX, G, NArgs) 1541 ). 1542 1543asserting_goal(assert(Rule), Rule). 1544asserting_goal(asserta(Rule), Rule). 1545asserting_goal(assertz(Rule), Rule). 1546asserting_goal(assert(Rule,_), Rule). 1547asserting_goal(asserta(Rule,_), Rule). 1548asserting_goal(assertz(Rule,_), Rule). 1549 1550process_assert(0, _, _) :- !. % catch variables 1551process_assert((_:-Body), Origin, Src) :- 1552 !, 1553 process_body(Body, Origin, Src). 1554process_assert(_, _, _).
1558variants([], _, []). 1559variants([H|T], Max, List) :- 1560 variants(T, H, Max, List). 1561 1562variants([], H, _, [H]). 1563variants(_, _, 0, []) :- !. 1564variants([H|T], V, Max, List) :- 1565 ( H =@= V 1566 -> variants(T, V, Max, List) 1567 ; List = [V|List2], 1568 Max1 is Max-1, 1569 variants(T, H, Max1, List2) 1570 ).
T = hello(X),
findall(T, T, List),
1584partial_evaluate(Goal, P) :- 1585 eval(Goal), 1586 !, 1587 P = true. 1588partial_evaluate(_, _). 1589 1590eval(X = Y) :- 1591 unify_with_occurs_check(X, Y). 1592 1593 1594 /******************************* 1595 * XPCE STUFF * 1596 *******************************/ 1597 1598pce_goal(new(_,_), new(-, new)). 1599pce_goal(send(_,_), send(arg, msg)). 1600pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1601pce_goal(get(_,_,_), get(arg, msg, -)). 1602pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1603pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1604pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1605 1606process_xpce_goal(G, Origin, Src) :- 1607 pce_goal(G, Process), 1608 !, 1609 assert_called(Src, Origin, G), 1610 ( arg(I, Process, How), 1611 arg(I, G, Term), 1612 process_xpce_arg(How, Term, Origin, Src), 1613 fail 1614 ; true 1615 ). 1616 1617process_xpce_arg(new, Term, Origin, Src) :- 1618 callable(Term), 1619 process_new(Term, Origin, Src). 1620process_xpce_arg(arg, Term, Origin, Src) :- 1621 compound(Term), 1622 process_new(Term, Origin, Src). 1623process_xpce_arg(msg, Term, Origin, Src) :- 1624 compound(Term), 1625 ( arg(_, Term, Arg), 1626 process_xpce_arg(arg, Arg, Origin, Src), 1627 fail 1628 ; true 1629 ). 1630 1631process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1632process_new(Term, Origin, Src) :- 1633 assert_new(Src, Origin, Term), 1634 ( compound(Term), 1635 arg(_, Term, Arg), 1636 process_xpce_arg(arg, Arg, Origin, Src), 1637 fail 1638 ; true 1639 ). 1640 1641assert_new(_, _, Term) :- 1642 \+ callable(Term), 1643 !. 1644assert_new(Src, Origin, Control) :- 1645 functor_name(Control, Class), 1646 pce_control_class(Class), 1647 !, 1648 forall(arg(_, Control, Arg), 1649 assert_new(Src, Origin, Arg)). 1650assert_new(Src, Origin, Term) :- 1651 compound(Term), 1652 arg(1, Term, Prolog), 1653 Prolog == @(prolog), 1654 ( Term =.. [message, _, Selector | T], 1655 atom(Selector) 1656 -> Called =.. [Selector|T], 1657 process_body(Called, Origin, Src) 1658 ; Term =.. [?, _, Selector | T], 1659 atom(Selector) 1660 -> append(T, [_R], T2), 1661 Called =.. [Selector|T2], 1662 process_body(Called, Origin, Src) 1663 ), 1664 fail. 1665assert_new(_, _, @(_)) :- !. 1666assert_new(Src, _, Term) :- 1667 functor_name(Term, Name), 1668 assert_used_class(Src, Name). 1669 1670 1671pce_control_class(and). 1672pce_control_class(or). 1673pce_control_class(if). 1674pce_control_class(not). 1675 1676 1677 /******************************** 1678 * INCLUDED MODULES * 1679 ********************************/
1683process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1684process_use_module([], _, _) :- !. 1685process_use_module([H|T], Src, Reexport) :- 1686 !, 1687 process_use_module(H, Src, Reexport), 1688 process_use_module(T, Src, Reexport). 1689process_use_module(library(pce), Src, Reexport) :- % bit special 1690 !, 1691 xref_public_list(library(pce), Path, Exports, Src), 1692 forall(member(Import, Exports), 1693 process_pce_import(Import, Src, Path, Reexport)). 1694process_use_module(File, Src, Reexport) :- 1695 ( xoption(Src, silent(Silent)) 1696 -> Extra = [silent(Silent)] 1697 ; Extra = [silent(true)] 1698 ), 1699 ( xref_public_list(File, Src, 1700 [ path(Path), 1701 module(M), 1702 exports(Exports), 1703 public(Public), 1704 meta(Meta) 1705 | Extra 1706 ]) 1707 -> assert(uses_file(File, Src, Path)), 1708 assert_import(Src, Exports, _, Path, Reexport), 1709 assert_xmodule_callable(Exports, M, Src, Path), 1710 assert_xmodule_callable(Public, M, Src, Path), 1711 maplist(process_meta_head(Src), Meta), 1712 ( File = library(chr) % hacky 1713 -> assert(mode(chr, Src)) 1714 ; true 1715 ) 1716 ; assert(uses_file(File, Src, '<not_found>')) 1717 ). 1718 1719process_pce_import(Name/Arity, Src, Path, Reexport) :- 1720 atom(Name), 1721 integer(Arity), 1722 !, 1723 functor(Term, Name, Arity), 1724 ( \+ system_predicate(Term), 1725 \+ Term = pce_error(_) % hack!? 1726 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1727 ; true 1728 ). 1729process_pce_import(op(P,T,N), Src, _, _) :- 1730 xref_push_op(Src, P, T, N).
1736process_use_module2(File, Import, Src, Reexport) :-
1737 ( xref_source_file(File, Path, Src)
1738 -> assert(uses_file(File, Src, Path)),
1739 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1740 -> assert_import(Src, Import, Export, Path, Reexport),
1741 forall(( member(Head, Meta),
1742 imported(Head, _, Path)
1743 ),
1744 process_meta_head(Src, Head))
1745 ; true
1746 )
1747 ; assert(uses_file(File, Src, '<not_found>'))
1748 ).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.
1779xref_public_list(File, Src, Options) :-
1780 option(path(Path), Options, _),
1781 option(module(Module), Options, _),
1782 option(exports(Exports), Options, _),
1783 option(public(Public), Options, _),
1784 option(meta(Meta), Options, _),
1785 xref_source_file(File, Path, Src, Options),
1786 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
1808xref_public_list(File, Path, Export, Src) :- 1809 xref_source_file(File, Path, Src), 1810 public_list(Path, _, _, Export, _, []). 1811xref_public_list(File, Path, Module, Export, Meta, Src) :- 1812 xref_source_file(File, Path, Src), 1813 public_list(Path, Module, Meta, Export, _, []). 1814xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 1815 xref_source_file(File, Path, Src), 1816 public_list(Path, Module, Meta, Export, Public, []).
true, ignore (syntax) errors. If not specified the default
is inherited from xref_source/2.1826:- dynamic public_list_cache/6. 1827:- volatile public_list_cache/6. 1828 1829public_list(Path, Module, Meta, Export, Public, _Options) :- 1830 public_list_cache(Path, Modified, 1831 Module0, Meta0, Export0, Public0), 1832 time_file(Path, ModifiedNow), 1833 ( abs(Modified-ModifiedNow) < 0.0001 1834 -> !, 1835 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0) 1836 ; retractall(public_list_cache(Path, _, _, _, _, _)), 1837 fail 1838 ). 1839public_list(Path, Module, Meta, Export, Public, Options) :- 1840 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options), 1841 ( Error = error(_,_), 1842 catch(time_file(Path, Modified), Error, fail) 1843 -> asserta(public_list_cache(Path, Modified, 1844 Module0, Meta0, Export0, Public0)) 1845 ; true 1846 ), 1847 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0). 1848 1849public_list_nc(Path, Module, Meta, Export, Public, Options) :- 1850 in_temporary_module( 1851 TempModule, 1852 true, 1853 public_list_diff(TempModule, Path, Module, 1854 Meta, [], Export, [], Public, [], Options)). 1855 1856 1857public_list_diff(TempModule, 1858 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 1859 setup_call_cleanup( 1860 public_list_setup(TempModule, Path, In, State), 1861 phrase(read_directives(In, Options, [true]), Directives), 1862 public_list_cleanup(In, State)), 1863 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 1864 1865public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :- 1866 prolog_open_source(Path, In), 1867 '$set_source_module'(OldM, TempModule), 1868 set_xref(OldXref). 1869 1870public_list_cleanup(In, state(OldM, OldXref)) :- 1871 '$set_source_module'(OldM), 1872 set_prolog_flag(xref, OldXref), 1873 prolog_close_source(In). 1874 1875 1876read_directives(In, Options, State) --> 1877 { repeat, 1878 catch(prolog_read_source_term(In, Term, Expanded, 1879 [ process_comment(true), 1880 syntax_errors(error) 1881 ]), 1882 E, report_syntax_error(E, -, Options)) 1883 -> nonvar(Term), 1884 Term = (:-_) 1885 }, 1886 !, 1887 terms(Expanded, State, State1), 1888 read_directives(In, Options, State1). 1889read_directives(_, _, _) --> []. 1890 1891terms(Var, State, State) --> { var(Var) }, !. 1892terms([H|T], State0, State) --> 1893 !, 1894 terms(H, State0, State1), 1895 terms(T, State1, State). 1896terms((:-if(Cond)), State0, [True|State0]) --> 1897 !, 1898 { eval_cond(Cond, True) }. 1899terms((:-elif(Cond)), [True0|State], [True|State]) --> 1900 !, 1901 { eval_cond(Cond, True1), 1902 elif(True0, True1, True) 1903 }. 1904terms((:-else), [True0|State], [True|State]) --> 1905 !, 1906 { negate(True0, True) }. 1907terms((:-endif), [_|State], State) --> !. 1908terms(H, State, State) --> 1909 ( {State = [true|_]} 1910 -> [H] 1911 ; [] 1912 ). 1913 1914eval_cond(Cond, true) :- 1915 catch(Cond, _, fail), 1916 !. 1917eval_cond(_, false). 1918 1919elif(true, _, else_false) :- !. 1920elif(false, true, true) :- !. 1921elif(True, _, True). 1922 1923negate(true, false). 1924negate(false, true). 1925negate(else_false, else_false). 1926 1927public_list([(:- module(Module, Export0))|Decls], Path, 1928 Module, Meta, MT, Export, Rest, Public, PT) :- 1929 !, 1930 append(Export0, Reexport, Export), 1931 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 1932public_list([(:- encoding(_))|Decls], Path, 1933 Module, Meta, MT, Export, Rest, Public, PT) :- 1934 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 1935 1936public_list_([], _, Meta, Meta, Export, Export, Public, Public). 1937public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 1938 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 1939 !, 1940 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 1941public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 1942 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 1943 1944public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 1945 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 1946public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 1947 public_from_import(Import, Spec, Path, Reexport, Rest). 1948public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 1949 phrase(meta_decls(Decl), Meta, MT). 1950public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 1951 phrase(public_decls(Decl), Public, PT).
1957reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 1958reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :- 1959 !, 1960 xref_source_file(H, Path, Src), 1961 public_list(Path, _Module, Meta0, Export0, Public0, []), 1962 append(Meta0, MT1, Meta), 1963 append(Export0, ET1, Export), 1964 append(Public0, PT1, Public), 1965 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT). 1966reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :- 1967 xref_source_file(Spec, Path, Src), 1968 public_list(Path, _Module, Meta0, Export0, Public0, []), 1969 append(Meta0, MT, Meta), 1970 append(Export0, ET, Export), 1971 append(Public0, PT, Public). 1972 1973public_from_import(except(Map), Path, Src, Export, Rest) :- 1974 !, 1975 xref_public_list(Path, _, AllExports, Src), 1976 except(Map, AllExports, NewExports), 1977 append(NewExports, Rest, Export). 1978public_from_import(Import, _, _, Export, Rest) :- 1979 import_name_map(Import, Export, Rest).
1984except([], Exports, Exports). 1985except([PI0 as NewName|Map], Exports0, Exports) :- 1986 !, 1987 canonical_pi(PI0, PI), 1988 map_as(Exports0, PI, NewName, Exports1), 1989 except(Map, Exports1, Exports). 1990except([PI0|Map], Exports0, Exports) :- 1991 canonical_pi(PI0, PI), 1992 select(PI2, Exports0, Exports1), 1993 same_pi(PI, PI2), 1994 !, 1995 except(Map, Exports1, Exports). 1996 1997 1998map_as([PI|T], Repl, As, [PI2|T]) :- 1999 same_pi(Repl, PI), 2000 !, 2001 pi_as(PI, As, PI2). 2002map_as([H|T0], Repl, As, [H|T]) :- 2003 map_as(T0, Repl, As, T). 2004 2005pi_as(_/Arity, Name, Name/Arity). 2006pi_as(_//Arity, Name, Name//Arity). 2007 2008import_name_map([], L, L). 2009import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 2010 !, 2011 import_name_map(T0, T, Tail). 2012import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 2013 !, 2014 import_name_map(T0, T, Tail). 2015import_name_map([H|T0], [H|T], Tail) :- 2016 import_name_map(T0, T, Tail). 2017 2018canonical_pi(Name//Arity0, PI) :- 2019 integer(Arity0), 2020 !, 2021 PI = Name/Arity, 2022 Arity is Arity0 + 2. 2023canonical_pi(PI, PI). 2024 2025same_pi(Canonical, PI2) :- 2026 canonical_pi(PI2, Canonical). 2027 2028meta_decls(Var) --> 2029 { var(Var) }, 2030 !. 2031meta_decls((A,B)) --> 2032 !, 2033 meta_decls(A), 2034 meta_decls(B). 2035meta_decls(A) --> 2036 [A]. 2037 2038public_decls(Var) --> 2039 { var(Var) }, 2040 !. 2041public_decls((A,B)) --> 2042 !, 2043 public_decls(A), 2044 public_decls(B). 2045public_decls(A) --> 2046 [A]. 2047 2048 /******************************* 2049 * INCLUDE * 2050 *******************************/ 2051 2052process_include([], _) :- !. 2053process_include([H|T], Src) :- 2054 !, 2055 process_include(H, Src), 2056 process_include(T, Src). 2057process_include(File, Src) :- 2058 callable(File), 2059 !, 2060 ( once(xref_input(ParentSrc, _)), 2061 xref_source_file(File, Path, ParentSrc) 2062 -> ( ( uses_file(_, Src, Path) 2063 ; Path == Src 2064 ) 2065 -> true 2066 ; assert(uses_file(File, Src, Path)), 2067 ( xoption(Src, process_include(true)) 2068 -> findall(O, xoption(Src, O), Options), 2069 setup_call_cleanup( 2070 open_include_file(Path, In, Refs), 2071 collect(Src, Path, In, Options), 2072 close_include(In, Refs)) 2073 ; true 2074 ) 2075 ) 2076 ; assert(uses_file(File, Src, '<not_found>')) 2077 ). 2078process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.2086open_include_file(Path, In, [Ref]) :- 2087 once(xref_input(_, Parent)), 2088 stream_property(Parent, encoding(Enc)), 2089 '$push_input_context'(xref_include), 2090 catch(( prolog:xref_open_source(Path, In) 2091 -> set_stream(In, encoding(Enc)) 2092 ; include_encoding(Enc, Options), 2093 open(Path, read, In, Options) 2094 ), E, 2095 ( '$pop_input_context', throw(E))), 2096 catch(( peek_char(In, #) % Deal with #! script 2097 -> skip(In, 10) 2098 ; true 2099 ), E, 2100 ( close_include(In, []), throw(E))), 2101 asserta(xref_input(Path, In), Ref). 2102 2103include_encoding(wchar_t, []) :- !. 2104include_encoding(Enc, [encoding(Enc)]). 2105 2106 2107close_include(In, Refs) :- 2108 maplist(erase, Refs), 2109 close(In, [force(true)]), 2110 '$pop_input_context'.
2116process_foreign(Spec, Src) :- 2117 ground(Spec), 2118 current_foreign_library(Spec, Defined), 2119 !, 2120 ( xmodule(Module, Src) 2121 -> true 2122 ; Module = user 2123 ), 2124 process_foreign_defined(Defined, Module, Src). 2125process_foreign(_, _). 2126 2127process_foreign_defined([], _, _). 2128process_foreign_defined([H|T], M, Src) :- 2129 ( H = M:Head 2130 -> assert_foreign(Src, Head) 2131 ; assert_foreign(Src, H) 2132 ), 2133 process_foreign_defined(T, M, Src). 2134 2135 2136 /******************************* 2137 * CHR SUPPORT * 2138 *******************************/ 2139 2140/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2141This part of the file supports CHR. Our choice is between making special 2142hooks to make CHR expansion work and then handle the (complex) expanded 2143code or process the CHR source directly. The latter looks simpler, 2144though I don't like the idea of adding support for libraries to this 2145module. A file is supposed to be a CHR file if it uses a 2146use_module(library(chr) or contains a :- constraint/1 directive. As an 2147extra bonus we get the source-locations right :-) 2148- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2149 2150process_chr(@(_Name, Rule), Src) :- 2151 mode(chr, Src), 2152 process_chr(Rule, Src). 2153process_chr(pragma(Rule, _Pragma), Src) :- 2154 mode(chr, Src), 2155 process_chr(Rule, Src). 2156process_chr(<=>(Head, Body), Src) :- 2157 mode(chr, Src), 2158 chr_head(Head, Src, H), 2159 chr_body(Body, H, Src). 2160process_chr(==>(Head, Body), Src) :- 2161 mode(chr, Src), 2162 chr_head(Head, H, Src), 2163 chr_body(Body, H, Src). 2164process_chr((:- chr_constraint(_)), Src) :- 2165 ( mode(chr, Src) 2166 -> true 2167 ; assert(mode(chr, Src)) 2168 ). 2169 2170chr_head(X, _, _) :- 2171 var(X), 2172 !. % Illegal. Warn? 2173chr_head(\(A,B), Src, H) :- 2174 chr_head(A, Src, H), 2175 process_body(B, H, Src). 2176chr_head((H0,B), Src, H) :- 2177 chr_defined(H0, Src, H), 2178 process_body(B, H, Src). 2179chr_head(H0, Src, H) :- 2180 chr_defined(H0, Src, H). 2181 2182chr_defined(X, _, _) :- 2183 var(X), 2184 !. 2185chr_defined(#(C,_Id), Src, C) :- 2186 !, 2187 assert_constraint(Src, C). 2188chr_defined(A, Src, A) :- 2189 assert_constraint(Src, A). 2190 2191chr_body(X, From, Src) :- 2192 var(X), 2193 !, 2194 process_body(X, From, Src). 2195chr_body('|'(Guard, Goals), H, Src) :- 2196 !, 2197 chr_body(Guard, H, Src), 2198 chr_body(Goals, H, Src). 2199chr_body(G, From, Src) :- 2200 process_body(G, From, Src). 2201 2202assert_constraint(_, Head) :- 2203 var(Head), 2204 !. 2205assert_constraint(Src, Head) :- 2206 constraint(Head, Src, _), 2207 !. 2208assert_constraint(Src, Head) :- 2209 generalise_term(Head, Term), 2210 current_source_line(Line), 2211 assert(constraint(Term, Src, Line)). 2212 2213 2214 /******************************** 2215 * PHASE 1 ASSERTIONS * 2216 ********************************/
2223assert_called(_, _, Var) :- 2224 var(Var), 2225 !. 2226assert_called(Src, From, Goal) :- 2227 var(From), 2228 !, 2229 assert_called(Src, '<unknown>', Goal). 2230assert_called(_, _, Goal) :- 2231 expand_hide_called(Goal), 2232 !. 2233assert_called(Src, Origin, M:G) :- 2234 !, 2235 ( atom(M), 2236 callable(G) 2237 -> current_condition(Cond), 2238 ( xmodule(M, Src) % explicit call to own module 2239 -> assert_called(Src, Origin, G) 2240 ; called(M:G, Src, Origin, Cond) % already registered 2241 -> true 2242 ; hide_called(M:G, Src) % not interesting (now) 2243 -> true 2244 ; generalise(Origin, OTerm), 2245 generalise(G, GTerm) 2246 -> assert(called(M:GTerm, Src, OTerm, Cond)) 2247 ; true 2248 ) 2249 ; true % call to variable module 2250 ). 2251assert_called(Src, _, Goal) :- 2252 ( xmodule(M, Src) 2253 -> M \== system 2254 ; M = user 2255 ), 2256 hide_called(M:Goal, Src), 2257 !. 2258assert_called(Src, Origin, Goal) :- 2259 current_condition(Cond), 2260 ( called(Goal, Src, Origin, Cond) 2261 -> true 2262 ; generalise(Origin, OTerm), 2263 generalise(Goal, Term) 2264 -> assert(called(Term, Src, OTerm, Cond)) 2265 ; true 2266 ).
2274expand_hide_called(pce_principal:send_implementation(_, _, _)). 2275expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2276expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2277expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2278 2279assert_defined(Src, Goal) :- 2280 defined(Goal, Src, _), 2281 !. 2282assert_defined(Src, Goal) :- 2283 generalise(Goal, Term), 2284 current_source_line(Line), 2285 assert(defined(Term, Src, Line)). 2286 2287assert_foreign(Src, Goal) :- 2288 foreign(Goal, Src, _), 2289 !. 2290assert_foreign(Src, Goal) :- 2291 generalise(Goal, Term), 2292 current_source_line(Line), 2293 assert(foreign(Term, Src, Line)).
true, re-export the
imported predicates.
2305assert_import(_, [], _, _, _) :- !. 2306assert_import(Src, [H|T], Export, From, Reexport) :- 2307 !, 2308 assert_import(Src, H, Export, From, Reexport), 2309 assert_import(Src, T, Export, From, Reexport). 2310assert_import(Src, except(Except), Export, From, Reexport) :- 2311 !, 2312 is_list(Export), 2313 !, 2314 except(Except, Export, Import), 2315 assert_import(Src, Import, _All, From, Reexport). 2316assert_import(Src, Import as Name, Export, From, Reexport) :- 2317 !, 2318 pi_to_head(Import, Term0), 2319 rename_goal(Term0, Name, Term), 2320 ( in_export_list(Term0, Export) 2321 -> assert(imported(Term, Src, From)), 2322 assert_reexport(Reexport, Src, Term) 2323 ; current_source_line(Line), 2324 assert_called(Src, '<directive>'(Line), Term0) 2325 ). 2326assert_import(Src, Import, Export, From, Reexport) :- 2327 pi_to_head(Import, Term), 2328 !, 2329 ( in_export_list(Term, Export) 2330 -> assert(imported(Term, Src, From)), 2331 assert_reexport(Reexport, Src, Term) 2332 ; current_source_line(Line), 2333 assert_called(Src, '<directive>'(Line), Term) 2334 ). 2335assert_import(Src, op(P,T,N), _, _, _) :- 2336 xref_push_op(Src, P,T,N). 2337 2338in_export_list(_Head, Export) :- 2339 var(Export), 2340 !. 2341in_export_list(Head, Export) :- 2342 member(PI, Export), 2343 pi_to_head(PI, Head). 2344 2345assert_reexport(false, _, _) :- !. 2346assert_reexport(true, Src, Term) :- 2347 assert(exported(Term, Src)).
2353process_import(M:PI, Src) :- 2354 pi_to_head(PI, Head), 2355 !, 2356 ( atom(M), 2357 current_module(M), 2358 module_property(M, file(From)) 2359 -> true 2360 ; From = '<unknown>' 2361 ), 2362 assert(imported(Head, Src, From)). 2363process_import(_, _).
2372assert_xmodule_callable([], _, _, _). 2373assert_xmodule_callable([PI|T], M, Src, From) :- 2374 ( pi_to_head(M:PI, Head) 2375 -> assert(imported(Head, Src, From)) 2376 ; true 2377 ), 2378 assert_xmodule_callable(T, M, Src, From).
2385assert_op(Src, op(P,T,M:N)) :-
2386 ( '$current_source_module'(M)
2387 -> Name = N
2388 ; Name = M:N
2389 ),
2390 ( xop(Src, op(P,T,Name))
2391 -> true
2392 ; assert(xop(Src, op(P,T,Name)))
2393 ).2400assert_module(Src, Module) :- 2401 xmodule(Module, Src), 2402 !. 2403assert_module(Src, Module) :- 2404 '$set_source_module'(Module), 2405 assert(xmodule(Module, Src)), 2406 ( module_property(Module, class(system)) 2407 -> retractall(xoption(Src, register_called(_))), 2408 assert(xoption(Src, register_called(all))) 2409 ; true 2410 ). 2411 2412assert_module_export(_, []) :- !. 2413assert_module_export(Src, [H|T]) :- 2414 !, 2415 assert_module_export(Src, H), 2416 assert_module_export(Src, T). 2417assert_module_export(Src, PI) :- 2418 pi_to_head(PI, Term), 2419 !, 2420 assert(exported(Term, Src)). 2421assert_module_export(Src, op(P, A, N)) :- 2422 xref_push_op(Src, P, A, N).
2428assert_module3([], _) :- !. 2429assert_module3([H|T], Src) :- 2430 !, 2431 assert_module3(H, Src), 2432 assert_module3(T, Src). 2433assert_module3(Option, Src) :- 2434 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2443process_predicates(Closure, Preds, Src) :- 2444 is_list(Preds), 2445 !, 2446 process_predicate_list(Preds, Closure, Src). 2447process_predicates(Closure, Preds, Src) :- 2448 process_predicate_comma(Preds, Closure, Src). 2449 2450process_predicate_list([], _, _). 2451process_predicate_list([H|T], Closure, Src) :- 2452 ( nonvar(H) 2453 -> call(Closure, H, Src) 2454 ; true 2455 ), 2456 process_predicate_list(T, Closure, Src). 2457 2458process_predicate_comma(Var, _, _) :- 2459 var(Var), 2460 !. 2461process_predicate_comma(M:(A,B), Closure, Src) :- 2462 !, 2463 process_predicate_comma(M:A, Closure, Src), 2464 process_predicate_comma(M:B, Closure, Src). 2465process_predicate_comma((A,B), Closure, Src) :- 2466 !, 2467 process_predicate_comma(A, Closure, Src), 2468 process_predicate_comma(B, Closure, Src). 2469process_predicate_comma(A, Closure, Src) :- 2470 call(Closure, A, Src). 2471 2472 2473assert_dynamic(PI, Src) :- 2474 pi_to_head(PI, Term), 2475 ( thread_local(Term, Src, _) % dynamic after thread_local has 2476 -> true % no effect 2477 ; current_source_line(Line), 2478 assert(dynamic(Term, Src, Line)) 2479 ). 2480 2481assert_thread_local(PI, Src) :- 2482 pi_to_head(PI, Term), 2483 current_source_line(Line), 2484 assert(thread_local(Term, Src, Line)). 2485 2486assert_multifile(PI, Src) :- % :- multifile(Spec) 2487 pi_to_head(PI, Term), 2488 current_source_line(Line), 2489 assert(multifile(Term, Src, Line)). 2490 2491assert_public(PI, Src) :- % :- public(Spec) 2492 pi_to_head(PI, Term), 2493 current_source_line(Line), 2494 assert_called(Src, '<public>'(Line), Term), 2495 assert(public(Term, Src, Line)). 2496 2497assert_export(PI, Src) :- % :- export(Spec) 2498 pi_to_head(PI, Term), 2499 !, 2500 assert(exported(Term, Src)).
2507pi_to_head(Var, _) :- 2508 var(Var), !, fail. 2509pi_to_head(M:PI, M:Term) :- 2510 !, 2511 pi_to_head(PI, Term). 2512pi_to_head(Name/Arity, Term) :- 2513 functor(Term, Name, Arity). 2514pi_to_head(Name//DCGArity, Term) :- 2515 Arity is DCGArity+2, 2516 functor(Term, Name, Arity). 2517 2518 2519assert_used_class(Src, Name) :- 2520 used_class(Name, Src), 2521 !. 2522assert_used_class(Src, Name) :- 2523 assert(used_class(Name, Src)). 2524 2525assert_defined_class(Src, Name, _Meta, _Super, _) :- 2526 defined_class(Name, _, _, Src, _), 2527 !. 2528assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2529assert_defined_class(Src, Name, Meta, Super, Summary) :- 2530 current_source_line(Line), 2531 ( Summary == @(default) 2532 -> Atom = '' 2533 ; is_list(Summary) 2534 -> atom_codes(Atom, Summary) 2535 ; string(Summary) 2536 -> atom_concat(Summary, '', Atom) 2537 ), 2538 assert(defined_class(Name, Super, Atom, Src, Line)), 2539 ( Meta = @(_) 2540 -> true 2541 ; assert_used_class(Src, Meta) 2542 ), 2543 assert_used_class(Src, Super). 2544 2545assert_defined_class(Src, Name, imported_from(_File)) :- 2546 defined_class(Name, _, _, Src, _), 2547 !. 2548assert_defined_class(Src, Name, imported_from(File)) :- 2549 assert(defined_class(Name, _, '', Src, file(File))). 2550 2551 2552 /******************************** 2553 * UTILITIES * 2554 ********************************/
2560generalise(Var, Var) :- 2561 var(Var), 2562 !. % error? 2563generalise(pce_principal:send_implementation(Id, _, _), 2564 pce_principal:send_implementation(Id, _, _)) :- 2565 atom(Id), 2566 !. 2567generalise(pce_principal:get_implementation(Id, _, _, _), 2568 pce_principal:get_implementation(Id, _, _, _)) :- 2569 atom(Id), 2570 !. 2571generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2572generalise(Module:Goal0, Module:Goal) :- 2573 atom(Module), 2574 !, 2575 generalise(Goal0, Goal). 2576generalise(Term0, Term) :- 2577 callable(Term0), 2578 generalise_term(Term0, Term). 2579 2580 2581 /******************************* 2582 * SOURCE MANAGEMENT * 2583 *******************************/ 2584 2585/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2586This section of the file contains hookable predicates to reason about 2587sources. The built-in code here can only deal with files. The XPCE 2588library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2589can do cross-referencing on PceEmacs edit buffers. Other examples for 2590hooking can be databases, (HTTP) URIs, etc. 2591- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2592 2593:- multifile 2594 prolog:xref_source_directory/2, % +Source, -Dir 2595 prolog:xref_source_file/3. % +Spec, -Path, +Options
2603xref_source_file(Plain, File, Source) :- 2604 xref_source_file(Plain, File, Source, []). 2605 2606xref_source_file(QSpec, File, Source, Options) :- 2607 nonvar(QSpec), QSpec = _:Spec, 2608 !, 2609 must_be(acyclic, Spec), 2610 xref_source_file(Spec, File, Source, Options). 2611xref_source_file(Spec, File, Source, Options) :- 2612 nonvar(Spec), 2613 prolog:xref_source_file(Spec, File, 2614 [ relative_to(Source) 2615 | Options 2616 ]), 2617 !. 2618xref_source_file(Plain, File, Source, Options) :- 2619 atom(Plain), 2620 \+ is_absolute_file_name(Plain), 2621 ( prolog:xref_source_directory(Source, Dir) 2622 -> true 2623 ; atom(Source), 2624 file_directory_name(Source, Dir) 2625 ), 2626 atomic_list_concat([Dir, /, Plain], Spec0), 2627 absolute_file_name(Spec0, Spec), 2628 do_xref_source_file(Spec, File, Options), 2629 !. 2630xref_source_file(Spec, File, Source, Options) :- 2631 do_xref_source_file(Spec, File, 2632 [ relative_to(Source) 2633 | Options 2634 ]), 2635 !. 2636xref_source_file(_, _, _, Options) :- 2637 option(silent(true), Options), 2638 !, 2639 fail. 2640xref_source_file(Spec, _, Src, _Options) :- 2641 verbose(Src), 2642 print_message(warning, error(existence_error(file, Spec), _)), 2643 fail. 2644 2645do_xref_source_file(Spec, File, Options) :- 2646 nonvar(Spec), 2647 option(file_type(Type), Options, prolog), 2648 absolute_file_name(Spec, File, 2649 [ file_type(Type), 2650 access(read), 2651 file_errors(fail) 2652 ]), 2653 !.
2659canonical_source(Source, Src) :-
2660 ( ground(Source)
2661 -> prolog_canonical_source(Source, Src)
2662 ; Source = Src
2663 ).name()
goals.2670goal_name_arity(Goal, Name, Arity) :- 2671 ( compound(Goal) 2672 -> compound_name_arity(Goal, Name, Arity) 2673 ; atom(Goal) 2674 -> Name = Goal, Arity = 0 2675 ). 2676 2677generalise_term(Specific, General) :- 2678 ( compound(Specific) 2679 -> compound_name_arity(Specific, Name, Arity), 2680 compound_name_arity(General, Name, Arity) 2681 ; General = Specific 2682 ). 2683 2684functor_name(Term, Name) :- 2685 ( compound(Term) 2686 -> compound_name_arity(Term, Name, _) 2687 ; atom(Term) 2688 -> Name = Term 2689 ). 2690 2691rename_goal(Goal0, Name, Goal) :- 2692 ( compound(Goal0) 2693 -> compound_name_arity(Goal0, _, Arity), 2694 compound_name_arity(Goal, Name, Arity) 2695 ; Goal = Name 2696 )
Prolog cross-referencer data collection
This module implements to data-collection part of the cross-referencer. This code is used in two places: