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_create(A,_), [A]). 1149xref_meta(thread_signal(_,A), [A]). 1150xref_meta(thread_at_exit(A), [A]). 1151xref_meta(thread_initialization(A), [A]). 1152xref_meta(engine_create(_,A,_), [A]). 1153xref_meta(engine_create(_,A,_,_), [A]). 1154xref_meta(predsort(A,_,_), [A+3]). 1155xref_meta(call_cleanup(A, B), [A, B]). 1156xref_meta(call_cleanup(A, _, B),[A, B]). 1157xref_meta(setup_call_cleanup(A, B, C),[A, B, C]). 1158xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]). 1159xref_meta(call_residue_vars(A,_), [A]). 1160xref_meta(with_mutex(_,A), [A]). 1161xref_meta(assume(G), [G]). % library(debug) 1162xref_meta(assertion(G), [G]). % library(debug) 1163xref_meta(freeze(_, G), [G]). 1164xref_meta(when(C, A), [C, A]). 1165xref_meta(time(G), [G]). % development system 1166xref_meta(profile(G), [G]). 1167xref_meta(at_halt(G), [G]). 1168xref_meta(call_with_time_limit(_, G), [G]). 1169xref_meta(call_with_depth_limit(G, _, _), [G]). 1170xref_meta(call_with_inference_limit(G, _, _), [G]). 1171xref_meta(alarm(_, G, _), [G]). 1172xref_meta(alarm(_, G, _, _), [G]). 1173xref_meta('$add_directive_wic'(G), [G]). 1174xref_meta(with_output_to(_, G), [G]). 1175xref_meta(if(G), [G]). 1176xref_meta(elif(G), [G]). 1177xref_meta(meta_options(G,_,_), [G+1]). 1178xref_meta(on_signal(_,_,H), [H+1]) :- H \== default. 1179xref_meta(distinct(G), [G]). % library(solution_sequences) 1180xref_meta(distinct(_, G), [G]). 1181xref_meta(order_by(_, G), [G]). 1182xref_meta(limit(_, G), [G]). 1183xref_meta(offset(_, G), [G]). 1184xref_meta(reset(G,_,_), [G]). 1185 1186 % XPCE meta-predicates 1187xref_meta(pce_global(_, new(_)), _) :- !, fail. 1188xref_meta(pce_global(_, B), [B+1]). 1189xref_meta(ifmaintainer(G), [G]). % used in manual 1190xref_meta(listen(_, G), [G]). % library(broadcast) 1191xref_meta(listen(_, _, G), [G]). 1192xref_meta(in_pce_thread(G), [G]). 1193 1194xref_meta(G, Meta) :- % call user extensions 1195 prolog:meta_goal(G, Meta). 1196xref_meta(G, Meta) :- % Generated from :- meta_predicate 1197 meta_goal(G, Meta). 1198 1199setof_goal(EG, G) :- 1200 var(EG), !, G = EG. 1201setof_goal(_^EG, G) :- 1202 !, 1203 setof_goal(EG, G). 1204setof_goal(G, G).
1211head_of(Var, _) :- 1212 var(Var), !, fail. 1213head_of((Head :- _), Head). 1214head_of(Head, Head).
1222xref_hook(Hook) :- 1223 prolog:hook(Hook). 1224xref_hook(Hook) :- 1225 hook(Hook). 1226 1227 1228hook(attr_portray_hook(_,_)). 1229hook(attr_unify_hook(_,_)). 1230hook(attribute_goals(_,_,_)). 1231hook(goal_expansion(_,_)). 1232hook(term_expansion(_,_)). 1233hook(resource(_,_,_)). 1234hook('$pred_option'(_,_,_,_)). 1235 1236hook(emacs_prolog_colours:goal_classification(_,_)). 1237hook(emacs_prolog_colours:term_colours(_,_)). 1238hook(emacs_prolog_colours:goal_colours(_,_)). 1239hook(emacs_prolog_colours:style(_,_)). 1240hook(emacs_prolog_colours:identify(_,_)). 1241hook(pce_principal:pce_class(_,_,_,_,_,_)). 1242hook(pce_principal:send_implementation(_,_,_)). 1243hook(pce_principal:get_implementation(_,_,_,_)). 1244hook(pce_principal:pce_lazy_get_method(_,_,_)). 1245hook(pce_principal:pce_lazy_send_method(_,_,_)). 1246hook(pce_principal:pce_uses_template(_,_)). 1247hook(prolog:locate_clauses(_,_)). 1248hook(prolog:message(_,_,_)). 1249hook(prolog:error_message(_,_,_)). 1250hook(prolog:message_location(_,_,_)). 1251hook(prolog:message_context(_,_,_)). 1252hook(prolog:message_line_element(_,_)). 1253hook(prolog:debug_control_hook(_)). 1254hook(prolog:help_hook(_)). 1255hook(prolog:show_profile_hook(_,_)). 1256hook(prolog:general_exception(_,_)). 1257hook(prolog:predicate_summary(_,_)). 1258hook(prolog:residual_goals(_,_)). 1259hook(prolog_edit:load). 1260hook(prolog_edit:locate(_,_,_)). 1261hook(shlib:unload_all_foreign_libraries). 1262hook(system:'$foreign_registered'(_, _)). 1263hook(predicate_options:option_decl(_,_,_)). 1264hook(user:exception(_,_,_)). 1265hook(user:file_search_path(_,_)). 1266hook(user:library_directory(_)). 1267hook(user:message_hook(_,_,_)). 1268hook(user:portray(_)). 1269hook(user:prolog_clause_name(_,_)). 1270hook(user:prolog_list_goal(_)). 1271hook(user:prolog_predicate_name(_,_)). 1272hook(user:prolog_trace_interception(_,_,_,_)). 1273hook(user:prolog_event_hook(_)). 1274hook(user:prolog_exception_hook(_,_,_,_)). 1275hook(sandbox:safe_primitive(_)). 1276hook(sandbox:safe_meta_predicate(_)). 1277hook(sandbox:safe_meta(_,_)). 1278hook(sandbox:safe_global_variable(_)). 1279hook(sandbox:safe_directive(_)).
1286arith_callable(Var, _) :- 1287 var(Var), !, fail. 1288arith_callable(Module:Spec, Module:Goal) :- 1289 !, 1290 arith_callable(Spec, Goal). 1291arith_callable(Name/Arity, Goal) :- 1292 PredArity is Arity + 1, 1293 functor(Goal, Name, PredArity).
We limit the number of explored paths to 100 to avoid getting trapped in this analysis.
1304process_body(Body, Origin, Src) :-
1305 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1306 true).true if there was a
partial evalation inside Goal that has bound variables.1313process_goal(Var, _, _, _) :- 1314 var(Var), 1315 !. 1316process_goal(Goal, Origin, Src, P) :- 1317 Goal = (_,_), % problems 1318 !, 1319 phrase(conjunction(Goal), Goals), 1320 process_conjunction(Goals, Origin, Src, P). 1321process_goal(Goal, Origin, Src, _) :- % Final disjunction, no 1322 Goal = (_;_), % problems 1323 !, 1324 phrase(disjunction(Goal), Goals), 1325 forall(member(G, Goals), 1326 process_body(G, Origin, Src)). 1327process_goal(Goal, Origin, Src, P) :- 1328 ( ( xmodule(M, Src) 1329 -> true 1330 ; M = user 1331 ), 1332 ( predicate_property(M:Goal, imported_from(IM)) 1333 -> true 1334 ; IM = M 1335 ), 1336 prolog:called_by(Goal, IM, M, Called) 1337 ; prolog:called_by(Goal, Called) 1338 ), 1339 !, 1340 must_be(list, Called), 1341 assert_called(Src, Origin, Goal), 1342 process_called_list(Called, Origin, Src, P). 1343process_goal(Goal, Origin, Src, _) :- 1344 process_xpce_goal(Goal, Origin, Src), 1345 !. 1346process_goal(load_foreign_library(File), _Origin, Src, _) :- 1347 process_foreign(File, Src). 1348process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :- 1349 process_foreign(File, Src). 1350process_goal(use_foreign_library(File), _Origin, Src, _) :- 1351 process_foreign(File, Src). 1352process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :- 1353 process_foreign(File, Src). 1354process_goal(Goal, Origin, Src, P) :- 1355 xref_meta_src(Goal, Metas, Src), 1356 !, 1357 assert_called(Src, Origin, Goal), 1358 process_called_list(Metas, Origin, Src, P). 1359process_goal(Goal, Origin, Src, _) :- 1360 asserting_goal(Goal, Rule), 1361 !, 1362 assert_called(Src, Origin, Goal), 1363 process_assert(Rule, Origin, Src). 1364process_goal(Goal, Origin, Src, P) :- 1365 partial_evaluate(Goal, P), 1366 assert_called(Src, Origin, Goal). 1367 1368disjunction(Var) --> {var(Var), !}, [Var]. 1369disjunction((A;B)) --> !, disjunction(A), disjunction(B). 1370disjunction(G) --> [G]. 1371 1372conjunction(Var) --> {var(Var), !}, [Var]. 1373conjunction((A,B)) --> !, conjunction(A), conjunction(B). 1374conjunction(G) --> [G]. 1375 (RVars, T) :- 1377 term_variables(T, TVars0), 1378 sort(TVars0, TVars), 1379 ord_intersect(RVars, TVars). 1380 1381process_conjunction([], _, _, _). 1382process_conjunction([Disj|Rest], Origin, Src, P) :- 1383 nonvar(Disj), 1384 Disj = (_;_), 1385 Rest \== [], 1386 !, 1387 phrase(disjunction(Disj), Goals), 1388 term_variables(Rest, RVars0), 1389 sort(RVars0, RVars), 1390 partition(shares_vars(RVars), Goals, Sharing, NonSHaring), 1391 forall(member(G, NonSHaring), 1392 process_body(G, Origin, Src)), 1393 ( Sharing == [] 1394 -> true 1395 ; maplist(term_variables, Sharing, GVars0), 1396 append(GVars0, GVars1), 1397 sort(GVars1, GVars), 1398 ord_intersection(GVars, RVars, SVars), 1399 VT =.. [v|SVars], 1400 findall(VT, 1401 ( member(G, Sharing), 1402 process_goal(G, Origin, Src, PS), 1403 PS == true 1404 ), 1405 Alts0), 1406 ( Alts0 == [] 1407 -> true 1408 ; ( true 1409 ; P = true, 1410 sort(Alts0, Alts1), 1411 variants(Alts1, 10, Alts), 1412 member(VT, Alts) 1413 ) 1414 ) 1415 ), 1416 process_conjunction(Rest, Origin, Src, P). 1417process_conjunction([H|T], Origin, Src, P) :- 1418 process_goal(H, Origin, Src, P), 1419 process_conjunction(T, Origin, Src, P). 1420 1421 1422process_called_list([], _, _, _). 1423process_called_list([H|T], Origin, Src, P) :- 1424 process_meta(H, Origin, Src, P), 1425 process_called_list(T, Origin, Src, P). 1426 1427process_meta(A+N, Origin, Src, P) :- 1428 !, 1429 ( extend(A, N, AX) 1430 -> process_goal(AX, Origin, Src, P) 1431 ; true 1432 ). 1433process_meta(//(A), Origin, Src, P) :- 1434 !, 1435 process_dcg_goal(A, Origin, Src, P). 1436process_meta(G, Origin, Src, P) :- 1437 process_goal(G, Origin, Src, P).
1444process_dcg_goal(Var, _, _, _) :- 1445 var(Var), 1446 !. 1447process_dcg_goal((A,B), Origin, Src, P) :- 1448 !, 1449 process_dcg_goal(A, Origin, Src, P), 1450 process_dcg_goal(B, Origin, Src, P). 1451process_dcg_goal((A;B), Origin, Src, P) :- 1452 !, 1453 process_dcg_goal(A, Origin, Src, P), 1454 process_dcg_goal(B, Origin, Src, P). 1455process_dcg_goal((A|B), Origin, Src, P) :- 1456 !, 1457 process_dcg_goal(A, Origin, Src, P), 1458 process_dcg_goal(B, Origin, Src, P). 1459process_dcg_goal((A->B), Origin, Src, P) :- 1460 !, 1461 process_dcg_goal(A, Origin, Src, P), 1462 process_dcg_goal(B, Origin, Src, P). 1463process_dcg_goal((A*->B), Origin, Src, P) :- 1464 !, 1465 process_dcg_goal(A, Origin, Src, P), 1466 process_dcg_goal(B, Origin, Src, P). 1467process_dcg_goal({Goal}, Origin, Src, P) :- 1468 !, 1469 process_goal(Goal, Origin, Src, P). 1470process_dcg_goal(List, _Origin, _Src, _) :- 1471 is_list(List), 1472 !. % terminal 1473process_dcg_goal(List, _Origin, _Src, _) :- 1474 string(List), 1475 !. % terminal 1476process_dcg_goal(Callable, Origin, Src, P) :- 1477 extend(Callable, 2, Goal), 1478 !, 1479 process_goal(Goal, Origin, Src, P). 1480process_dcg_goal(_, _, _, _). 1481 1482 1483extend(Var, _, _) :- 1484 var(Var), !, fail. 1485extend(M:G, N, M:GX) :- 1486 !, 1487 callable(G), 1488 extend(G, N, GX). 1489extend(G, N, GX) :- 1490 ( compound(G) 1491 -> compound_name_arguments(G, Name, Args), 1492 length(Rest, N), 1493 append(Args, Rest, NArgs), 1494 compound_name_arguments(GX, Name, NArgs) 1495 ; atom(G) 1496 -> length(NArgs, N), 1497 compound_name_arguments(GX, G, NArgs) 1498 ). 1499 1500asserting_goal(assert(Rule), Rule). 1501asserting_goal(asserta(Rule), Rule). 1502asserting_goal(assertz(Rule), Rule). 1503asserting_goal(assert(Rule,_), Rule). 1504asserting_goal(asserta(Rule,_), Rule). 1505asserting_goal(assertz(Rule,_), Rule). 1506 1507process_assert(0, _, _) :- !. % catch variables 1508process_assert((_:-Body), Origin, Src) :- 1509 !, 1510 process_body(Body, Origin, Src). 1511process_assert(_, _, _).
1515variants([], _, []). 1516variants([H|T], Max, List) :- 1517 variants(T, H, Max, List). 1518 1519variants([], H, _, [H]). 1520variants(_, _, 0, []) :- !. 1521variants([H|T], V, Max, List) :- 1522 ( H =@= V 1523 -> variants(T, V, Max, List) 1524 ; List = [V|List2], 1525 Max1 is Max-1, 1526 variants(T, H, Max1, List2) 1527 ).
T = hello(X),
findall(T, T, List),
1541partial_evaluate(Goal, P) :- 1542 eval(Goal), 1543 !, 1544 P = true. 1545partial_evaluate(_, _). 1546 1547eval(X = Y) :- 1548 unify_with_occurs_check(X, Y). 1549 1550 1551 /******************************* 1552 * XPCE STUFF * 1553 *******************************/ 1554 1555pce_goal(new(_,_), new(-, new)). 1556pce_goal(send(_,_), send(arg, msg)). 1557pce_goal(send_class(_,_,_), send_class(arg, arg, msg)). 1558pce_goal(get(_,_,_), get(arg, msg, -)). 1559pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)). 1560pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)). 1561pce_goal(get_object(_,_,_), get_object(arg, msg, -)). 1562 1563process_xpce_goal(G, Origin, Src) :- 1564 pce_goal(G, Process), 1565 !, 1566 assert_called(Src, Origin, G), 1567 ( arg(I, Process, How), 1568 arg(I, G, Term), 1569 process_xpce_arg(How, Term, Origin, Src), 1570 fail 1571 ; true 1572 ). 1573 1574process_xpce_arg(new, Term, Origin, Src) :- 1575 callable(Term), 1576 process_new(Term, Origin, Src). 1577process_xpce_arg(arg, Term, Origin, Src) :- 1578 compound(Term), 1579 process_new(Term, Origin, Src). 1580process_xpce_arg(msg, Term, Origin, Src) :- 1581 compound(Term), 1582 ( arg(_, Term, Arg), 1583 process_xpce_arg(arg, Arg, Origin, Src), 1584 fail 1585 ; true 1586 ). 1587 1588process_new(_M:_Term, _, _) :- !. % TBD: Calls on other modules! 1589process_new(Term, Origin, Src) :- 1590 assert_new(Src, Origin, Term), 1591 ( compound(Term), 1592 arg(_, Term, Arg), 1593 process_xpce_arg(arg, Arg, Origin, Src), 1594 fail 1595 ; true 1596 ). 1597 1598assert_new(_, _, Term) :- 1599 \+ callable(Term), 1600 !. 1601assert_new(Src, Origin, Control) :- 1602 functor_name(Control, Class), 1603 pce_control_class(Class), 1604 !, 1605 forall(arg(_, Control, Arg), 1606 assert_new(Src, Origin, Arg)). 1607assert_new(Src, Origin, Term) :- 1608 compound(Term), 1609 arg(1, Term, Prolog), 1610 Prolog == @(prolog), 1611 ( Term =.. [message, _, Selector | T], 1612 atom(Selector) 1613 -> Called =.. [Selector|T], 1614 process_body(Called, Origin, Src) 1615 ; Term =.. [?, _, Selector | T], 1616 atom(Selector) 1617 -> append(T, [_R], T2), 1618 Called =.. [Selector|T2], 1619 process_body(Called, Origin, Src) 1620 ), 1621 fail. 1622assert_new(_, _, @(_)) :- !. 1623assert_new(Src, _, Term) :- 1624 functor_name(Term, Name), 1625 assert_used_class(Src, Name). 1626 1627 1628pce_control_class(and). 1629pce_control_class(or). 1630pce_control_class(if). 1631pce_control_class(not). 1632 1633 1634 /******************************** 1635 * INCLUDED MODULES * 1636 ********************************/
1640process_use_module(_Module:_Files, _, _) :- !. % loaded in another module 1641process_use_module([], _, _) :- !. 1642process_use_module([H|T], Src, Reexport) :- 1643 !, 1644 process_use_module(H, Src, Reexport), 1645 process_use_module(T, Src, Reexport). 1646process_use_module(library(pce), Src, Reexport) :- % bit special 1647 !, 1648 xref_public_list(library(pce), Path, Exports, Src), 1649 forall(member(Import, Exports), 1650 process_pce_import(Import, Src, Path, Reexport)). 1651process_use_module(File, Src, Reexport) :- 1652 ( xoption(Src, silent(Silent)) 1653 -> Extra = [silent(Silent)] 1654 ; Extra = [silent(true)] 1655 ), 1656 ( xref_public_list(File, Src, 1657 [ path(Path), 1658 module(M), 1659 exports(Exports), 1660 public(Public), 1661 meta(Meta) 1662 | Extra 1663 ]) 1664 -> assert(uses_file(File, Src, Path)), 1665 assert_import(Src, Exports, _, Path, Reexport), 1666 assert_xmodule_callable(Exports, M, Src, Path), 1667 assert_xmodule_callable(Public, M, Src, Path), 1668 maplist(process_meta_head(Src), Meta), 1669 ( File = library(chr) % hacky 1670 -> assert(mode(chr, Src)) 1671 ; true 1672 ) 1673 ; assert(uses_file(File, Src, '<not_found>')) 1674 ). 1675 1676process_pce_import(Name/Arity, Src, Path, Reexport) :- 1677 atom(Name), 1678 integer(Arity), 1679 !, 1680 functor(Term, Name, Arity), 1681 ( \+ system_predicate(Term), 1682 \+ Term = pce_error(_) % hack!? 1683 -> assert_import(Src, [Name/Arity], _, Path, Reexport) 1684 ; true 1685 ). 1686process_pce_import(op(P,T,N), Src, _, _) :- 1687 xref_push_op(Src, P, T, N).
1693process_use_module2(File, Import, Src, Reexport) :-
1694 ( xref_source_file(File, Path, Src)
1695 -> assert(uses_file(File, Src, Path)),
1696 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1697 -> assert_import(Src, Import, Export, Path, Reexport),
1698 forall(( member(Head, Meta),
1699 imported(Head, _, Path)
1700 ),
1701 process_meta_head(Src, Head))
1702 ; true
1703 )
1704 ; assert(uses_file(File, Src, '<not_found>'))
1705 ).
1732xref_public_list(File, Src, Options) :-
1733 option(path(Path), Options, _),
1734 option(module(Module), Options, _),
1735 option(exports(Exports), Options, _),
1736 option(public(Public), Options, _),
1737 option(meta(Meta), Options, _),
1738 xref_source_file(File, Path, Src, Options),
1739 public_list(Path, Module, Meta, Exports, Public, Options).These predicates fail if File is not a module-file.
1761xref_public_list(File, Path, Export, Src) :- 1762 xref_source_file(File, Path, Src), 1763 public_list(Path, _, _, Export, _, []). 1764xref_public_list(File, Path, Module, Export, Meta, Src) :- 1765 xref_source_file(File, Path, Src), 1766 public_list(Path, Module, Meta, Export, _, []). 1767xref_public_list(File, Path, Module, Export, Public, Meta, Src) :- 1768 xref_source_file(File, Path, Src), 1769 public_list(Path, Module, Meta, Export, Public, []). 1770 1771public_list(Path, Module, Meta, Export, Public, Options) :- 1772 public_list_diff(Path, Module, Meta, [], Export, [], Public, [], Options). 1773 1774public_list_diff(Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :- 1775 setup_call_cleanup( 1776 ( prolog_open_source(Path, In), 1777 set_xref(Old) 1778 ), 1779 phrase(read_directives(In, Options, [true]), Directives), 1780 ( set_prolog_flag(xref, Old), 1781 prolog_close_source(In) 1782 )), 1783 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT). 1784 1785 1786read_directives(In, Options, State) --> 1787 { repeat, 1788 catch(prolog_read_source_term(In, Term, Expanded, 1789 [ process_comment(true), 1790 syntax_errors(error) 1791 ]), 1792 E, report_syntax_error(E, -, Options)) 1793 -> nonvar(Term), 1794 Term = (:-_) 1795 }, 1796 !, 1797 terms(Expanded, State, State1), 1798 read_directives(In, Options, State1). 1799read_directives(_, _, _) --> []. 1800 1801terms(Var, State, State) --> { var(Var) }, !. 1802terms([H|T], State0, State) --> 1803 !, 1804 terms(H, State0, State1), 1805 terms(T, State1, State). 1806terms((:-if(Cond)), State0, [True|State0]) --> 1807 !, 1808 { eval_cond(Cond, True) }. 1809terms((:-elif(Cond)), [True0|State], [True|State]) --> 1810 !, 1811 { eval_cond(Cond, True1), 1812 elif(True0, True1, True) 1813 }. 1814terms((:-else), [True0|State], [True|State]) --> 1815 !, 1816 { negate(True0, True) }. 1817terms((:-endif), [_|State], State) --> !. 1818terms(H, State, State) --> 1819 ( {State = [true|_]} 1820 -> [H] 1821 ; [] 1822 ). 1823 1824eval_cond(Cond, true) :- 1825 catch(, _, fail), 1826 !. 1827eval_cond(_, false). 1828 1829elif(true, _, else_false) :- !. 1830elif(false, true, true) :- !. 1831elif(True, _, True). 1832 1833negate(true, false). 1834negate(false, true). 1835negate(else_false, else_false). 1836 1837public_list([(:- module(Module, Export0))|Decls], Path, 1838 Module, Meta, MT, Export, Rest, Public, PT) :- 1839 !, 1840 append(Export0, Reexport, Export), 1841 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT). 1842public_list([(:- encoding(_))|Decls], Path, 1843 Module, Meta, MT, Export, Rest, Public, PT) :- 1844 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT). 1845 1846public_list_([], _, Meta, Meta, Export, Export, Public, Public). 1847public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :- 1848 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0), 1849 !, 1850 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT). 1851public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :- 1852 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT). 1853 1854public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :- 1855 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT). 1856public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :- 1857 public_from_import(Import, Spec, Path, Reexport, Rest). 1858public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :- 1859 phrase(meta_decls(Decl), Meta, MT). 1860public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :- 1861 phrase(public_decls(Decl), Public, PT). 1862 1863reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !. 1864reexport_files([H|T], Src, Meta, MT, Export, Rest, Public, PT) :- 1865 !, 1866 xref_source_file(H, Path, Src), 1867 public_list_diff(Path, _, Meta, MT0, Export, Rest0, Public, PT0, []), 1868 reexport_files(T, Src, MT0, MT, Rest0, Rest, PT0, PT). 1869reexport_files(Spec, Src, Meta, MT, Export, Rest, Public, PT) :- 1870 xref_source_file(Spec, Path, Src), 1871 public_list_diff(Path, _, Meta, MT, Export, Rest, Public, PT, []). 1872 1873public_from_import(except(Map), Path, Src, Export, Rest) :- 1874 !, 1875 xref_public_list(Path, _, AllExports, Src), 1876 except(Map, AllExports, NewExports), 1877 append(NewExports, Rest, Export). 1878public_from_import(Import, _, _, Export, Rest) :- 1879 import_name_map(Import, Export, Rest).
1884except([], Exports, Exports). 1885except([PI0 as NewName|Map], Exports0, Exports) :- 1886 !, 1887 canonical_pi(PI0, PI), 1888 map_as(Exports0, PI, NewName, Exports1), 1889 except(Map, Exports1, Exports). 1890except([PI0|Map], Exports0, Exports) :- 1891 canonical_pi(PI0, PI), 1892 select(PI2, Exports0, Exports1), 1893 same_pi(PI, PI2), 1894 !, 1895 except(Map, Exports1, Exports). 1896 1897 1898map_as([PI|T], Repl, As, [PI2|T]) :- 1899 same_pi(Repl, PI), 1900 !, 1901 pi_as(PI, As, PI2). 1902map_as([H|T0], Repl, As, [H|T]) :- 1903 map_as(T0, Repl, As, T). 1904 1905pi_as(_/Arity, Name, Name/Arity). 1906pi_as(_//Arity, Name, Name//Arity). 1907 1908import_name_map([], L, L). 1909import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :- 1910 !, 1911 import_name_map(T0, T, Tail). 1912import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :- 1913 !, 1914 import_name_map(T0, T, Tail). 1915import_name_map([H|T0], [H|T], Tail) :- 1916 import_name_map(T0, T, Tail). 1917 1918canonical_pi(Name//Arity0, PI) :- 1919 integer(Arity0), 1920 !, 1921 PI = Name/Arity, 1922 Arity is Arity0 + 2. 1923canonical_pi(PI, PI). 1924 1925same_pi(Canonical, PI2) :- 1926 canonical_pi(PI2, Canonical). 1927 1928meta_decls(Var) --> 1929 { var(Var) }, 1930 !. 1931meta_decls((A,B)) --> 1932 !, 1933 meta_decls(A), 1934 meta_decls(B). 1935meta_decls(A) --> 1936 [A]. 1937 1938public_decls(Var) --> 1939 { var(Var) }, 1940 !. 1941public_decls((A,B)) --> 1942 !, 1943 public_decls(A), 1944 public_decls(B). 1945public_decls(A) --> 1946 [A]. 1947 1948 /******************************* 1949 * INCLUDE * 1950 *******************************/ 1951 1952process_include([], _) :- !. 1953process_include([H|T], Src) :- 1954 !, 1955 process_include(H, Src), 1956 process_include(T, Src). 1957process_include(File, Src) :- 1958 callable(File), 1959 !, 1960 ( once(xref_input(ParentSrc, _)), 1961 xref_source_file(File, Path, ParentSrc) 1962 -> ( ( uses_file(_, Src, Path) 1963 ; Path == Src 1964 ) 1965 -> true 1966 ; assert(uses_file(File, Src, Path)), 1967 ( xoption(Src, process_include(true)) 1968 -> findall(O, xoption(Src, O), Options), 1969 setup_call_cleanup( 1970 open_include_file(Path, In, Refs), 1971 collect(Src, Path, In, Options), 1972 close_include(In, Refs)) 1973 ; true 1974 ) 1975 ) 1976 ; assert(uses_file(File, Src, '<not_found>')) 1977 ). 1978process_include(_, _).
include(File) referenced file. Note that we cannot
use prolog_open_source/2 because we should not safe/restore
the lexical context.1986open_include_file(Path, In, [Ref]) :- 1987 once(xref_input(_, Parent)), 1988 stream_property(Parent, encoding(Enc)), 1989 '$push_input_context'(xref_include), 1990 catch(( prolog:xref_open_source(Path, In) 1991 -> set_stream(In, encoding(Enc)) 1992 ; include_encoding(Enc, Options), 1993 open(Path, read, In, Options) 1994 ), E, 1995 ( '$pop_input_context', throw(E))), 1996 catch(( peek_char(In, #) % Deal with #! script 1997 -> skip(In, 10) 1998 ; true 1999 ), E, 2000 ( close_include(In, []), throw(E))), 2001 asserta(xref_input(Path, In), Ref). 2002 2003include_encoding(wchar_t, []) :- !. 2004include_encoding(Enc, [encoding(Enc)]). 2005 2006 2007close_include(In, Refs) :- 2008 maplist(erase, Refs), 2009 close(In, [force(true)]), 2010 '$pop_input_context'.
2016process_foreign(Spec, Src) :- 2017 ground(Spec), 2018 current_foreign_library(Spec, Defined), 2019 !, 2020 ( xmodule(Module, Src) 2021 -> true 2022 ; Module = user 2023 ), 2024 process_foreign_defined(Defined, Module, Src). 2025process_foreign(_, _). 2026 2027process_foreign_defined([], _, _). 2028process_foreign_defined([H|T], M, Src) :- 2029 ( H = M:Head 2030 -> assert_foreign(Src, Head) 2031 ; assert_foreign(Src, H) 2032 ), 2033 process_foreign_defined(T, M, Src). 2034 2035 2036 /******************************* 2037 * CHR SUPPORT * 2038 *******************************/ 2039 2040/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2041This part of the file supports CHR. Our choice is between making special 2042hooks to make CHR expansion work and then handle the (complex) expanded 2043code or process the CHR source directly. The latter looks simpler, 2044though I don't like the idea of adding support for libraries to this 2045module. A file is supposed to be a CHR file if it uses a 2046use_module(library(chr) or contains a :- constraint/1 directive. As an 2047extra bonus we get the source-locations right :-) 2048- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2049 2050process_chr(@(_Name, Rule), Src) :- 2051 mode(chr, Src), 2052 process_chr(Rule, Src). 2053process_chr(pragma(Rule, _Pragma), Src) :- 2054 mode(chr, Src), 2055 process_chr(Rule, Src). 2056process_chr(<=>(Head, Body), Src) :- 2057 mode(chr, Src), 2058 chr_head(Head, Src, H), 2059 chr_body(Body, H, Src). 2060process_chr(==>(Head, Body), Src) :- 2061 mode(chr, Src), 2062 chr_head(Head, H, Src), 2063 chr_body(Body, H, Src). 2064process_chr((:- chr_constraint(_)), Src) :- 2065 ( mode(chr, Src) 2066 -> true 2067 ; assert(mode(chr, Src)) 2068 ). 2069 2070chr_head(X, _, _) :- 2071 var(X), 2072 !. % Illegal. Warn? 2073chr_head(\(A,B), Src, H) :- 2074 chr_head(A, Src, H), 2075 process_body(B, H, Src). 2076chr_head((H0,B), Src, H) :- 2077 chr_defined(H0, Src, H), 2078 process_body(B, H, Src). 2079chr_head(H0, Src, H) :- 2080 chr_defined(H0, Src, H). 2081 2082chr_defined(X, _, _) :- 2083 var(X), 2084 !. 2085chr_defined(#(C,_Id), Src, C) :- 2086 !, 2087 assert_constraint(Src, C). 2088chr_defined(A, Src, A) :- 2089 assert_constraint(Src, A). 2090 2091chr_body(X, From, Src) :- 2092 var(X), 2093 !, 2094 process_body(X, From, Src). 2095chr_body('|'(Guard, Goals), H, Src) :- 2096 !, 2097 chr_body(Guard, H, Src), 2098 chr_body(Goals, H, Src). 2099chr_body(G, From, Src) :- 2100 process_body(G, From, Src). 2101 2102assert_constraint(_, Head) :- 2103 var(Head), 2104 !. 2105assert_constraint(Src, Head) :- 2106 constraint(Head, Src, _), 2107 !. 2108assert_constraint(Src, Head) :- 2109 generalise_term(Head, Term), 2110 current_source_line(Line), 2111 assert(constraint(Term, Src, Line)). 2112 2113 2114 /******************************** 2115 * PHASE 1 ASSERTIONS * 2116 ********************************/
2123assert_called(_, _, Var) :- 2124 var(Var), 2125 !. 2126assert_called(Src, From, Goal) :- 2127 var(From), 2128 !, 2129 assert_called(Src, '<unknown>', Goal). 2130assert_called(_, _, Goal) :- 2131 expand_hide_called(Goal), 2132 !. 2133assert_called(Src, Origin, M:G) :- 2134 !, 2135 ( atom(M), 2136 callable(G) 2137 -> current_condition(Cond), 2138 ( xmodule(M, Src) % explicit call to own module 2139 -> assert_called(Src, Origin, G) 2140 ; called(M:G, Src, Origin, Cond) % already registered 2141 -> true 2142 ; hide_called(M:G, Src) % not interesting (now) 2143 -> true 2144 ; generalise(Origin, OTerm), 2145 generalise(G, GTerm) 2146 -> assert(called(M:GTerm, Src, OTerm, Cond)) 2147 ; true 2148 ) 2149 ; true % call to variable module 2150 ). 2151assert_called(Src, _, Goal) :- 2152 ( xmodule(M, Src) 2153 -> M \== system 2154 ; M = user 2155 ), 2156 hide_called(M:Goal, Src), 2157 !. 2158assert_called(Src, Origin, Goal) :- 2159 current_condition(Cond), 2160 ( called(Goal, Src, Origin, Cond) 2161 -> true 2162 ; generalise(Origin, OTerm), 2163 generalise(Goal, Term) 2164 -> assert(called(Term, Src, OTerm, Cond)) 2165 ; true 2166 ).
2174expand_hide_called(pce_principal:send_implementation(_, _, _)). 2175expand_hide_called(pce_principal:get_implementation(_, _, _, _)). 2176expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)). 2177expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)). 2178 2179assert_defined(Src, Goal) :- 2180 defined(Goal, Src, _), 2181 !. 2182assert_defined(Src, Goal) :- 2183 generalise(Goal, Term), 2184 current_source_line(Line), 2185 assert(defined(Term, Src, Line)). 2186 2187assert_foreign(Src, Goal) :- 2188 foreign(Goal, Src, _), 2189 !. 2190assert_foreign(Src, Goal) :- 2191 generalise(Goal, Term), 2192 current_source_line(Line), 2193 assert(foreign(Term, Src, Line)).
true, re-export the
imported predicates.
2205assert_import(_, [], _, _, _) :- !. 2206assert_import(Src, [H|T], Export, From, Reexport) :- 2207 !, 2208 assert_import(Src, H, Export, From, Reexport), 2209 assert_import(Src, T, Export, From, Reexport). 2210assert_import(Src, except(Except), Export, From, Reexport) :- 2211 !, 2212 is_list(Export), 2213 !, 2214 except(Except, Export, Import), 2215 assert_import(Src, Import, _All, From, Reexport). 2216assert_import(Src, Import as Name, Export, From, Reexport) :- 2217 !, 2218 pi_to_head(Import, Term0), 2219 rename_goal(Term0, Name, Term), 2220 ( in_export_list(Term0, Export) 2221 -> assert(imported(Term, Src, From)), 2222 assert_reexport(Reexport, Src, Term) 2223 ; current_source_line(Line), 2224 assert_called(Src, '<directive>'(Line), Term0) 2225 ). 2226assert_import(Src, Import, Export, From, Reexport) :- 2227 pi_to_head(Import, Term), 2228 !, 2229 ( in_export_list(Term, Export) 2230 -> assert(imported(Term, Src, From)), 2231 assert_reexport(Reexport, Src, Term) 2232 ; current_source_line(Line), 2233 assert_called(Src, '<directive>'(Line), Term) 2234 ). 2235assert_import(Src, op(P,T,N), _, _, _) :- 2236 xref_push_op(Src, P,T,N). 2237 2238in_export_list(_Head, Export) :- 2239 var(Export), 2240 !. 2241in_export_list(Head, Export) :- 2242 member(PI, Export), 2243 pi_to_head(PI, Head). 2244 2245assert_reexport(false, _, _) :- !. 2246assert_reexport(true, Src, Term) :- 2247 assert(exported(Term, Src)).
2253process_import(M:PI, Src) :- 2254 pi_to_head(PI, Head), 2255 !, 2256 ( atom(M), 2257 current_module(M), 2258 module_property(M, file(From)) 2259 -> true 2260 ; From = '<unknown>' 2261 ), 2262 assert(imported(Head, Src, From)). 2263process_import(_, _).
2272assert_xmodule_callable([], _, _, _). 2273assert_xmodule_callable([PI|T], M, Src, From) :- 2274 ( pi_to_head(M:PI, Head) 2275 -> assert(imported(Head, Src, From)) 2276 ; true 2277 ), 2278 assert_xmodule_callable(T, M, Src, From).
2285assert_op(Src, op(P,T,_:N)) :-
2286 ( xop(Src, op(P,T,N))
2287 -> true
2288 ; valid_op(op(P,T,N))
2289 -> assert(xop(Src, op(P,T,N)))
2290 ; true
2291 ).2298assert_module(Src, Module) :- 2299 xmodule(Module, Src), 2300 !. 2301assert_module(Src, Module) :- 2302 '$set_source_module'(Module), 2303 assert(xmodule(Module, Src)), 2304 ( module_property(Module, class(system)) 2305 -> retractall(xoption(Src, register_called(_))), 2306 assert(xoption(Src, register_called(all))) 2307 ; true 2308 ). 2309 2310assert_module_export(_, []) :- !. 2311assert_module_export(Src, [H|T]) :- 2312 !, 2313 assert_module_export(Src, H), 2314 assert_module_export(Src, T). 2315assert_module_export(Src, PI) :- 2316 pi_to_head(PI, Term), 2317 !, 2318 assert(exported(Term, Src)). 2319assert_module_export(Src, op(P, A, N)) :- 2320 xref_push_op(Src, P, A, N).
2326assert_module3([], _) :- !. 2327assert_module3([H|T], Src) :- 2328 !, 2329 assert_module3(H, Src), 2330 assert_module3(T, Src). 2331assert_module3(Option, Src) :- 2332 process_use_module(library(dialect/Option), Src, false).
call(Closure, PI,
Src). Handles both lists of specifications and (PI,...)
specifications.2341process_predicates(Closure, Preds, Src) :- 2342 is_list(Preds), 2343 !, 2344 process_predicate_list(Preds, Closure, Src). 2345process_predicates(Closure, Preds, Src) :- 2346 process_predicate_comma(Preds, Closure, Src). 2347 2348process_predicate_list([], _, _). 2349process_predicate_list([H|T], Closure, Src) :- 2350 ( nonvar(H) 2351 -> call(Closure, H, Src) 2352 ; true 2353 ), 2354 process_predicate_list(T, Closure, Src). 2355 2356process_predicate_comma(Var, _, _) :- 2357 var(Var), 2358 !. 2359process_predicate_comma(M:(A,B), Closure, Src) :- 2360 !, 2361 process_predicate_comma(M:A, Closure, Src), 2362 process_predicate_comma(M:B, Closure, Src). 2363process_predicate_comma((A,B), Closure, Src) :- 2364 !, 2365 process_predicate_comma(A, Closure, Src), 2366 process_predicate_comma(B, Closure, Src). 2367process_predicate_comma(A, Closure, Src) :- 2368 call(Closure, A, Src). 2369 2370 2371assert_dynamic(PI, Src) :- 2372 pi_to_head(PI, Term), 2373 ( thread_local(Term, Src, _) % dynamic after thread_local has 2374 -> true % no effect 2375 ; current_source_line(Line), 2376 assert(dynamic(Term, Src, Line)) 2377 ). 2378 2379assert_thread_local(PI, Src) :- 2380 pi_to_head(PI, Term), 2381 current_source_line(Line), 2382 assert(thread_local(Term, Src, Line)). 2383 2384assert_multifile(PI, Src) :- % :- multifile(Spec) 2385 pi_to_head(PI, Term), 2386 current_source_line(Line), 2387 assert(multifile(Term, Src, Line)). 2388 2389assert_public(PI, Src) :- % :- public(Spec) 2390 pi_to_head(PI, Term), 2391 current_source_line(Line), 2392 assert_called(Src, '<public>'(Line), Term), 2393 assert(public(Term, Src, Line)). 2394 2395assert_export(PI, Src) :- % :- export(Spec) 2396 pi_to_head(PI, Term), 2397 !, 2398 assert(exported(Term, Src)).
2405pi_to_head(Var, _) :- 2406 var(Var), !, fail. 2407pi_to_head(M:PI, M:Term) :- 2408 !, 2409 pi_to_head(PI, Term). 2410pi_to_head(Name/Arity, Term) :- 2411 functor(Term, Name, Arity). 2412pi_to_head(Name//DCGArity, Term) :- 2413 Arity is DCGArity+2, 2414 functor(Term, Name, Arity). 2415 2416 2417assert_used_class(Src, Name) :- 2418 used_class(Name, Src), 2419 !. 2420assert_used_class(Src, Name) :- 2421 assert(used_class(Name, Src)). 2422 2423assert_defined_class(Src, Name, _Meta, _Super, _) :- 2424 defined_class(Name, _, _, Src, _), 2425 !. 2426assert_defined_class(_, _, _, -, _) :- !. % :- pce_extend_class 2427assert_defined_class(Src, Name, Meta, Super, Summary) :- 2428 current_source_line(Line), 2429 ( Summary == @(default) 2430 -> Atom = '' 2431 ; is_list(Summary) 2432 -> atom_codes(Atom, Summary) 2433 ; string(Summary) 2434 -> atom_concat(Summary, '', Atom) 2435 ), 2436 assert(defined_class(Name, Super, Atom, Src, Line)), 2437 ( Meta = @(_) 2438 -> true 2439 ; assert_used_class(Src, Meta) 2440 ), 2441 assert_used_class(Src, Super). 2442 2443assert_defined_class(Src, Name, imported_from(_File)) :- 2444 defined_class(Name, _, _, Src, _), 2445 !. 2446assert_defined_class(Src, Name, imported_from(File)) :- 2447 assert(defined_class(Name, _, '', Src, file(File))). 2448 2449 2450 /******************************** 2451 * UTILITIES * 2452 ********************************/
2458generalise(Var, Var) :- 2459 var(Var), 2460 !. % error? 2461generalise(pce_principal:send_implementation(Id, _, _), 2462 pce_principal:send_implementation(Id, _, _)) :- 2463 atom(Id), 2464 !. 2465generalise(pce_principal:get_implementation(Id, _, _, _), 2466 pce_principal:get_implementation(Id, _, _, _)) :- 2467 atom(Id), 2468 !. 2469generalise('<directive>'(Line), '<directive>'(Line)) :- !. 2470generalise(Module:Goal0, Module:Goal) :- 2471 atom(Module), 2472 !, 2473 generalise(Goal0, Goal). 2474generalise(Term0, Term) :- 2475 callable(Term0), 2476 generalise_term(Term0, Term). 2477 2478 2479 /******************************* 2480 * SOURCE MANAGEMENT * 2481 *******************************/ 2482 2483/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2484This section of the file contains hookable predicates to reason about 2485sources. The built-in code here can only deal with files. The XPCE 2486library(pce_prolog_xref) provides hooks to deal with XPCE objects, so we 2487can do cross-referencing on PceEmacs edit buffers. Other examples for 2488hooking can be databases, (HTTP) URIs, etc. 2489- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2490 2491:- multifile 2492 prolog:xref_source_directory/2, % +Source, -Dir 2493 prolog:xref_source_file/3. % +Spec, -Path, +Options
2501xref_source_file(Plain, File, Source) :- 2502 xref_source_file(Plain, File, Source, []). 2503 2504xref_source_file(QSpec, File, Source, Options) :- 2505 nonvar(QSpec), QSpec = _:Spec, 2506 !, 2507 must_be(acyclic, Spec), 2508 xref_source_file(Spec, File, Source, Options). 2509xref_source_file(Spec, File, Source, Options) :- 2510 nonvar(Spec), 2511 prolog:xref_source_file(Spec, File, 2512 [ relative_to(Source) 2513 | Options 2514 ]), 2515 !. 2516xref_source_file(Plain, File, Source, Options) :- 2517 atom(Plain), 2518 \+ is_absolute_file_name(Plain), 2519 ( prolog:xref_source_directory(Source, Dir) 2520 -> true 2521 ; atom(Source), 2522 file_directory_name(Source, Dir) 2523 ), 2524 atomic_list_concat([Dir, /, Plain], Spec0), 2525 absolute_file_name(Spec0, Spec), 2526 do_xref_source_file(Spec, File, Options), 2527 !. 2528xref_source_file(Spec, File, Source, Options) :- 2529 do_xref_source_file(Spec, File, 2530 [ relative_to(Source) 2531 | Options 2532 ]), 2533 !. 2534xref_source_file(_, _, _, Options) :- 2535 option(silent(true), Options), 2536 !, 2537 fail. 2538xref_source_file(Spec, _, Src, _Options) :- 2539 verbose(Src), 2540 print_message(warning, error(existence_error(file, Spec), _)), 2541 fail. 2542 2543do_xref_source_file(Spec, File, Options) :- 2544 nonvar(Spec), 2545 option(file_type(Type), Options, prolog), 2546 absolute_file_name(Spec, File, 2547 [ file_type(Type), 2548 access(read), 2549 file_errors(fail) 2550 ]), 2551 !.
2557canonical_source(Source, Src) :-
2558 ( ground(Source)
2559 -> prolog_canonical_source(Source, Src)
2560 ; Source = Src
2561 ).name()
goals.2568goal_name_arity(Goal, Name, Arity) :- 2569 ( compound(Goal) 2570 -> compound_name_arity(Goal, Name, Arity) 2571 ; atom(Goal) 2572 -> Name = Goal, Arity = 0 2573 ). 2574 2575generalise_term(Specific, General) :- 2576 ( compound(Specific) 2577 -> compound_name_arity(Specific, Name, Arity), 2578 compound_name_arity(General, Name, Arity) 2579 ; General = Specific 2580 ). 2581 2582functor_name(Term, Name) :- 2583 ( compound(Term) 2584 -> compound_name_arity(Term, Name, _) 2585 ; atom(Term) 2586 -> Name = Term 2587 ). 2588 2589rename_goal(Goal0, Name, Goal) :- 2590 ( compound(Goal0) 2591 -> compound_name_arity(Goal0, _, Arity), 2592 compound_name_arity(Goal, Name, Arity) 2593 ; Goal = Name 2594 )
Prolog cross-referencer data collection
This module implements to data-collection part of the cross-referencer. This code is used in two places: