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-2017, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(prolog_xref, 37 [ xref_source/1, % +Source 38 xref_source/2, % +Source, +Options 39 xref_called/3, % ?Source, ?Callable, ?By 40 xref_called/4, % ?Source, ?Callable, ?By, ?Cond 41 xref_defined/3, % ?Source. ?Callable, -How 42 xref_definition_line/2, % +How, -Line 43 xref_exported/2, % ?Source, ?Callable 44 xref_module/2, % ?Source, ?Module 45 xref_uses_file/3, % ?Source, ?Spec, ?Path 46 xref_op/2, % ?Source, ?Op 47 xref_prolog_flag/4, % ?Source, ?Flag, ?Value, ?Line 48 xref_comment/3, % ?Source, ?Title, ?Comment 49 xref_comment/4, % ?Source, ?Head, ?Summary, ?Comment 50 xref_mode/3, % ?Source, ?Mode, ?Det 51 xref_option/2, % ?Source, ?Option 52 xref_clean/1, % +Source 53 xref_current_source/1, % ?Source 54 xref_done/2, % +Source, -When 55 xref_built_in/1, % ?Callable 56 xref_source_file/3, % +Spec, -Path, +Source 57 xref_source_file/4, % +Spec, -Path, +Source, +Options 58 xref_public_list/3, % +File, +Src, +Options 59 xref_public_list/4, % +File, -Path, -Export, +Src 60 xref_public_list/6, % +File, -Path, -Module, -Export, -Meta, +Src 61 xref_public_list/7, % +File, -Path, -Module, -Export, -Public, -Meta, +Src 62 xref_meta/3, % +Source, +Goal, -Called 63 xref_meta/2, % +Goal, -Called 64 xref_hook/1, % ?Callable 65 % XPCE class references 66 xref_used_class/2, % ?Source, ?ClassName 67 xref_defined_class/3 % ?Source, ?ClassName, -How 68 ]). 69:- use_module(library(debug), [debug/3]). 70:- use_module(library(lists), [append/3, append/2, member/2, select/3]). 71:- use_module(library(operators), [push_op/3]). 72:- use_module(library(shlib), [current_foreign_library/2]). 73:- use_module(library(ordsets)). 74:- use_module(library(prolog_source)). 75:- use_module(library(option)). 76:- use_module(library(error)). 77:- use_module(library(apply)). 78:- use_module(library(debug)). 79:- if(exists_source(library(pldoc))). 80:- use_module(library(pldoc), []). % Must be loaded before doc_process 81:- use_module(library(pldoc/doc_process)). 82:- endif. 83 84:- predicate_options(xref_source/2, 2, 85 [ silent(boolean), 86 module(atom), 87 register_called(oneof([all,non_iso,non_built_in])), 88 comments(oneof([store,collect,ignore])), 89 process_include(boolean) 90 ]). 91 92 93:- dynamic 94 called/4, % Head, Src, From, Cond 95 (dynamic)/3, % Head, Src, Line 96 (thread_local)/3, % Head, Src, Line 97 (multifile)/3, % Head, Src, Line 98 (public)/3, % Head, Src, Line 99 defined/3, % Head, Src, Line 100 meta_goal/3, % Head, Called, Src 101 foreign/3, % Head, Src, Line 102 constraint/3, % Head, Src, Line 103 imported/3, % Head, Src, From 104 exported/2, % Head, Src 105 xmodule/2, % Module, Src 106 uses_file/3, % Spec, Src, Path 107 xop/2, % Src, Op 108 source/2, % Src, Time 109 used_class/2, % Name, Src 110 defined_class/5, % Name, Super, Summary, Src, Line 111 (mode)/2, % Mode, Src 112 xoption/2, % Src, Option 113 xflag/4, % Name, Value, Src, Line 114 115 module_comment/3, % Src, Title, Comment 116 pred_comment/4, % Head, Src, Summary, Comment 117 pred_comment_link/3, % Head, Src, HeadTo 118 pred_mode/3. % Head, Src, Det 119 120:- create_prolog_flag(xref, false, [type(boolean)]).
138:- predicate_options(xref_source_file/4, 4, 139 [ file_type(oneof([txt,prolog,directory])), 140 silent(boolean) 141 ]). 142:- predicate_options(xref_public_list/3, 3, 143 [ path(-atom), 144 module(-atom), 145 exports(-list(any)), 146 public(-list(any)), 147 meta(-list(any)), 148 silent(boolean) 149 ]). 150 151 152 /******************************* 153 * HOOKS * 154 *******************************/
181:- multifile 182 prolog:called_by/4, % +Goal, +Module, +Context, -Called 183 prolog:called_by/2, % +Goal, -Called 184 prolog:meta_goal/2, % +Goal, -Pattern 185 prolog:hook/1, % +Callable 186 prolog:generated_predicate/1. % :PI 187 188:- meta_predicate 189 prolog:generated_predicate(). 190 191:- dynamic 192 meta_goal/2. 193 194:- meta_predicate 195 process_predicates(, , ). 196 197 /******************************* 198 * BUILT-INS * 199 *******************************/
register_called.207hide_called(Callable, Src) :- 208 xoption(Src, register_called(Which)), 209 !, 210 mode_hide_called(Which, Callable). 211hide_called(Callable, _) :- 212 mode_hide_called(non_built_in, Callable). 213 214mode_hide_called(all, _) :- !, fail. 215mode_hide_called(non_iso, _:Goal) :- 216 goal_name_arity(Goal, Name, Arity), 217 current_predicate(system:Name/Arity), 218 predicate_property(system:Goal, iso). 219mode_hide_called(non_built_in, _:Goal) :- 220 goal_name_arity(Goal, Name, Arity), 221 current_predicate(system:Name/Arity), 222 predicate_property(system:Goal, built_in). 223mode_hide_called(non_built_in, M:Goal) :- 224 goal_name_arity(Goal, Name, Arity), 225 current_predicate(M:Name/Arity), 226 predicate_property(M:Goal, built_in).
232system_predicate(Goal) :- 233 goal_name_arity(Goal, Name, Arity), 234 current_predicate(system:Name/Arity), % avoid autoloading 235 predicate_property(system:Goal, built_in), 236 !. 237 238 239 /******************************** 240 * TOPLEVEL * 241 ********************************/ 242 243verbose(Src) :- 244 \+ xoption(Src, silent(true)). 245 246:- thread_local 247 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).275xref_source(Source) :- 276 xref_source(Source, []). 277 278xref_source(Source, Options) :- 279 prolog_canonical_source(Source, Src), 280 ( last_modified(Source, Modified) 281 -> ( source(Src, Modified) 282 -> true 283 ; xref_clean(Src), 284 assert(source(Src, Modified)), 285 do_xref(Src, Options) 286 ) 287 ; xref_clean(Src), 288 get_time(Now), 289 assert(source(Src, Now)), 290 do_xref(Src, Options) 291 ). 292 293do_xref(Src, Options) :- 294 must_be(list, Options), 295 setup_call_cleanup( 296 xref_setup(Src, In, Options, State), 297 collect(Src, Src, In, Options), 298 xref_cleanup(State)). 299 300last_modified(Source, Modified) :- 301 prolog:xref_source_time(Source, Modified), 302 !. 303last_modified(Source, Modified) :- 304 atom(Source), 305 exists_file(Source), 306 time_file(Source, Modified). 307 308xref_setup(Src, In, Options, state(In, Dialect, Xref, [SRef|HRefs])) :- 309 maplist(assert_option(Src), Options), 310 assert_default_options(Src), 311 current_prolog_flag(emulated_dialect, Dialect), 312 prolog_open_source(Src, In), 313 set_initial_mode(In, Options), 314 asserta(xref_input(Src, In), SRef), 315 set_xref(Xref), 316 ( verbose(Src) 317 -> HRefs = [] 318 ; asserta(user:thread_message_hook(_,_,_), Ref), 319 HRefs = [Ref] 320 ). 321 322assert_option(_, Var) :- 323 var(Var), 324 !, 325 instantiation_error(Var). 326assert_option(Src, silent(Boolean)) :- 327 !, 328 must_be(boolean, Boolean), 329 assert(xoption(Src, silent(Boolean))). 330assert_option(Src, register_called(Which)) :- 331 !, 332 must_be(oneof([all,non_iso,non_built_in]), Which), 333 assert(xoption(Src, register_called(Which))). 334assert_option(Src, comments(CommentHandling)) :- 335 !, 336 must_be(oneof([store,collect,ignore]), CommentHandling), 337 assert(xoption(Src, comments(CommentHandling))). 338assert_option(Src, module(Module)) :- 339 !, 340 must_be(atom, Module), 341 assert(xoption(Src, module(Module))). 342assert_option(Src, process_include(Boolean)) :- 343 !, 344 must_be(boolean, Boolean), 345 assert(xoption(Src, process_include(Boolean))). 346 347assert_default_options(Src) :- 348 ( xref_option_default(Opt), 349 generalise_term(Opt, Gen), 350 ( xoption(Src, Gen) 351 -> true 352 ; assertz(xoption(Src, Opt)) 353 ), 354 fail 355 ; true 356 ). 357 358xref_option_default(silent(false)). 359xref_option_default(register_called(non_built_in)). 360xref_option_default(comments(collect)). 361xref_option_default(process_include(true)).
367xref_cleanup(state(In, Dialect, Xref, Refs)) :- 368 prolog_close_source(In), 369 set_prolog_flag(emulated_dialect, Dialect), 370 set_prolog_flag(xref, Xref), 371 maplist(erase, Refs). 372 373set_xref(Xref) :- 374 current_prolog_flag(xref, Xref), 375 set_prolog_flag(xref, true).
384set_initial_mode(_Stream, Options) :- 385 option(module(Module), Options), 386 !, 387 '$set_source_module'(Module). 388set_initial_mode(Stream, _) :- 389 stream_property(Stream, file_name(Path)), 390 source_file_property(Path, load_context(M, _, Opts)), 391 !, 392 '$set_source_module'(M), 393 ( option(dialect(Dialect), Opts) 394 -> expects_dialect(Dialect) 395 ; true 396 ). 397set_initial_mode(_, _) :- 398 '$set_source_module'(user).
404xref_input_stream(Stream) :-
405 xref_input(_, Var),
406 !,
407 Stream = Var.414xref_push_op(Src, P, T, N0) :- 415 ( N0 = _:_ 416 -> N = N0 417 ; '$current_source_module'(M), 418 N = M:N0 419 ), 420 valid_op(op(P,T,N)), 421 push_op(P, T, N), 422 assert_op(Src, op(P,T,N)), 423 debug(xref(op), ':- ~w.', [op(P,T,N)]). 424 425valid_op(op(P,T,M:N)) :- 426 atom(M), 427 atom(N), 428 integer(P), 429 between(0, 1200, P), 430 atom(T), 431 op_type(T). 432 433op_type(xf). 434op_type(yf). 435op_type(fx). 436op_type(fy). 437op_type(xfx). 438op_type(xfy). 439op_type(yfx).
445xref_set_prolog_flag(Flag, Value, Src, Line) :- 446 atom(Flag), 447 !, 448 assertz(xflag(Flag, Value, Src, Line)). 449xref_set_prolog_flag(_, _, _, _).
455xref_clean(Source) :- 456 prolog_canonical_source(Source, Src), 457 retractall(called(_, Src, _Origin, _Cond)), 458 retractall(dynamic(_, Src, Line)), 459 retractall(multifile(_, Src, Line)), 460 retractall(public(_, Src, Line)), 461 retractall(defined(_, Src, Line)), 462 retractall(meta_goal(_, _, Src)), 463 retractall(foreign(_, Src, Line)), 464 retractall(constraint(_, Src, Line)), 465 retractall(imported(_, Src, _From)), 466 retractall(exported(_, Src)), 467 retractall(uses_file(_, Src, _)), 468 retractall(xmodule(_, Src)), 469 retractall(xop(Src, _)), 470 retractall(xoption(Src, _)), 471 retractall(xflag(_Name, _Value, Src, Line)), 472 retractall(source(Src, _)), 473 retractall(used_class(_, Src)), 474 retractall(defined_class(_, _, _, Src, _)), 475 retractall(mode(_, Src)), 476 retractall(module_comment(Src, _, _)), 477 retractall(pred_comment(_, Src, _, _)), 478 retractall(pred_comment_link(_, Src, _)), 479 retractall(pred_mode(_, Src, _)). 480 481 482 /******************************* 483 * READ RESULTS * 484 *******************************/
490xref_current_source(Source) :-
491 source(Source, _Time).
498xref_done(Source, Time) :-
499 prolog_canonical_source(Source, Src),
500 source(Src, Time).509xref_called(Source, Called, By) :- 510 xref_called(Source, Called, By, _). 511 512xref_called(Source, Called, By, Cond) :- 513 canonical_source(Source, Src), 514 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)536xref_defined(Source, Called, How) :- 537 nonvar(Source), 538 !, 539 canonical_source(Source, Src), 540 xref_defined2(How, Src, Called). 541xref_defined(Source, Called, How) :- 542 xref_defined2(How, Src, Called), 543 canonical_source(Source, Src). 544 545xref_defined2(dynamic(Line), Src, Called) :- 546 dynamic(Called, Src, Line). 547xref_defined2(thread_local(Line), Src, Called) :- 548 thread_local(Called, Src, Line). 549xref_defined2(multifile(Line), Src, Called) :- 550 multifile(Called, Src, Line). 551xref_defined2(public(Line), Src, Called) :- 552 public(Called, Src, Line). 553xref_defined2(local(Line), Src, Called) :- 554 defined(Called, Src, Line). 555xref_defined2(foreign(Line), Src, Called) :- 556 foreign(Called, Src, Line). 557xref_defined2(constraint(Line), Src, Called) :- 558 constraint(Called, Src, Line). 559xref_defined2(imported(From), Src, Called) :- 560 imported(Called, Src, From).
568xref_definition_line(local(Line), Line). 569xref_definition_line(dynamic(Line), Line). 570xref_definition_line(thread_local(Line), Line). 571xref_definition_line(multifile(Line), Line). 572xref_definition_line(public(Line), Line). 573xref_definition_line(constraint(Line), Line). 574xref_definition_line(foreign(Line), Line).
581xref_exported(Source, Called) :-
582 prolog_canonical_source(Source, Src),
583 exported(Called, Src).589xref_module(Source, Module) :- 590 nonvar(Source), 591 !, 592 prolog_canonical_source(Source, Src), 593 xmodule(Module, Src). 594xref_module(Source, Module) :- 595 xmodule(Module, Src), 596 prolog_canonical_source(Source, Src).
606xref_uses_file(Source, Spec, Path) :-
607 prolog_canonical_source(Source, Src),
608 uses_file(Spec, Src, Path).
618xref_op(Source, Op) :-
619 prolog_canonical_source(Source, Src),
620 xop(Src, Op).628xref_prolog_flag(Source, Flag, Value, Line) :- 629 prolog_canonical_source(Source, Src), 630 xflag(Flag, Value, Src, Line). 631 632xref_built_in(Head) :- 633 system_predicate(Head). 634 635xref_used_class(Source, Class) :- 636 prolog_canonical_source(Source, Src), 637 used_class(Class, Src). 638 639xref_defined_class(Source, Class, local(Line, Super, Summary)) :- 640 prolog_canonical_source(Source, Src), 641 defined_class(Class, Super, Summary, Src, Line), 642 integer(Line), 643 !. 644xref_defined_class(Source, Class, file(File)) :- 645 prolog_canonical_source(Source, Src), 646 defined_class(Class, _, _, Src, file(File)). 647 648:- thread_local 649 current_cond/1, 650 source_line/1. 651 652current_source_line(Line) :- 653 source_line(Var), 654 !, 655 Line = Var.
663collect(Src, File, In, Options) :- 664 ( Src == File 665 -> SrcSpec = Line 666 ; SrcSpec = (File:Line) 667 ), 668 option(comments(CommentHandling), Options, collect), 669 ( CommentHandling == ignore 670 -> CommentOptions = [], 671 Comments = [] 672 ; CommentHandling == store 673 -> CommentOptions = [ process_comment(true) ], 674 Comments = [] 675 ; CommentOptions = [ comments(Comments) ] 676 ), 677 repeat, 678 catch(prolog_read_source_term( 679 In, Term, Expanded, 680 [ term_position(TermPos) 681 | CommentOptions 682 ]), 683 E, report_syntax_error(E, Src, [])), 684 update_condition(Term), 685 ( is_list(Expanded) 686 -> member(T, Expanded) 687 ; T = Expanded 688 ), 689 stream_position_data(line_count, TermPos, Line), 690 setup_call_cleanup( 691 asserta(source_line(SrcSpec), Ref), 692 catch(process(T, Comments, TermPos, Src), 693 E, print_message(error, E)), 694 erase(Ref)), 695 T == end_of_file, 696 !. 697 698report_syntax_error(E, _, _) :- 699 fatal_error(E), 700 throw(E). 701report_syntax_error(_, _, Options) :- 702 option(silent(true), Options), 703 !, 704 fail. 705report_syntax_error(E, Src, _Options) :- 706 ( verbose(Src) 707 -> print_message(error, E) 708 ; true 709 ), 710 fail. 711 712fatal_error(time_limit_exceeded). 713fatal_error(error(resource_error(_),_)).
719update_condition((:-Directive)) :- 720 !, 721 update_cond(Directive). 722update_condition(_). 723 724update_cond(if(Cond)) :- 725 !, 726 asserta(current_cond(Cond)). 727update_cond(else) :- 728 retract(current_cond(C0)), 729 !, 730 assert(current_cond(\+C0)). 731update_cond(elif(Cond)) :- 732 retract(current_cond(C0)), 733 !, 734 assert(current_cond((\+C0,Cond))). 735update_cond(endif) :- 736 retract(current_cond(_)), 737 !. 738update_cond(_).
745current_condition(Condition) :- 746 \+ current_cond(_), 747 !, 748 Condition = true. 749current_condition(Condition) :- 750 findall(C, current_cond(C), List), 751 list_to_conj(List, Condition). 752 753list_to_conj([], true). 754list_to_conj([C], C) :- !. 755list_to_conj([H|T], (H,C)) :- 756 list_to_conj(T, C). 757 758 759 /******************************* 760 * PROCESS * 761 *******************************/
765process(Term, Comments, TermPos, Src) :- 766 process(Term, Src), 767 xref_comments(Comments, TermPos, Src). 768 769process(Var, _) :- 770 var(Var), 771 !. % Warn? 772process(end_of_file, _) :- !. 773process((:- Directive), Src) :- 774 !, 775 process_directive(Directive, Src), 776 !. 777process((?- Directive), Src) :- 778 !, 779 process_directive(Directive, Src), 780 !. 781process((Head :- Body), Src) :- 782 !, 783 assert_defined(Src, Head), 784 process_body(Body, Head, Src). 785process('$source_location'(_File, _Line):Clause, Src) :- 786 !, 787 process(Clause, Src). 788process(Term, Src) :- 789 process_chr(Term, Src), 790 !. 791process(M:(Head :- Body), Src) :- 792 !, 793 process((M:Head :- M:Body), Src). 794process(Head, Src) :- 795 assert_defined(Src, Head). 796 797 798 /******************************* 799 * COMMENTS * 800 *******************************/
804xref_comments([], _Pos, _Src). 805:- if(current_predicate(parse_comment/3)). 806xref_comments([Pos-Comment|T], TermPos, Src) :- 807 ( Pos @> TermPos % comments inside term 808 -> true 809 ; stream_position_data(line_count, Pos, Line), 810 FilePos = Src:Line, 811 ( parse_comment(Comment, FilePos, Parsed) 812 -> assert_comments(Parsed, Src) 813 ; true 814 ), 815 xref_comments(T, TermPos, Src) 816 ). 817 818assert_comments([], _). 819assert_comments([H|T], Src) :- 820 assert_comment(H, Src), 821 assert_comments(T, Src). 822 823assert_comment(section(_Id, Title, Comment), Src) :- 824 assertz(module_comment(Src, Title, Comment)). 825assert_comment(predicate(PI, Summary, Comment), Src) :- 826 pi_to_head(PI, Src, Head), 827 assertz(pred_comment(Head, Src, Summary, Comment)). 828assert_comment(link(PI, PITo), Src) :- 829 pi_to_head(PI, Src, Head), 830 pi_to_head(PITo, Src, HeadTo), 831 assertz(pred_comment_link(Head, Src, HeadTo)). 832assert_comment(mode(Head, Det), Src) :- 833 assertz(pred_mode(Head, Src, Det)). 834 835pi_to_head(PI, Src, Head) :- 836 pi_to_head(PI, Head0), 837 ( Head0 = _:_ 838 -> strip_module(Head0, M, Plain), 839 ( xmodule(M, Src) 840 -> Head = Plain 841 ; Head = M:Plain 842 ) 843 ; Head = Head0 844 ). 845:- endif.
851xref_comment(Source, Title, Comment) :-
852 canonical_source(Source, Src),
853 module_comment(Src, Title, Comment).
859xref_comment(Source, Head, Summary, Comment) :-
860 canonical_source(Source, Src),
861 ( pred_comment(Head, Src, Summary, Comment)
862 ; pred_comment_link(Head, Src, HeadTo),
863 pred_comment(HeadTo, Src, Summary, Comment)
864 ).
871xref_mode(Source, Mode, Det) :-
872 canonical_source(Source, Src),
873 pred_mode(Mode, Src, Det).880xref_option(Source, Option) :- 881 canonical_source(Source, Src), 882 xoption(Src, Option). 883 884 885 /******************************** 886 * DIRECTIVES * 887 ********************************/ 888 889process_directive(Var, _) :- 890 var(Var), 891 !. % error, but that isn't our business 892process_directive(Dir, _Src) :- 893 debug(xref(directive), 'Processing :- ~q', [Dir]), 894 fail. 895process_directive((A,B), Src) :- % TBD: what about other control 896 !, 897 process_directive(A, Src), % structures? 898 process_directive(B, Src). 899process_directive(List, Src) :- 900 is_list(List), 901 !, 902 process_directive(consult(List), Src). 903process_directive(use_module(File, Import), Src) :- 904 process_use_module2(File, Import, Src, false). 905process_directive(expects_dialect(Dialect), Src) :- 906 process_directive(use_module(library(dialect/Dialect)), Src), 907 expects_dialect(Dialect). 908process_directive(reexport(File, Import), Src) :- 909 process_use_module2(File, Import, Src, true). 910process_directive(reexport(Modules), Src) :- 911 process_use_module(Modules, Src, true). 912process_directive(use_module(Modules), Src) :- 913 process_use_module(Modules, Src, false). 914process_directive(consult(Modules), Src) :- 915 process_use_module(Modules, Src, false). 916process_directive(ensure_loaded(Modules), Src) :- 917 process_use_module(Modules, Src, false). 918process_directive(load_files(Files, _Options), Src) :- 919 process_use_module(Files, Src, false). 920process_directive(include(Files), Src) :- 921 process_include(Files, Src). 922process_directive(dynamic(Dynamic), Src) :- 923 process_predicates(assert_dynamic, Dynamic, Src). 924process_directive(thread_local(Dynamic), Src) :- 925 process_predicates(assert_thread_local, Dynamic, Src). 926process_directive(multifile(Dynamic), Src) :- 927 process_predicates(assert_multifile, Dynamic, Src). 928process_directive(public(Public), Src) :- 929 process_predicates(assert_public, Public, Src). 930process_directive(export(Export), Src) :- 931 process_predicates(assert_export, Export, Src). 932process_directive(import(Import), Src) :- 933 process_import(Import, Src). 934process_directive(module(Module, Export), Src) :- 935 assert_module(Src, Module), 936 assert_module_export(Src, Export). 937process_directive(module(Module, Export, Import), Src) :- 938 assert_module(Src, Module), 939 assert_module_export(Src, Export), 940 assert_module3(Import, Src). 941process_directive('$set_source_module'(system), Src) :- 942 assert_module(Src, system). % hack for handling boot/init.pl 943process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :- 944 assert_defined_class(Src, Name, Meta, Super, Doc). 945process_directive(pce_autoload(Name, From), Src) :- 946 assert_defined_class(Src, Name, imported_from(From)). 947 948process_directive(op(P, A, N), Src) :- 949 xref_push_op(Src, P, A, N). 950process_directive(set_prolog_flag(Flag, Value), Src) :- 951 ( Flag == character_escapes 952 -> set_prolog_flag(character_escapes, Value) 953 ; true 954 ), 955 current_source_line(Line), 956 xref_set_prolog_flag(Flag, Value, Src, Line). 957process_directive(style_check(X), _) :- 958 style_check(X). 959process_directive(encoding(Enc), _) :- 960 ( xref_input_stream(Stream) 961 -> catch(set_stream(Stream, encoding(Enc)), _, true) 962 ; true % can this happen? 963 ). 964process_directive(pce_expansion:push_compile_operators, _) :- 965 '$current_source_module'(SM), 966 call(pce_expansion:push_compile_operators(SM)). % call to avoid xref 967process_directive(pce_expansion:pop_compile_operators, _) :- 968 call(pce_expansion:pop_compile_operators). 969process_directive(meta_predicate(Meta), Src) :- 970 process_meta_predicate(Meta, Src). 971process_directive(arithmetic_function(FSpec), Src) :- 972 arith_callable(FSpec, Goal), 973 !, 974 current_source_line(Line), 975 assert_called(Src, '<directive>'(Line), Goal). 976process_directive(format_predicate(_, Goal), Src) :- 977 !, 978 current_source_line(Line), 979 assert_called(Src, '<directive>'(Line), Goal). 980process_directive(if(Cond), Src) :- 981 !, 982 current_source_line(Line), 983 assert_called(Src, '<directive>'(Line), Cond). 984process_directive(elif(Cond), Src) :- 985 !, 986 current_source_line(Line), 987 assert_called(Src, '<directive>'(Line), Cond). 988process_directive(else, _) :- !. 989process_directive(endif, _) :- !. 990process_directive(Goal, Src) :- 991 current_source_line(Line), 992 process_body(Goal, '<directive>'(Line), Src).
998process_meta_predicate((A,B), Src) :- 999 !, 1000 process_meta_predicate(A, Src), 1001 process_meta_predicate(B, Src). 1002process_meta_predicate(Decl, Src) :- 1003 process_meta_head(Src, Decl). 1004 1005process_meta_head(Src, Decl) :- % swapped arguments for maplist 1006 compound(Decl), 1007 compound_name_arity(Decl, Name, Arity), 1008 compound_name_arity(Head, Name, Arity), 1009 meta_args(1, Arity, Decl, Head, Meta), 1010 ( ( prolog:meta_goal(Head, _) 1011 ; prolog:called_by(Head, _, _, _) 1012 ; prolog:called_by(Head, _) 1013 ; meta_goal(Head, _) 1014 ) 1015 -> true 1016 ; assert(meta_goal(Head, Meta, Src)) 1017 ). 1018 1019meta_args(I, Arity, _, _, []) :- 1020 I > Arity, 1021 !. 1022meta_args(I, Arity, Decl, Head, [H|T]) :- % 0 1023 arg(I, Decl, 0), 1024 !, 1025 arg(I, Head, H), 1026 I2 is I + 1, 1027 meta_args(I2, Arity, Decl, Head, T). 1028meta_args(I, Arity, Decl, Head, [H|T]) :- % ^ 1029 arg(I, Decl, ^), 1030 !, 1031 arg(I, Head, EH), 1032 setof_goal(EH, H), 1033 I2 is I + 1, 1034 meta_args(I2, Arity, Decl, Head, T). 1035meta_args(I, Arity, Decl, Head, [//(H)|T]) :- 1036 arg(I, Decl, //), 1037 !, 1038 arg(I, Head, H), 1039 I2 is I + 1, 1040 meta_args(I2, Arity, Decl, Head, T). 1041meta_args(I, Arity, Decl, Head, [H+A|T]) :- % I --> H+I 1042 arg(I, Decl, A), 1043 integer(A), A > 0, 1044 !, 1045 arg(I, Head, H), 1046 I2 is I + 1, 1047 meta_args(I2, Arity, Decl, Head, T). 1048meta_args(I, Arity, Decl, Head, Meta) :- 1049 I2 is I + 1, 1050 meta_args(I2, Arity, Decl, Head, Meta). 1051 1052 1053 /******************************** 1054 * BODY * 1055 ********************************/
1064xref_meta(Source, Head, Called) :-
1065 canonical_source(Source, Src),
1066 xref_meta_src(Head, Called, Src).1081xref_meta_src(Head, Called, Src) :- 1082 meta_goal(Head, Called, Src), 1083 !. 1084xref_meta_src(Head, Called, _) :- 1085 xref_meta(Head, Called), 1086 !. 1087xref_meta_src(Head, Called, _) :- 1088 compound(Head), 1089 compound_name_arity(Head, Name, Arity), 1090 apply_pred(Name), 1091 Arity > 5, 1092 !, 1093 Extra is Arity - 1, 1094 arg(1, Head, G), 1095 Called = [G+Extra]. 1096 1097apply_pred(call). % built-in 1098apply_pred(maplist). % library(apply_macros) 1099 1100xref_meta((A, B), [A, B]). 1101xref_meta((A; B), [A, B]). 1102xref_meta((A| B), [A, B]). 1103xref_meta((A -> B), [A, B]). 1104xref_meta((A *-> B), [A, B]). 1105xref_meta(findall(_V,G,_L), [G]). 1106xref_meta(findall(_V,G,_L,_T), [G]). 1107xref_meta(findnsols(_N,_V,G,_L), [G]). 1108xref_meta(findnsols(_N,_V,G,_L,_T), [G]). 1109xref_meta(setof(_V, EG, _L), [G]) :- 1110 setof_goal(EG, G). 1111xref_meta(bagof(_V, EG, _L), [G]) :- 1112 setof_goal(EG, G). 1113xref_meta(forall(A, B), [A, B]). 1114xref_meta(maplist(G,_), [G+1]). 1115xref_meta(maplist(G,_,_), [G+2]). 1116xref_meta(maplist(G,_,_,_), [G+3]). 1117xref_meta(maplist(G,_,_,_,_), [G+4]). 1118xref_meta(map_list_to_pairs(G,_,_), [G+2]). 1119xref_meta(map_assoc(G, _), [G+1]). 1120xref_meta(map_assoc(G, _, _), [G+2]). 1121xref_meta(checklist(G, _L), [G+1]). 1122xref_meta(sublist(G, _, _), [G+1]). 1123xref_meta(include(G, _, _), [G+1]). 1124xref_meta(exclude(G, _, _), [G+1]). 1125xref_meta(partition(G, _, _, _, _), [G+2]). 1126xref_meta(partition(G, _, _, _),[G+1]). 1127xref_meta(call(G), [G]). 1128xref_meta(call(G, _), [G+1]). 1129xref_meta(call(G, _, _), [G+2]). 1130xref_meta(call(G, _, _, _), [G+3]). 1131xref_meta(call(G, _, _, _, _), [G+4]). 1132xref_meta(not(G), [G]). 1133xref_meta(notrace(G), [G]). 1134xref_meta(\+(G), [G]). 1135xref_meta(ignore(G), [G]). 1136xref_meta(once(G), [G]). 1137xref_meta(initialization(G), [G]). 1138xref_meta(initialization(G,_), [G]). 1139xref_meta(retract(Rule), [G]) :- head_of(Rule, G). 1140xref_meta(clause(G, _), [G]). 1141xref_meta(clause(G, _, _), [G]). 1142xref_meta(phrase(G, _A), [//(G)]). 1143xref_meta(phrase(G, _A, _R), [//(G)]). 1144xref_meta(call_dcg(G, _A, _R), [//(G)]). 1145xref_meta(phrase_from_file(G,_),[//(G)]). 1146xref_meta(catch(A, _, B), [A, B]). 1147xref_meta(thread_create(A,_,_), [A]). 1148xref_meta(thread_signal(_,A), [A]). 1149xref_meta(thread_at_exit(A), [A]). 1150xref_meta(thread_initialization(A), [A]). 1151xref_meta(engine_create(_,A,_), [A]). 1152xref_meta(engine_create(_,A,_,_), [A]). 1153xref_meta(predsort(A,_,_), [A+3]). 1154xref_meta(call_cleanup(A, B), [A, B]). 1155xref_meta(call_cleanup(A, _, B),[A, B]). 1156xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1157xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1158xref_meta(call_residue_vars(A,_), [A]). 1159xref_meta(with_mutex(_,A), [A]). 1160xref_meta(assume(G), [G]). % library(debug) 1161xref_meta(assertion(G), [G]). % library(debug) 1162xref_meta(freeze(_, G), [G]). 1163xref_meta(when(C, A), [C, A]). 1164xref_meta(time(G), [G]). % development system 1165xref_meta(profile(G), [G]). 1166xref_meta(at_halt(G), [G]). 1167xref_meta(call_with_time_limit(_, G), [G]). 1168xref_meta(call_with_depth_limit(G, _, _), [G]). 1169xref_meta(call_with_inference_limit(G, _, _), [G]). 1170xref_meta(alarm(_, G, _), [G]). 1171xref_meta(alarm(_, G, _, _), [G]). 1172xref_meta('$add_directive_wic'(G), [G]). 1173xref_meta(with_output_to(_, G), [G]). 1174xref_meta(if(G), [G]). 1175xref_meta(elif(G), [G]). 1176xref_meta(meta_options(G,_,_), [G+1]). 1177xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1178xref_meta(distinct(G), [G]). % library(solution_sequences) 1179xref_meta(distinct(_, G), [G]). 1180xref_meta(order_by(_, G), [G]). 1181xref_meta(limit(_, G), [G]). 1182xref_meta(offset(_, G), [G]). 1183xref_meta(reset(G,_,_), [G]). 1184 1185 % XPCE meta-predicates 1186xref_meta(pce_global(_, new(_)), _) :- !, fail. 1187xref_meta(pce_global(_, B), [B+1]). 1188xref_meta(ifmaintainer(G), [G]). % used in manual 1189xref_meta(listen(_, G), [G]). % library(broadcast) 1190xref_meta(listen(_, _, G), [G]). 1191xref_meta(in_pce_thread(G), [G]). 1192 1193xref_meta(G, Meta) :- % call user extensions 1194 prolog:meta_goal(G, Meta). 1195xref_meta(G, Meta) :- % Generated from :- meta_predicate 1196 meta_goal(G, Meta). 1197 1198setof_goal(EG, G) :- 1199 var(EG), !, G = EG. 1200setof_goal(_^EG, G) :- 1201 !, 1202 setof_goal(EG, G). 1203setof_goal(G, G).
1210head_of(Var, _) :- 1211 var(Var), !, fail. 1212head_of((Head :- _), Head). 1213head_of(Head, Head).
1221xref_hook(Hook) :- 1222 prolog:hook(Hook). 1223xref_hook(Hook) :- 1224 hook(Hook). 1225 1226 1227hook(attr_portray_hook(_,_)). 1228hook(attr_unify_hook(_,_)). 1229hook(attribute_goals(_,_,_)). 1230hook(goal_expansion(_,_)). 1231hook(term_expansion(_,_)). 1232hook(resource(_,_,_)). 1233hook('$pred_option'(_,_,_,_)). 1234 1235hook(emacs_prolog_colours:goal_classification(_,_)). 1236hook(emacs_prolog_colours:term_colours(_,_)). 1237hook(emacs_prolog_colours:goal_colours(_,_)). 1238hook(emacs_prolog_colours:style(_,_)). 1239hook(emacs_prolog_colours:identify(_,_)). 1240hook(pce_principal:pce_class(_,_,_,_,_,_)). 1241hook(pce_principal:send_implementation(_,_,_)). 1242hook(pce_principal:get_implementation(_,_,_,_)). 1243hook(pce_principal:pce_lazy_get_method(_,_,_)). 1244hook(pce_principal:pce_lazy_send_method(_,_,_)). 1245hook(pce_principal:pce_uses_template(_,_)). 1246hook(prolog:locate_clauses(_,_)). 1247hook(prolog:message(_,_,_)). 1248hook(prolog:error_message(_,_,_)). 1249hook(prolog:message_location(_,_,_)). 1250hook(prolog:message_context(_,_,_)). 1251hook(prolog:message_line_element(_,_)). 1252hook(prolog:debug_control_hook(_)). 1253hook(prolog:help_hook(_)). 1254hook(prolog:show_profile_hook(_,_)). 1255hook(prolog:general_exception(_,_)). 1256hook(prolog:predicate_summary(_,_)). 1257hook(prolog:residual_goals(_,_)). 1258hook(prolog_edit:load). 1259hook(prolog_edit:locate(_,_,_)). 1260hook(shlib:unload_all_foreign_libraries). 1261hook(system:'$foreign_registered'(_, _)). 1262hook(predicate_options:option_decl(_,_,_)). 1263hook(user:exception(_,_,_)). 1264hook(user:file_search_path(_,_)). 1265hook(user:library_directory(_)). 1266hook(user:message_hook(_,_,_)). 1267hook(user:portray(_)). 1268hook(user:prolog_clause_name(_,_)). 1269hook(user:prolog_list_goal(_)). 1270hook(user:prolog_predicate_name(_,_)). 1271hook(user:prolog_trace_interception(_,_,_,_)). 1272hook(user:prolog_event_hook(_)). 1273hook(user:prolog_exception_hook(_,_,_,_)). 1274hook(sandbox:safe_primitive(_)). 1275hook(sandbox:safe_meta_predicate(_)). 1276hook(sandbox:safe_meta(_,_)). 1277hook(sandbox:safe_global_variable(_)). 1278hook(sandbox:safe_directive(_)).
1285arith_callable(Var, _) :- 1286 var(Var), !, fail. 1287arith_callable(Module:Spec, Module:Goal) :- 1288 !, 1289 arith_callable(Spec, Goal). 1290arith_callable(Name/Arity, Goal) :- 1291 PredArity is Arity + 1, 1292 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1303process_body(Body, Origin, Src) :-
1304 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1305 true).true if there was a
partial evalation inside Goal that has bound variables.1312process_goal(Var, _, _, _) :- 1313 var(Var), 1314 !. 1315process_goal(Goal, Origin, Src, P) :- 1316 Goal = (_,_), % problems 1317 !, 1318 phrase(conjunction(Goal), Goals), 1319 process_conjunction(Goals, Origin, Src, P). 1320process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1321 Goal = (_;_), % problems 1322 !, 1323 phrase(disjunction(Goal), Goals), 1324 forall(member(G, Goals), 1325 process_body(G, Origin, Src)). 1326process_goal(Goal, Origin, Src, P) :- 1327 ( ( xmodule(M, Src) 1328 -> true 1329 ; M = user 1330 ), 1331 ( predicate_property(M:Goal, imported_from(IM)) 1332 -> true 1333 ; IM = M 1334 ), 1335 prolog:called_by(Goal, IM, M, Called) 1336 ; prolog:called_by(Goal, Called) 1337 ), 1338 !, 1339 must_be(list, Called), 1340 assert_called(Src, Origin, Goal), 1341 process_called_list(Called, Origin, Src, P). 1342process_goal(Goal, Origin, Src, _) :- 1343 process_xpce_goal(Goal, Origin, Src), 1344 !. 1345process_goal(load_foreign_library(File), _Origin, Src, _) :- 1346 process_foreign(File, Src). 1347process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1348 process_foreign(File, Src). 1349process_goal(use_foreign_library(File), _Origin, Src, _) :- 1350 process_foreign(File, Src). 1351process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1352 process_foreign(File, Src). 1353process_goal(Goal, Origin, Src, P) :- 1354 xref_meta_src(Goal, Metas, Src), 1355 !, 1356 assert_called(Src, Origin, Goal), 1357 process_called_list(Metas, Origin, Src, P). 1358process_goal(Goal, Origin, Src, _) :- 1359 asserting_goal(Goal, Rule), 1360 !, 1361 assert_called(Src, Origin, Goal), 1362 process_assert(Rule, Origin, Src). 1363process_goal(Goal, Origin, Src, P) :- 1364 partial_evaluate(Goal, P), 1365 assert_called(Src, Origin, Goal). 1366 1367disjunction(Var) --> {var(Var), !}, [Var]. 1368disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1369disjunction(G) --> [G]. 1370 1371conjunction(Var) --> {var(Var), !}, [Var]. 1372conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1373conjunction(G) --> [G]. 1374 (RVars, T) :- 1376 term_variables(T, TVars0), 1377 sort(TVars0, TVars), 1378 ord_intersect(RVars, TVars). 1379 1380process_conjunction([], _, _, _). 1381process_conjunction([Disj|Rest], Origin, Src, P) :- 1382 nonvar(Disj), 1383 Disj = (_;_), 1384 Rest \== [], 1385 !, 1386 phrase(disjunction(Disj), Goals), 1387 term_variables(Rest, RVars0), 1388 sort(RVars0, RVars), 1389 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1390 forall(member(G, NonSHaring), 1391 process_body(G, Origin, Src)), 1392 ( Sharing == [] 1393 -> true 1394 ; maplist(term_variables, Sharing, GVars0), 1395 append(GVars0, GVars1), 1396 sort(GVars1, GVars), 1397 ord_intersection(GVars, RVars, SVars), 1398 VT =.. [v|SVars], 1399 findall(VT, 1400 ( member(G, Sharing), 1401 process_goal(G, Origin, Src, PS), 1402 PS == true 1403 ), 1404 Alts0), 1405 ( Alts0 == [] 1406 -> true 1407 ; ( true 1408 ; P = true, 1409 sort(Alts0, Alts1), 1410 variants(Alts1, 10, Alts), 1411 member(VT, Alts) 1412 ) 1413 ) 1414 ), 1415 process_conjunction(Rest, Origin, Src, P). 1416process_conjunction([H|T], Origin, Src, P) :- 1417 process_goal(H, Origin, Src, P), 1418 process_conjunction(T, Origin, Src, P). 1419 1420 1421process_called_list([], _, _, _). 1422process_called_list([H|T], Origin, Src, P) :- 1423 process_meta(H, Origin, Src, P), 1424 process_called_list(T, Origin, Src, P). 1425 1426process_meta(A+N, Origin, Src, P) :- 1427 !, 1428 ( extend(A, N, AX) 1429 -> process_goal(AX, Origin, Src, P) 1430 ; true 1431 ). 1432process_meta(//(A), Origin, Src, P) :- 1433 !, 1434 process_dcg_goal(A, Origin, Src, P). 1435process_meta(G, Origin, Src, P) :- 1436 process_goal(G, Origin, Src, P).
1443process_dcg_goal(Var, _, _, _) :- 1444 var(Var), 1445 !. 1446process_dcg_goal((A,B), Origin, Src, P) :- 1447 !, 1448 process_dcg_goal(A, Origin, Src, P), 1449 process_dcg_goal(B, Origin, Src, P). 1450process_dcg_goal((A;B), Origin, Src, P) :- 1451 !, 1452 process_dcg_goal(A, Origin, Src, P), 1453 process_dcg_goal(B, Origin, Src, P). 1454process_dcg_goal((A|B), Origin, Src, P) :- 1455 !, 1456 process_dcg_goal(A, Origin, Src, P), 1457 process_dcg_goal(B, Origin, Src, P). 1458process_dcg_goal((A->B), Origin, Src, P) :- 1459 !, 1460 process_dcg_goal(A, Origin, Src, P), 1461 process_dcg_goal(B, Origin, Src, P). 1462process_dcg_goal((A*->B), Origin, Src, P) :- 1463 !, 1464 process_dcg_goal(A, Origin, Src, P), 1465 process_dcg_goal(B, Origin, Src, P). 1466process_dcg_goal({Goal}, Origin, Src, P) :- 1467 !, 1468 process_goal(Goal, Origin, Src, P). 1469process_dcg_goal(List, _Origin, _Src, _) :- 1470 is_list(List), 1471 !. % terminal 1472process_dcg_goal(List, _Origin, _Src, _) :- 1473 string(List), 1474 !. % terminal 1475process_dcg_goal(Callable, Origin, Src, P) :- 1476 extend(Callable, 2, Goal), 1477 !, 1478 process_goal(Goal, Origin, Src, P). 1479process_dcg_goal(_, _, _, _). 1480 1481 1482extend(Var, _, _) :- 1483 var(Var), !, fail. 1484extend(M:G, N, M:GX) :- 1485 !, 1486 callable(G), 1487 extend(G, N, GX). 1488extend(G, N, GX) :- 1489 ( compound(G) 1490 -> compound_name_arguments(G, Name, Args), 1491 length(Rest, N), 1492 append(Args, Rest, NArgs), 1493 compound_name_arguments(GX, Name, NArgs) 1494 ; atom(G) 1495 -> length(NArgs, N), 1496 compound_name_arguments(GX, G, NArgs) 1497 ). 1498 1499asserting_goal(assert(Rule), Rule). 1500asserting_goal(asserta(Rule), Rule). 1501asserting_goal(assertz(Rule), Rule). 1502asserting_goal(assert(Rule,_), Rule). 1503asserting_goal(asserta(Rule,_), Rule). 1504asserting_goal(assertz(Rule,_), Rule). 1505 1506process_assert(0, _, _) :- !. % catch variables 1507process_assert((_:-Body), Origin, Src) :- 1508 !, 1509 process_body(Body, Origin, Src). 1510process_assert(_, _, _).
1514variants([], _, []). 1515variants([H|T], Max, List) :- 1516 variants(T, H, Max, List). 1517 1518variants([], H, _, [H]). 1519variants(_, _, 0, []) :- !. 1520variants([H|T], V, Max, List) :- 1521 ( H =@= V 1522 -> variants(T, V, Max, List) 1523 ; List = [V|List2], 1524 Max1 is Max-1, 1525 variants(T, H, Max1, List2) 1526 ).
T = hello(X),
findall(T, T, List),
1540partial_evaluate(Goal, P) :- 1541 eval(Goal), 1542 !, 1543 P = true. 1544partial_evaluate(_, _). 1545 1546eval(X = Y) :- 1547 unify_with_occurs_check(X, Y). 1548 1549 1550 /******************************* 1551 * XPCE STUFF * 1552 *******************************/ 1553 1554pce_goal(new(_,_), new(-, new)). 1555pce_goal(send(_,_), send(arg, msg)). 1556pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1557pce_goal(get(_,_,_), get(arg, msg, -)). 1558pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1559pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1560pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1561 1562process_xpce_goal(G, Origin, Src) :- 1563 pce_goal(G, Process), 1564 !, 1565 assert_called(Src, Origin, G), 1566 ( arg(I, Process, How), 1567 arg(I, G, Term), 1568 process_xpce_arg(How, Term, Origin, Src), 1569 fail 1570 ; true 1571 ). 1572 1573process_xpce_arg(new, Term, Origin, Src) :- 1574 callable(Term), 1575 process_new(Term, Origin, Src). 1576process_xpce_arg(arg, Term, Origin, Src) :- 1577 compound(Term), 1578 process_new(Term, Origin, Src). 1579process_xpce_arg(msg, Term, Origin, Src) :- 1580 compound(Term), 1581 ( arg(_, Term, Arg), 1582 process_xpce_arg(arg, Arg, Origin, Src), 1583 fail 1584 ; true 1585 ). 1586 1587process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1588process_new(Term, Origin, Src) :- 1589 assert_new(Src, Origin, Term), 1590 ( compound(Term), 1591 arg(_, Term, Arg), 1592 process_xpce_arg(arg, Arg, Origin, Src), 1593 fail 1594 ; true 1595 ). 1596 1597assert_new(_, _, Term) :- 1598 \+ callable(Term), 1599 !. 1600assert_new(Src, Origin, Control) :- 1601 functor_name(Control, Class), 1602 pce_control_class(Class), 1603 !, 1604 forall(arg(_, Control, Arg), 1605 assert_new(Src, Origin, Arg)). 1606assert_new(Src, Origin, Term) :- 1607 compound(Term), 1608 arg(1, Term, Prolog), 1609 Prolog == @(prolog), 1610 ( Term =.. [message, _, Selector | T], 1611 atom(Selector) 1612 -> Called =.. [Selector|T], 1613 process_body(Called, Origin, Src) 1614 ; Term =.. [?, _, Selector | T], 1615 atom(Selector) 1616 -> append(T, [_R], T2), 1617 Called =.. [Selector|T2], 1618 process_body(Called, Origin, Src) 1619 ), 1620 fail. 1621assert_new(_, _, @(_)) :- !. 1622assert_new(Src, _, Term) :- 1623 functor_name(Term, Name), 1624 assert_used_class(Src, Name). 1625 1626 1627pce_control_class(and). 1628pce_control_class(or). 1629pce_control_class(if). 1630pce_control_class(not). 1631 1632 1633 /******************************** 1634 * INCLUDED MODULES * 1635 ********************************/
1639process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1640process_use_module([], _, _) :- !. 1641process_use_module([H|T], Src, Reexport) :- 1642 !, 1643 process_use_module(H, Src, Reexport), 1644 process_use_module(T, Src, Reexport). 1645process_use_module(library(pce), Src, Reexport) :- % bit special 1646 !, 1647 xref_public_list(library(pce), Path, Exports, Src), 1648 forall(member(Import, Exports), 1649 process_pce_import(Import, Src, Path, Reexport)). 1650process_use_module(File, Src, Reexport) :- 1651 ( xoption(Src, silent(Silent)) 1652 -> Extra = [silent(Silent)] 1653 ; Extra = [silent(true)] 1654 ), 1655 ( xref_public_list(File, Src, 1656 [ path(Path), 1657 module(M), 1658 exports(Exports), 1659 public(Public), 1660 meta(Meta) 1661 | Extra 1662 ]) 1663 -> assert(uses_file(File, Src, Path)), 1664 assert_import(Src, Exports, _, Path, Reexport), 1665 assert_xmodule_callable(Exports, M, Src, Path), 1666 assert_xmodule_callable(Public, M, Src, Path), 1667 maplist(process_meta_head(Src), Meta), 1668 ( File = library(chr) % hacky 1669 -> assert(mode(chr, Src)) 1670 ; true 1671 ) 1672 ; assert(uses_file(File, Src, '<not_found>')) 1673 ). 1674 1675process_pce_import(Name/Arity, Src, Path, Reexport) :- 1676 atom(Name), 1677 integer(Arity), 1678 !, 1679 functor(Term, Name, Arity), 1680 ( \+ system_predicate(Term), 1681 \+ Term = pce_error(_) % hack!? 1682 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1683 ; true 1684 ). 1685process_pce_import(op(P,T,N), Src, _, _) :- 1686 xref_push_op(Src, P, T, N).
1692process_use_module2(File, Import, Src, Reexport) :-
1693 ( xref_source_file(File, Path, Src)
1694 -> assert(uses_file(File, Src, Path)),
1695 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1696 -> assert_import(Src, Import, Export, Path, Reexport),
1697 forall(( member(Head, Meta),
1698 imported(Head, _, Path)
1699 ),
1700 process_meta_head(Src, Head))
1701 ; true
1702 )
1703 ; assert(uses_file(File, Src, '<not_found>'))
1704 ).
1731xref_public_list(File, Src, Options) :-
1732 option(path(Path), Options, _),
1733 option(module(Module), Options, _),
1734 option(exports(Exports), Options, _),
1735 option(public(Public), Options, _),
1736 option(meta(Meta), Options, _),
1737 xref_source_file(File, Path, Src, Options),
1738 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
1760xref_public_list(File, Path, Export, Src) :- 1761 xref_source_file(File, Path, Src), 1762 public_list(Path, _, _, Export, _, []). 1763xref_public_list(File, Path, Module, Export, Meta, Src) :- 1764 xref_source_file(File, Path, Src), 1765 public_list(Path, Module, Meta, Export, _, []). 1766xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 1767 xref_source_file(File, Path, Src), 1768 public_list(Path, Module, Meta, Export, Public, []). 1769 1770public_list(Path, Module, Meta, Export, Public, Options) :- 1771 public_list_diff(Path, Module, Meta, [], Export, [], Public, [], Options). 1772 1773public_list_diff(Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 1774 setup_call_cleanup( 1775 ( prolog_open_source(Path, In), 1776 set_xref(Old) 1777 ), 1778 phrase(read_directives(In, Options, [true]), Directives), 1779 ( set_prolog_flag(xref, Old), 1780 prolog_close_source(In) 1781 )), 1782 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 1783 1784 1785read_directives(In, Options, State) --> 1786 { repeat, 1787 catch(prolog_read_source_term(In, Term, Expanded, 1788 [ process_comment(true), 1789 syntax_errors(error) 1790 ]), 1791 E, report_syntax_error(E, -, Options)) 1792 -> nonvar(Term), 1793 Term = (:-_) 1794 }, 1795 !, 1796 terms(Expanded, State, State1), 1797 read_directives(In, Options, State1). 1798read_directives(_, _, _) --> []. 1799 1800terms(Var, State, State) --> { var(Var) }, !. 1801terms([H|T], State0, State) --> 1802 !, 1803 terms(H, State0, State1), 1804 terms(T, State1, State). 1805terms((:-if(Cond)), State0, [True|State0]) --> 1806 !, 1807 { eval_cond(Cond, True) }. 1808terms((:-elif(Cond)), [True0|State], [True|State]) --> 1809 !, 1810 { eval_cond(Cond, True1), 1811 elif(True0, True1, True) 1812 }. 1813terms((:-else), [True0|State], [True|State]) --> 1814 !, 1815 { negate(True0, True) }. 1816terms((:-endif), [_|State], State) --> !. 1817terms(H, State, State) --> 1818 ( {State = [true|_]} 1819 -> [H] 1820 ; [] 1821 ). 1822 1823eval_cond(Cond, true) :- 1824 catch(, _, fail), 1825 !. 1826eval_cond(_, false). 1827 1828elif(true, _, else_false) :- !. 1829elif(false, true, true) :- !. 1830elif(True, _, True). 1831 1832negate(true, false). 1833negate(false, true). 1834negate(else_false, else_false). 1835 1836public_list([(:- module(Module, Export0))|Decls], Path, 1837 Module, Meta, MT, Export, Rest, Public, PT) :- 1838 !, 1839 append(Export0, Reexport, Export), 1840 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 1841public_list([(:- encoding(_))|Decls], Path, 1842 Module, Meta, MT, Export, Rest, Public, PT) :- 1843 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 1844 1845public_list_([], _, Meta, Meta, Export, Export, Public, Public). 1846public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 1847 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 1848 !, 1849 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 1850public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 1851 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 1852 1853public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 1854 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 1855public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 1856 public_from_import(Import, Spec, Path, Reexport, Rest). 1857public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 1858 phrase(meta_decls(Decl), Meta, MT). 1859public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 1860 phrase(public_decls(Decl), Public, PT). 1861 1862reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 1863reexport_files([H|T], Src, Meta, MT, Export, Rest, Public, PT) :- 1864 !, 1865 xref_source_file(H, Path, Src), 1866 public_list_diff(Path, _, Meta, MT0, Export, Rest0, Public, PT0, []), 1867 reexport_files(T, Src, MT0, MT, Rest0, Rest, PT0, PT). 1868reexport_files(Spec, Src, Meta, MT, Export, Rest, Public, PT) :- 1869 xref_source_file(Spec, Path, Src), 1870 public_list_diff(Path, _, Meta, MT, Export, Rest, Public, PT, []). 1871 1872public_from_import(except(Map), Path, Src, Export, Rest) :- 1873 !, 1874 xref_public_list(Path, _, AllExports, Src), 1875 except(Map, AllExports, NewExports), 1876 append(NewExports, Rest, Export). 1877public_from_import(Import, _, _, Export, Rest) :- 1878 import_name_map(Import, Export, Rest).
1883except([], Exports, Exports). 1884except([PI0 as NewName|Map], Exports0, Exports) :- 1885 !, 1886 canonical_pi(PI0, PI), 1887 map_as(Exports0, PI, NewName, Exports1), 1888 except(Map, Exports1, Exports). 1889except([PI0|Map], Exports0, Exports) :- 1890 canonical_pi(PI0, PI), 1891 select(PI2, Exports0, Exports1), 1892 same_pi(PI, PI2), 1893 !, 1894 except(Map, Exports1, Exports). 1895 1896 1897map_as([PI|T], Repl, As, [PI2|T]) :- 1898 same_pi(Repl, PI), 1899 !, 1900 pi_as(PI, As, PI2). 1901map_as([H|T0], Repl, As, [H|T]) :- 1902 map_as(T0, Repl, As, T). 1903 1904pi_as(_/Arity, Name, Name/Arity). 1905pi_as(_//Arity, Name, Name//Arity). 1906 1907import_name_map([], L, L). 1908import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 1909 !, 1910 import_name_map(T0, T, Tail). 1911import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 1912 !, 1913 import_name_map(T0, T, Tail). 1914import_name_map([H|T0], [H|T], Tail) :- 1915 import_name_map(T0, T, Tail). 1916 1917canonical_pi(Name//Arity0, PI) :- 1918 integer(Arity0), 1919 !, 1920 PI = Name/Arity, 1921 Arity is Arity0 + 2. 1922canonical_pi(PI, PI). 1923 1924same_pi(Canonical, PI2) :- 1925 canonical_pi(PI2, Canonical). 1926 1927meta_decls(Var) --> 1928 { var(Var) }, 1929 !. 1930meta_decls((A,B)) --> 1931 !, 1932 meta_decls(A), 1933 meta_decls(B). 1934meta_decls(A) --> 1935 [A]. 1936 1937public_decls(Var) --> 1938 { var(Var) }, 1939 !. 1940public_decls((A,B)) --> 1941 !, 1942 public_decls(A), 1943 public_decls(B). 1944public_decls(A) --> 1945 [A]. 1946 1947 /******************************* 1948 * INCLUDE * 1949 *******************************/ 1950 1951process_include([], _) :- !. 1952process_include([H|T], Src) :- 1953 !, 1954 process_include(H, Src), 1955 process_include(T, Src). 1956process_include(File, Src) :- 1957 callable(File), 1958 !, 1959 ( once(xref_input(ParentSrc, _)), 1960 xref_source_file(File, Path, ParentSrc) 1961 -> ( ( uses_file(_, Src, Path) 1962 ; Path == Src 1963 ) 1964 -> true 1965 ; assert(uses_file(File, Src, Path)), 1966 ( xoption(Src, process_include(true)) 1967 -> findall(O, xoption(Src, O), Options), 1968 setup_call_cleanup( 1969 open_include_file(Path, In, Refs), 1970 collect(Src, Path, In, Options), 1971 close_include(In, Refs)) 1972 ; true 1973 ) 1974 ) 1975 ; assert(uses_file(File, Src, '<not_found>')) 1976 ). 1977process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.1985open_include_file(Path, In, [Ref]) :- 1986 once(xref_input(_, Parent)), 1987 stream_property(Parent, encoding(Enc)), 1988 '$push_input_context'(xref_include), 1989 catch(( prolog:xref_open_source(Path, In) 1990 -> set_stream(In, encoding(Enc)) 1991 ; include_encoding(Enc, Options), 1992 open(Path, read, In, Options) 1993 ), E, 1994 ( '$pop_input_context', throw(E))), 1995 catch(( peek_char(In, #) % Deal with #! script 1996 -> skip(In, 10) 1997 ; true 1998 ), E, 1999 ( close_include(In, []), throw(E))), 2000 asserta(xref_input(Path, In), Ref). 2001 2002include_encoding(wchar_t, []) :- !. 2003include_encoding(Enc, [encoding(Enc)]). 2004 2005 2006close_include(In, Refs) :- 2007 maplist(erase, Refs), 2008 close(In, [force(true)]), 2009 '$pop_input_context'.
2015process_foreign(Spec, Src) :- 2016 ground(Spec), 2017 current_foreign_library(Spec, Defined), 2018 !, 2019 ( xmodule(Module, Src) 2020 -> true 2021 ; Module = user 2022 ), 2023 process_foreign_defined(Defined, Module, Src). 2024process_foreign(_, _). 2025 2026process_foreign_defined([], _, _). 2027process_foreign_defined([H|T], M, Src) :- 2028 ( H = M:Head 2029 -> assert_foreign(Src, Head) 2030 ; assert_foreign(Src, H) 2031 ), 2032 process_foreign_defined(T, M, Src). 2033 2034 2035 /******************************* 2036 * CHR SUPPORT * 2037 *******************************/ 2038 2039/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2040This part of the file supports CHR. Our choice is between making special 2041hooks to make CHR expansion work and then handle the (complex) expanded 2042code or process the CHR source directly. The latter looks simpler, 2043though I don't like the idea of adding support for libraries to this 2044module. A file is supposed to be a CHR file if it uses a 2045use_module(library(chr) or contains a :- constraint/1 directive. As an 2046extra bonus we get the source-locations right :-) 2047- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2048 2049process_chr(@(_Name, Rule), Src) :- 2050 mode(chr, Src), 2051 process_chr(Rule, Src). 2052process_chr(pragma(Rule, _Pragma), Src) :- 2053 mode(chr, Src), 2054 process_chr(Rule, Src). 2055process_chr(<=>(Head, Body), Src) :- 2056 mode(chr, Src), 2057 chr_head(Head, Src, H), 2058 chr_body(Body, H, Src). 2059process_chr(==>(Head, Body), Src) :- 2060 mode(chr, Src), 2061 chr_head(Head, H, Src), 2062 chr_body(Body, H, Src). 2063process_chr((:- chr_constraint(_)), Src) :- 2064 ( mode(chr, Src) 2065 -> true 2066 ; assert(mode(chr, Src)) 2067 ). 2068 2069chr_head(X, _, _) :- 2070 var(X), 2071 !. % Illegal. Warn? 2072chr_head(\(A,B), Src, H) :- 2073 chr_head(A, Src, H), 2074 process_body(B, H, Src). 2075chr_head((H0,B), Src, H) :- 2076 chr_defined(H0, Src, H), 2077 process_body(B, H, Src). 2078chr_head(H0, Src, H) :- 2079 chr_defined(H0, Src, H). 2080 2081chr_defined(X, _, _) :- 2082 var(X), 2083 !. 2084chr_defined(#(C,_Id), Src, C) :- 2085 !, 2086 assert_constraint(Src, C). 2087chr_defined(A, Src, A) :- 2088 assert_constraint(Src, A). 2089 2090chr_body(X, From, Src) :- 2091 var(X), 2092 !, 2093 process_body(X, From, Src). 2094chr_body('|'(Guard, Goals), H, Src) :- 2095 !, 2096 chr_body(Guard, H, Src), 2097 chr_body(Goals, H, Src). 2098chr_body(G, From, Src) :- 2099 process_body(G, From, Src). 2100 2101assert_constraint(_, Head) :- 2102 var(Head), 2103 !. 2104assert_constraint(Src, Head) :- 2105 constraint(Head, Src, _), 2106 !. 2107assert_constraint(Src, Head) :- 2108 generalise_term(Head, Term), 2109 current_source_line(Line), 2110 assert(constraint(Term, Src, Line)). 2111 2112 2113 /******************************** 2114 * PHASE 1 ASSERTIONS * 2115 ********************************/
2122assert_called(_, _, Var) :- 2123 var(Var), 2124 !. 2125assert_called(Src, From, Goal) :- 2126 var(From), 2127 !, 2128 assert_called(Src, '<unknown>', Goal). 2129assert_called(_, _, Goal) :- 2130 expand_hide_called(Goal), 2131 !. 2132assert_called(Src, Origin, M:G) :- 2133 !, 2134 ( atom(M), 2135 callable(G) 2136 -> current_condition(Cond), 2137 ( xmodule(M, Src) % explicit call to own module 2138 -> assert_called(Src, Origin, G) 2139 ; called(M:G, Src, Origin, Cond) % already registered 2140 -> true 2141 ; hide_called(M:G, Src) % not interesting (now) 2142 -> true 2143 ; generalise(Origin, OTerm), 2144 generalise(G, GTerm) 2145 -> assert(called(M:GTerm, Src, OTerm, Cond)) 2146 ; true 2147 ) 2148 ; true % call to variable module 2149 ). 2150assert_called(Src, _, Goal) :- 2151 ( xmodule(M, Src) 2152 -> M \== system 2153 ; M = user 2154 ), 2155 hide_called(M:Goal, Src), 2156 !. 2157assert_called(Src, Origin, Goal) :- 2158 current_condition(Cond), 2159 ( called(Goal, Src, Origin, Cond) 2160 -> true 2161 ; generalise(Origin, OTerm), 2162 generalise(Goal, Term) 2163 -> assert(called(Term, Src, OTerm, Cond)) 2164 ; true 2165 ).
2173expand_hide_called(pce_principal:send_implementation(_, _, _)). 2174expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2175expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2176expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2177 2178assert_defined(Src, Goal) :- 2179 defined(Goal, Src, _), 2180 !. 2181assert_defined(Src, Goal) :- 2182 generalise(Goal, Term), 2183 current_source_line(Line), 2184 assert(defined(Term, Src, Line)). 2185 2186assert_foreign(Src, Goal) :- 2187 foreign(Goal, Src, _), 2188 !. 2189assert_foreign(Src, Goal) :- 2190 generalise(Goal, Term), 2191 current_source_line(Line), 2192 assert(foreign(Term, Src, Line)).
true, re-export the
imported predicates.
2204assert_import(_, [], _, _, _) :- !. 2205assert_import(Src, [H|T], Export, From, Reexport) :- 2206 !, 2207 assert_import(Src, H, Export, From, Reexport), 2208 assert_import(Src, T, Export, From, Reexport). 2209assert_import(Src, except(Except), Export, From, Reexport) :- 2210 !, 2211 is_list(Export), 2212 !, 2213 except(Except, Export, Import), 2214 assert_import(Src, Import, _All, From, Reexport). 2215assert_import(Src, Import as Name, Export, From, Reexport) :- 2216 !, 2217 pi_to_head(Import, Term0), 2218 rename_goal(Term0, Name, Term), 2219 ( in_export_list(Term0, Export) 2220 -> assert(imported(Term, Src, From)), 2221 assert_reexport(Reexport, Src, Term) 2222 ; current_source_line(Line), 2223 assert_called(Src, '<directive>'(Line), Term0) 2224 ). 2225assert_import(Src, Import, Export, From, Reexport) :- 2226 pi_to_head(Import, Term), 2227 !, 2228 ( in_export_list(Term, Export) 2229 -> assert(imported(Term, Src, From)), 2230 assert_reexport(Reexport, Src, Term) 2231 ; current_source_line(Line), 2232 assert_called(Src, '<directive>'(Line), Term) 2233 ). 2234assert_import(Src, op(P,T,N), _, _, _) :- 2235 xref_push_op(Src, P,T,N). 2236 2237in_export_list(_Head, Export) :- 2238 var(Export), 2239 !. 2240in_export_list(Head, Export) :- 2241 member(PI, Export), 2242 pi_to_head(PI, Head). 2243 2244assert_reexport(false, _, _) :- !. 2245assert_reexport(true, Src, Term) :- 2246 assert(exported(Term, Src)).
2252process_import(M:PI, Src) :- 2253 pi_to_head(PI, Head), 2254 !, 2255 ( atom(M), 2256 current_module(M), 2257 module_property(M, file(From)) 2258 -> true 2259 ; From = '<unknown>' 2260 ), 2261 assert(imported(Head, Src, From)). 2262process_import(_, _).
2271assert_xmodule_callable([], _, _, _). 2272assert_xmodule_callable([PI|T], M, Src, From) :- 2273 ( pi_to_head(M:PI, Head) 2274 -> assert(imported(Head, Src, From)) 2275 ; true 2276 ), 2277 assert_xmodule_callable(T, M, Src, From).
2284assert_op(Src, op(P,T,_:N)) :-
2285 ( xop(Src, op(P,T,N))
2286 -> true
2287 ; valid_op(op(P,T,N))
2288 -> assert(xop(Src, op(P,T,N)))
2289 ; true
2290 ).2297assert_module(Src, Module) :- 2298 xmodule(Module, Src), 2299 !. 2300assert_module(Src, Module) :- 2301 '$set_source_module'(Module), 2302 assert(xmodule(Module, Src)), 2303 ( module_property(Module, class(system)) 2304 -> retractall(xoption(Src, register_called(_))), 2305 assert(xoption(Src, register_called(all))) 2306 ; true 2307 ). 2308 2309assert_module_export(_, []) :- !. 2310assert_module_export(Src, [H|T]) :- 2311 !, 2312 assert_module_export(Src, H), 2313 assert_module_export(Src, T). 2314assert_module_export(Src, PI) :- 2315 pi_to_head(PI, Term), 2316 !, 2317 assert(exported(Term, Src)). 2318assert_module_export(Src, op(P, A, N)) :- 2319 xref_push_op(Src, P, A, N).
2325assert_module3([], _) :- !. 2326assert_module3([H|T], Src) :- 2327 !, 2328 assert_module3(H, Src), 2329 assert_module3(T, Src). 2330assert_module3(Option, Src) :- 2331 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2340process_predicates(Closure, Preds, Src) :- 2341 is_list(Preds), 2342 !, 2343 process_predicate_list(Preds, Closure, Src). 2344process_predicates(Closure, Preds, Src) :- 2345 process_predicate_comma(Preds, Closure, Src). 2346 2347process_predicate_list([], _, _). 2348process_predicate_list([H|T], Closure, Src) :- 2349 ( nonvar(H) 2350 -> call(Closure, H, Src) 2351 ; true 2352 ), 2353 process_predicate_list(T, Closure, Src). 2354 2355process_predicate_comma(Var, _, _) :- 2356 var(Var), 2357 !. 2358process_predicate_comma(M:(A,B), Closure, Src) :- 2359 !, 2360 process_predicate_comma(M:A, Closure, Src), 2361 process_predicate_comma(M:B, Closure, Src). 2362process_predicate_comma((A,B), Closure, Src) :- 2363 !, 2364 process_predicate_comma(A, Closure, Src), 2365 process_predicate_comma(B, Closure, Src). 2366process_predicate_comma(A, Closure, Src) :- 2367 call(Closure, A, Src). 2368 2369 2370assert_dynamic(PI, Src) :- 2371 pi_to_head(PI, Term), 2372 ( thread_local(Term, Src, _) % dynamic after thread_local has 2373 -> true % no effect 2374 ; current_source_line(Line), 2375 assert(dynamic(Term, Src, Line)) 2376 ). 2377 2378assert_thread_local(PI, Src) :- 2379 pi_to_head(PI, Term), 2380 current_source_line(Line), 2381 assert(thread_local(Term, Src, Line)). 2382 2383assert_multifile(PI, Src) :- % :- multifile(Spec) 2384 pi_to_head(PI, Term), 2385 current_source_line(Line), 2386 assert(multifile(Term, Src, Line)). 2387 2388assert_public(PI, Src) :- % :- public(Spec) 2389 pi_to_head(PI, Term), 2390 current_source_line(Line), 2391 assert_called(Src, '<public>'(Line), Term), 2392 assert(public(Term, Src, Line)). 2393 2394assert_export(PI, Src) :- % :- export(Spec) 2395 pi_to_head(PI, Term), 2396 !, 2397 assert(exported(Term, Src)).
2404pi_to_head(Var, _) :- 2405 var(Var), !, fail. 2406pi_to_head(M:PI, M:Term) :- 2407 !, 2408 pi_to_head(PI, Term). 2409pi_to_head(Name/Arity, Term) :- 2410 functor(Term, Name, Arity). 2411pi_to_head(Name//DCGArity, Term) :- 2412 Arity is DCGArity+2, 2413 functor(Term, Name, Arity). 2414 2415 2416assert_used_class(Src, Name) :- 2417 used_class(Name, Src), 2418 !. 2419assert_used_class(Src, Name) :- 2420 assert(used_class(Name, Src)). 2421 2422assert_defined_class(Src, Name, _Meta, _Super, _) :- 2423 defined_class(Name, _, _, Src, _), 2424 !. 2425assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2426assert_defined_class(Src, Name, Meta, Super, Summary) :- 2427 current_source_line(Line), 2428 ( Summary == @(default) 2429 -> Atom = '' 2430 ; is_list(Summary) 2431 -> atom_codes(Atom, Summary) 2432 ; string(Summary) 2433 -> atom_concat(Summary, '', Atom) 2434 ), 2435 assert(defined_class(Name, Super, Atom, Src, Line)), 2436 ( Meta = @(_) 2437 -> true 2438 ; assert_used_class(Src, Meta) 2439 ), 2440 assert_used_class(Src, Super). 2441 2442assert_defined_class(Src, Name, imported_from(_File)) :- 2443 defined_class(Name, _, _, Src, _), 2444 !. 2445assert_defined_class(Src, Name, imported_from(File)) :- 2446 assert(defined_class(Name, _, '', Src, file(File))). 2447 2448 2449 /******************************** 2450 * UTILITIES * 2451 ********************************/
2457generalise(Var, Var) :- 2458 var(Var), 2459 !. % error? 2460generalise(pce_principal:send_implementation(Id, _, _), 2461 pce_principal:send_implementation(Id, _, _)) :- 2462 atom(Id), 2463 !. 2464generalise(pce_principal:get_implementation(Id, _, _, _), 2465 pce_principal:get_implementation(Id, _, _, _)) :- 2466 atom(Id), 2467 !. 2468generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2469generalise(Module:Goal0, Module:Goal) :- 2470 atom(Module), 2471 !, 2472 generalise(Goal0, Goal). 2473generalise(Term0, Term) :- 2474 callable(Term0), 2475 generalise_term(Term0, Term). 2476 2477 2478 /******************************* 2479 * SOURCE MANAGEMENT * 2480 *******************************/ 2481 2482/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2483This section of the file contains hookable predicates to reason about 2484sources. The built-in code here can only deal with files. The XPCE 2485library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2486can do cross-referencing on PceEmacs edit buffers. Other examples for 2487hooking can be databases, (HTTP) URIs, etc. 2488- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2489 2490:- multifile 2491 prolog:xref_source_directory/2, % +Source, -Dir 2492 prolog:xref_source_file/3. % +Spec, -Path, +Options
2500xref_source_file(Plain, File, Source) :- 2501 xref_source_file(Plain, File, Source, []). 2502 2503xref_source_file(QSpec, File, Source, Options) :- 2504 nonvar(QSpec), QSpec = _:Spec, 2505 !, 2506 must_be(acyclic, Spec), 2507 xref_source_file(Spec, File, Source, Options). 2508xref_source_file(Spec, File, Source, Options) :- 2509 nonvar(Spec), 2510 prolog:xref_source_file(Spec, File, 2511 [ relative_to(Source) 2512 | Options 2513 ]), 2514 !. 2515xref_source_file(Plain, File, Source, Options) :- 2516 atom(Plain), 2517 \+ is_absolute_file_name(Plain), 2518 ( prolog:xref_source_directory(Source, Dir) 2519 -> true 2520 ; atom(Source), 2521 file_directory_name(Source, Dir) 2522 ), 2523 atomic_list_concat([Dir, /, Plain], Spec0), 2524 absolute_file_name(Spec0, Spec), 2525 do_xref_source_file(Spec, File, Options), 2526 !. 2527xref_source_file(Spec, File, Source, Options) :- 2528 do_xref_source_file(Spec, File, 2529 [ relative_to(Source) 2530 | Options 2531 ]), 2532 !. 2533xref_source_file(_, _, _, Options) :- 2534 option(silent(true), Options), 2535 !, 2536 fail. 2537xref_source_file(Spec, _, Src, _Options) :- 2538 verbose(Src), 2539 print_message(warning, error(existence_error(file, Spec), _)), 2540 fail. 2541 2542do_xref_source_file(Spec, File, Options) :- 2543 nonvar(Spec), 2544 option(file_type(Type), Options, prolog), 2545 absolute_file_name(Spec, File, 2546 [ file_type(Type), 2547 access(read), 2548 file_errors(fail) 2549 ]), 2550 !.
2556canonical_source(Source, Src) :-
2557 ( ground(Source)
2558 -> prolog_canonical_source(Source, Src)
2559 ; Source = Src
2560 ).name()
goals.2567goal_name_arity(Goal, Name, Arity) :- 2568 ( compound(Goal) 2569 -> compound_name_arity(Goal, Name, Arity) 2570 ; atom(Goal) 2571 -> Name = Goal, Arity = 0 2572 ). 2573 2574generalise_term(Specific, General) :- 2575 ( compound(Specific) 2576 -> compound_name_arity(Specific, Name, Arity), 2577 compound_name_arity(General, Name, Arity) 2578 ; General = Specific 2579 ). 2580 2581functor_name(Term, Name) :- 2582 ( compound(Term) 2583 -> compound_name_arity(Term, Name, _) 2584 ; atom(Term) 2585 -> Name = Term 2586 ). 2587 2588rename_goal(Goal0, Name, Goal) :- 2589 ( compound(Goal0) 2590 -> compound_name_arity(Goal0, _, Arity), 2591 compound_name_arity(Goal, Name, Arity) 2592 ; Goal = Name 2593 )
Prolog cross-referencer data collection
This module implements to data-collection part of the cross-referencer. This code is used in two places: