37
38:- module(prolog_xref,
39 [ xref_source/1, 40 xref_source/2, 41 xref_called/3, 42 xref_called/4, 43 xref_called/5, 44 xref_defined/3, 45 xref_definition_line/2, 46 xref_exported/2, 47 xref_module/2, 48 xref_uses_file/3, 49 xref_op/2, 50 xref_prolog_flag/4, 51 xref_comment/3, 52 xref_comment/4, 53 xref_mode/3, 54 xref_option/2, 55 xref_clean/1, 56 xref_current_source/1, 57 xref_done/2, 58 xref_built_in/1, 59 xref_source_file/3, 60 xref_source_file/4, 61 xref_public_list/3, 62 xref_public_list/4, 63 xref_public_list/6, 64 xref_public_list/7, 65 xref_meta/3, 66 xref_meta/2, 67 xref_hook/1, 68 69 xref_used_class/2, 70 xref_defined_class/3 71 ]). 72:- autoload(library(apply),[maplist/2,partition/4,maplist/3]). 73:- autoload(library(debug),[debug/3]). 74:- autoload(library(dialect),[expects_dialect/1]). 75:- autoload(library(error),[must_be/2,instantiation_error/1]). 76:- autoload(library(lists),[member/2,append/2,append/3,select/3]). 77:- autoload(library(modules),[in_temporary_module/3]). 78:- autoload(library(operators),[push_op/3]). 79:- autoload(library(option),[option/2,option/3]). 80:- autoload(library(ordsets),[ord_intersect/2,ord_intersection/3]). 81:- autoload(library(prolog_code), [pi_head/2]). 82:- autoload(library(prolog_source),
83 [ prolog_canonical_source/2,
84 prolog_open_source/2,
85 prolog_close_source/1,
86 prolog_read_source_term/4
87 ]). 88
89:- if(exists_source(library(shlib))). 90:- autoload(library(shlib),[current_foreign_library/2]). 91:- endif. 92:- autoload(library(solution_sequences),[distinct/2,limit/2]). 93
94:- if(exists_source(library(pldoc))). 95:- use_module(library(pldoc), []). 96:- use_module(library(pldoc/doc_process)). 97
98:- endif. 99
100:- predicate_options(xref_source/2, 2,
101 [ silent(boolean),
102 module(atom),
103 register_called(oneof([all,non_iso,non_built_in])),
104 comments(oneof([store,collect,ignore])),
105 process_include(boolean)
106 ]). 107
108
109:- dynamic
110 called/5, 111 (dynamic)/3, 112 (thread_local)/3, 113 (multifile)/3, 114 (public)/3, 115 defined/3, 116 meta_goal/3, 117 foreign/3, 118 constraint/3, 119 imported/3, 120 exported/2, 121 xmodule/2, 122 uses_file/3, 123 xop/2, 124 source/2, 125 used_class/2, 126 defined_class/5, 127 (mode)/2, 128 xoption/2, 129 xflag/4, 130
131 module_comment/3, 132 pred_comment/4, 133 pred_comment_link/3, 134 pred_mode/3. 135
136:- create_prolog_flag(xref, false, [type(boolean)]). 137
172
173:- predicate_options(xref_source_file/4, 4,
174 [ file_type(oneof([txt,prolog,directory])),
175 silent(boolean)
176 ]). 177:- predicate_options(xref_public_list/3, 3,
178 [ path(-atom),
179 module(-atom),
180 exports(-list(any)),
181 public(-list(any)),
182 meta(-list(any)),
183 silent(boolean)
184 ]). 185
186
187 190
197
205
210
215
216:- multifile
217 prolog:called_by/4, 218 prolog:called_by/2, 219 prolog:meta_goal/2, 220 prolog:hook/1, 221 prolog:generated_predicate/1, 222 prolog:no_autoload_module/1. 223
224:- meta_predicate
225 prolog:generated_predicate(:). 226
227:- dynamic
228 meta_goal/2. 229
230:- meta_predicate
231 process_predicates(2, +, +). 232
233 236
242
243hide_called(Callable, Src) :-
244 xoption(Src, register_called(Which)),
245 !,
246 mode_hide_called(Which, Callable).
247hide_called(Callable, _) :-
248 mode_hide_called(non_built_in, Callable).
249
250mode_hide_called(all, _) :- !, fail.
251mode_hide_called(non_iso, _:Goal) :-
252 goal_name_arity(Goal, Name, Arity),
253 current_predicate(system:Name/Arity),
254 predicate_property(system:Goal, iso).
255mode_hide_called(non_built_in, _:Goal) :-
256 goal_name_arity(Goal, Name, Arity),
257 current_predicate(system:Name/Arity),
258 predicate_property(system:Goal, built_in).
259mode_hide_called(non_built_in, M:Goal) :-
260 goal_name_arity(Goal, Name, Arity),
261 current_predicate(M:Name/Arity),
262 predicate_property(M:Goal, built_in).
263
267
268system_predicate(Goal) :-
269 goal_name_arity(Goal, Name, Arity),
270 current_predicate(system:Name/Arity), 271 predicate_property(system:Goal, built_in),
272 !.
273
274
275 278
279verbose(Src) :-
280 \+ xoption(Src, silent(true)).
281
282:- thread_local
283 xref_input/2. 284
285
310
311xref_source(Source) :-
312 xref_source(Source, []).
313
314xref_source(Source, Options) :-
315 prolog_canonical_source(Source, Src),
316 ( last_modified(Source, Modified)
317 -> ( source(Src, Modified)
318 -> true
319 ; xref_clean(Src),
320 assert(source(Src, Modified)),
321 do_xref(Src, Options)
322 )
323 ; xref_clean(Src),
324 get_time(Now),
325 assert(source(Src, Now)),
326 do_xref(Src, Options)
327 ).
328
329do_xref(Src, Options) :-
330 must_be(list, Options),
331 setup_call_cleanup(
332 xref_setup(Src, In, Options, State),
333 collect(Src, Src, In, Options),
334 xref_cleanup(State)).
335
336last_modified(Source, Modified) :-
337 prolog:xref_source_time(Source, Modified),
338 !.
339last_modified(Source, Modified) :-
340 atom(Source),
341 \+ is_global_url(Source),
342 exists_file(Source),
343 time_file(Source, Modified).
344
345is_global_url(File) :-
346 sub_atom(File, B, _, _, '://'),
347 !,
348 B > 1,
349 sub_atom(File, 0, B, _, Scheme),
350 atom_codes(Scheme, Codes),
351 maplist(between(0'a, 0'z), Codes).
352
353xref_setup(Src, In, Options, state(In, Dialect, Xref, [SRef|HRefs])) :-
354 maplist(assert_option(Src), Options),
355 assert_default_options(Src),
356 current_prolog_flag(emulated_dialect, Dialect),
357 prolog_open_source(Src, In),
358 set_initial_mode(In, Options),
359 asserta(xref_input(Src, In), SRef),
360 set_xref(Xref),
361 ( verbose(Src)
362 -> HRefs = []
363 ; asserta((user:thread_message_hook(_,Level,_) :-
364 hide_message(Level)),
365 Ref),
366 HRefs = [Ref]
367 ).
368
369hide_message(warning).
370hide_message(error).
371hide_message(informational).
372
373assert_option(_, Var) :-
374 var(Var),
375 !,
376 instantiation_error(Var).
377assert_option(Src, silent(Boolean)) :-
378 !,
379 must_be(boolean, Boolean),
380 assert(xoption(Src, silent(Boolean))).
381assert_option(Src, register_called(Which)) :-
382 !,
383 must_be(oneof([all,non_iso,non_built_in]), Which),
384 assert(xoption(Src, register_called(Which))).
385assert_option(Src, comments(CommentHandling)) :-
386 !,
387 must_be(oneof([store,collect,ignore]), CommentHandling),
388 assert(xoption(Src, comments(CommentHandling))).
389assert_option(Src, module(Module)) :-
390 !,
391 must_be(atom, Module),
392 assert(xoption(Src, module(Module))).
393assert_option(Src, process_include(Boolean)) :-
394 !,
395 must_be(boolean, Boolean),
396 assert(xoption(Src, process_include(Boolean))).
397
398assert_default_options(Src) :-
399 ( xref_option_default(Opt),
400 generalise_term(Opt, Gen),
401 ( xoption(Src, Gen)
402 -> true
403 ; assertz(xoption(Src, Opt))
404 ),
405 fail
406 ; true
407 ).
408
409xref_option_default(silent(false)).
410xref_option_default(register_called(non_built_in)).
411xref_option_default(comments(collect)).
412xref_option_default(process_include(true)).
413
417
418xref_cleanup(state(In, Dialect, Xref, Refs)) :-
419 prolog_close_source(In),
420 set_prolog_flag(emulated_dialect, Dialect),
421 set_prolog_flag(xref, Xref),
422 maplist(erase, Refs).
423
424set_xref(Xref) :-
425 current_prolog_flag(xref, Xref),
426 set_prolog_flag(xref, true).
427
434
435set_initial_mode(_Stream, Options) :-
436 option(module(Module), Options),
437 !,
438 '$set_source_module'(Module).
439set_initial_mode(Stream, _) :-
440 stream_property(Stream, file_name(Path)),
441 source_file_property(Path, load_context(M, _, Opts)),
442 !,
443 '$set_source_module'(M),
444 ( option(dialect(Dialect), Opts)
445 -> expects_dialect(Dialect)
446 ; true
447 ).
448set_initial_mode(_, _) :-
449 '$set_source_module'(user).
450
454
455xref_input_stream(Stream) :-
456 xref_input(_, Var),
457 !,
458 Stream = Var.
459
464
465xref_push_op(Src, P, T, N0) :-
466 '$current_source_module'(M0),
467 strip_module(M0:N0, M, N),
468 ( is_list(N),
469 N \== []
470 -> maplist(push_op(Src, P, T, M), N)
471 ; push_op(Src, P, T, M, N)
472 ).
473
474push_op(Src, P, T, M0, N0) :-
475 strip_module(M0:N0, M, N),
476 Name = M:N,
477 valid_op(op(P,T,Name)),
478 push_op(P, T, Name),
479 assert_op(Src, op(P,T,Name)),
480 debug(xref(op), ':- ~w.', [op(P,T,Name)]).
481
482valid_op(op(P,T,M:N)) :-
483 atom(M),
484 valid_op_name(N),
485 integer(P),
486 between(0, 1200, P),
487 atom(T),
488 op_type(T).
489
490valid_op_name(N) :-
491 atom(N),
492 !.
493valid_op_name(N) :-
494 N == [].
495
496op_type(xf).
497op_type(yf).
498op_type(fx).
499op_type(fy).
500op_type(xfx).
501op_type(xfy).
502op_type(yfx).
503
507
508xref_set_prolog_flag(Flag, Value, Src, Line) :-
509 atom(Flag),
510 !,
511 assertz(xflag(Flag, Value, Src, Line)).
512xref_set_prolog_flag(_, _, _, _).
513
517
518xref_clean(Source) :-
519 prolog_canonical_source(Source, Src),
520 retractall(called(_, Src, _Origin, _Cond, _Line)),
521 retractall(dynamic(_, Src, Line)),
522 retractall(multifile(_, Src, Line)),
523 retractall(public(_, Src, Line)),
524 retractall(defined(_, Src, Line)),
525 retractall(meta_goal(_, _, Src)),
526 retractall(foreign(_, Src, Line)),
527 retractall(constraint(_, Src, Line)),
528 retractall(imported(_, Src, _From)),
529 retractall(exported(_, Src)),
530 retractall(uses_file(_, Src, _)),
531 retractall(xmodule(_, Src)),
532 retractall(xop(Src, _)),
533 retractall(xoption(Src, _)),
534 retractall(xflag(_Name, _Value, Src, Line)),
535 retractall(source(Src, _)),
536 retractall(used_class(_, Src)),
537 retractall(defined_class(_, _, _, Src, _)),
538 retractall(mode(_, Src)),
539 retractall(module_comment(Src, _, _)),
540 retractall(pred_comment(_, Src, _, _)),
541 retractall(pred_comment_link(_, Src, _)),
542 retractall(pred_mode(_, Src, _)).
543
544
545 548
552
553xref_current_source(Source) :-
554 source(Source, _Time).
555
556
560
561xref_done(Source, Time) :-
562 prolog_canonical_source(Source, Src),
563 source(Src, Time).
564
565
584
585xref_called(Source, Called, By) :-
586 xref_called(Source, Called, By, _).
587
588xref_called(Source, Called, By, Cond) :-
589 canonical_source(Source, Src),
590 distinct(Called-By, called(Called, Src, By, Cond, _)).
591
592xref_called(Source, Called, By, Cond, Line) :-
593 canonical_source(Source, Src),
594 called(Called, Src, By, Cond, Line).
595
614
615xref_defined(Source, Called, How) :-
616 nonvar(Source),
617 !,
618 canonical_source(Source, Src),
619 xref_defined2(How, Src, Called).
620xref_defined(Source, Called, How) :-
621 xref_defined2(How, Src, Called),
622 canonical_source(Source, Src).
623
624xref_defined2(dynamic(Line), Src, Called) :-
625 dynamic(Called, Src, Line).
626xref_defined2(thread_local(Line), Src, Called) :-
627 thread_local(Called, Src, Line).
628xref_defined2(multifile(Line), Src, Called) :-
629 multifile(Called, Src, Line).
630xref_defined2(public(Line), Src, Called) :-
631 public(Called, Src, Line).
632xref_defined2(local(Line), Src, Called) :-
633 defined(Called, Src, Line).
634xref_defined2(foreign(Line), Src, Called) :-
635 foreign(Called, Src, Line).
636xref_defined2(constraint(Line), Src, Called) :-
637 constraint(Called, Src, Line).
638xref_defined2(imported(From), Src, Called) :-
639 imported(Called, Src, From).
640
641
646
647xref_definition_line(local(Line), Line).
648xref_definition_line(dynamic(Line), Line).
649xref_definition_line(thread_local(Line), Line).
650xref_definition_line(multifile(Line), Line).
651xref_definition_line(public(Line), Line).
652xref_definition_line(constraint(Line), Line).
653xref_definition_line(foreign(Line), Line).
654
655
659
660xref_exported(Source, Called) :-
661 prolog_canonical_source(Source, Src),
662 exported(Called, Src).
663
667
668xref_module(Source, Module) :-
669 nonvar(Source),
670 !,
671 prolog_canonical_source(Source, Src),
672 xmodule(Module, Src).
673xref_module(Source, Module) :-
674 xmodule(Module, Src),
675 prolog_canonical_source(Source, Src).
676
684
685xref_uses_file(Source, Spec, Path) :-
686 prolog_canonical_source(Source, Src),
687 uses_file(Spec, Src, Path).
688
696
697xref_op(Source, Op) :-
698 prolog_canonical_source(Source, Src),
699 xop(Src, Op).
700
706
707xref_prolog_flag(Source, Flag, Value, Line) :-
708 prolog_canonical_source(Source, Src),
709 xflag(Flag, Value, Src, Line).
710
711xref_built_in(Head) :-
712 system_predicate(Head).
713
714xref_used_class(Source, Class) :-
715 prolog_canonical_source(Source, Src),
716 used_class(Class, Src).
717
718xref_defined_class(Source, Class, local(Line, Super, Summary)) :-
719 prolog_canonical_source(Source, Src),
720 defined_class(Class, Super, Summary, Src, Line),
721 integer(Line),
722 !.
723xref_defined_class(Source, Class, file(File)) :-
724 prolog_canonical_source(Source, Src),
725 defined_class(Class, _, _, Src, file(File)).
726
727:- thread_local
728 current_cond/1,
729 source_line/1,
730 current_test_unit/2. 731
732current_source_line(Line) :-
733 source_line(Var),
734 !,
735 Line = Var.
736
742
743collect(Src, File, In, Options) :-
744 ( Src == File
745 -> SrcSpec = Line
746 ; SrcSpec = (File:Line)
747 ),
748 option(comments(CommentHandling), Options, collect),
749 ( CommentHandling == ignore
750 -> CommentOptions = [],
751 Comments = []
752 ; CommentHandling == store
753 -> CommentOptions = [ process_comment(true) ],
754 Comments = [],
755 set_prolog_flag(xref_store_comments, true)
756 ; CommentOptions = [ comments(Comments) ]
757 ),
758 repeat,
759 catch(prolog_read_source_term(
760 In, Term, Expanded,
761 [ term_position(TermPos)
762 | CommentOptions
763 ]),
764 E, report_syntax_error(E, Src, [])),
765 update_condition(Term),
766 stream_position_data(line_count, TermPos, Line),
767 setup_call_cleanup(
768 asserta(source_line(SrcSpec), Ref),
769 catch(process(Expanded, Comments, Term, TermPos, Src, EOF),
770 E, print_message(error, E)),
771 erase(Ref)),
772 EOF == true,
773 !,
774 set_prolog_flag(xref_store_comments, false).
775
776report_syntax_error(E, _, _) :-
777 fatal_error(E),
778 throw(E).
779report_syntax_error(_, _, Options) :-
780 option(silent(true), Options),
781 !,
782 fail.
783report_syntax_error(E, Src, _Options) :-
784 ( verbose(Src)
785 -> print_message(error, E)
786 ; true
787 ),
788 fail.
789
790fatal_error(time_limit_exceeded).
791fatal_error(error(resource_error(_),_)).
792
796
797update_condition((:-Directive)) :-
798 !,
799 update_cond(Directive).
800update_condition(_).
801
802update_cond(if(Cond)) :-
803 !,
804 asserta(current_cond(Cond)).
805update_cond(else) :-
806 retract(current_cond(C0)),
807 !,
808 assert(current_cond(\+C0)).
809update_cond(elif(Cond)) :-
810 retract(current_cond(C0)),
811 !,
812 assert(current_cond((\+C0,Cond))).
813update_cond(endif) :-
814 retract(current_cond(_)),
815 !.
816update_cond(_).
817
822
823current_condition(Condition) :-
824 \+ current_cond(_),
825 !,
826 Condition = true.
827current_condition(Condition) :-
828 findall(C, current_cond(C), List),
829 list_to_conj(List, Condition).
830
831list_to_conj([], true).
832list_to_conj([C], C) :- !.
833list_to_conj([H|T], (H,C)) :-
834 list_to_conj(T, C).
835
836
837 840
850
851process(Expanded, Comments, Term0, TermPos, Src, EOF) :-
852 is_list(Expanded), 853 !,
854 ( member(Term, Expanded),
855 process(Term, Term0, Src),
856 Term == end_of_file
857 -> EOF = true
858 ; EOF = false
859 ),
860 xref_comments(Comments, TermPos, Src).
861process(end_of_file, _, _, _, _, true) :-
862 !.
863process(Term, Comments, Term0, TermPos, Src, false) :-
864 process(Term, Term0, Src),
865 xref_comments(Comments, TermPos, Src).
866
868
869process(_, Term0, _) :-
870 ignore_raw_term(Term0),
871 !.
872process(Term, _Term0, Src) :-
873 process(Term, Src).
874
875ignore_raw_term((:- predicate_options(_,_,_))).
876
878
879process(Var, _) :-
880 var(Var),
881 !. 882process(end_of_file, _) :- !.
883process((:- Directive), Src) :-
884 !,
885 process_directive(Directive, Src),
886 !.
887process((?- Directive), Src) :-
888 !,
889 process_directive(Directive, Src),
890 !.
891process((Head :- Body), Src) :-
892 !,
893 assert_defined(Src, Head),
894 process_body(Body, Head, Src).
895process((Left => Body), Src) :-
896 !,
897 ( nonvar(Left),
898 Left = (Head, Guard)
899 -> assert_defined(Src, Head),
900 process_body(Guard, Head, Src),
901 process_body(Body, Head, Src)
902 ; assert_defined(Src, Left),
903 process_body(Body, Left, Src)
904 ).
905process(?=>(Head, Body), Src) :-
906 !,
907 assert_defined(Src, Head),
908 process_body(Body, Head, Src).
909process('$source_location'(_File, _Line):Clause, Src) :-
910 !,
911 process(Clause, Src).
912process(Term, Src) :-
913 process_chr(Term, Src),
914 !.
915process(M:(Head :- Body), Src) :-
916 !,
917 process((M:Head :- M:Body), Src).
918process(Head, Src) :-
919 assert_defined(Src, Head).
920
921
922 925
927
([], _Pos, _Src).
929:- if(current_predicate(parse_comment/3)). 930xref_comments([Pos-Comment|T], TermPos, Src) :-
931 ( Pos @> TermPos 932 -> true
933 ; stream_position_data(line_count, Pos, Line),
934 FilePos = Src:Line,
935 ( parse_comment(Comment, FilePos, Parsed)
936 -> assert_comments(Parsed, Src)
937 ; true
938 ),
939 xref_comments(T, TermPos, Src)
940 ).
941
([], _).
943assert_comments([H|T], Src) :-
944 assert_comment(H, Src),
945 assert_comments(T, Src).
946
(section(_Id, Title, Comment), Src) :-
948 assertz(module_comment(Src, Title, Comment)).
949assert_comment(predicate(PI, Summary, Comment), Src) :-
950 pi_to_head(PI, Src, Head),
951 assertz(pred_comment(Head, Src, Summary, Comment)).
952assert_comment(link(PI, PITo), Src) :-
953 pi_to_head(PI, Src, Head),
954 pi_to_head(PITo, Src, HeadTo),
955 assertz(pred_comment_link(Head, Src, HeadTo)).
956assert_comment(mode(Head, Det), Src) :-
957 assertz(pred_mode(Head, Src, Det)).
958
959pi_to_head(PI, Src, Head) :-
960 pi_to_head(PI, Head0),
961 ( Head0 = _:_
962 -> strip_module(Head0, M, Plain),
963 ( xmodule(M, Src)
964 -> Head = Plain
965 ; Head = M:Plain
966 )
967 ; Head = Head0
968 ).
969:- endif. 970
974
(Source, Title, Comment) :-
976 canonical_source(Source, Src),
977 module_comment(Src, Title, Comment).
978
982
(Source, Head, Summary, Comment) :-
984 canonical_source(Source, Src),
985 ( pred_comment(Head, Src, Summary, Comment)
986 ; pred_comment_link(Head, Src, HeadTo),
987 pred_comment(HeadTo, Src, Summary, Comment)
988 ).
989
994
995xref_mode(Source, Mode, Det) :-
996 canonical_source(Source, Src),
997 pred_mode(Mode, Src, Det).
998
1003
1004xref_option(Source, Option) :-
1005 canonical_source(Source, Src),
1006 xoption(Src, Option).
1007
1008
1009 1012
1013process_directive(Var, _) :-
1014 var(Var),
1015 !. 1016process_directive(Dir, _Src) :-
1017 debug(xref(directive), 'Processing :- ~q', [Dir]),
1018 fail.
1019process_directive((A,B), Src) :- 1020 !,
1021 process_directive(A, Src), 1022 process_directive(B, Src).
1023process_directive(List, Src) :-
1024 is_list(List),
1025 !,
1026 process_directive(consult(List), Src).
1027process_directive(use_module(File, Import), Src) :-
1028 process_use_module2(File, Import, Src, false).
1029process_directive(autoload(File, Import), Src) :-
1030 process_use_module2(File, Import, Src, false).
1031process_directive(require(Import), Src) :-
1032 process_requires(Import, Src).
1033process_directive(expects_dialect(Dialect), Src) :-
1034 process_directive(use_module(library(dialect/Dialect)), Src),
1035 expects_dialect(Dialect).
1036process_directive(reexport(File, Import), Src) :-
1037 process_use_module2(File, Import, Src, true).
1038process_directive(reexport(Modules), Src) :-
1039 process_use_module(Modules, Src, true).
1040process_directive(autoload(Modules), Src) :-
1041 process_use_module(Modules, Src, false).
1042process_directive(use_module(Modules), Src) :-
1043 process_use_module(Modules, Src, false).
1044process_directive(consult(Modules), Src) :-
1045 process_use_module(Modules, Src, false).
1046process_directive(ensure_loaded(Modules), Src) :-
1047 process_use_module(Modules, Src, false).
1048process_directive(load_files(Files, _Options), Src) :-
1049 process_use_module(Files, Src, false).
1050process_directive(include(Files), Src) :-
1051 process_include(Files, Src).
1052process_directive(dynamic(Dynamic), Src) :-
1053 process_predicates(assert_dynamic, Dynamic, Src).
1054process_directive(dynamic(Dynamic, _Options), Src) :-
1055 process_predicates(assert_dynamic, Dynamic, Src).
1056process_directive(thread_local(Dynamic), Src) :-
1057 process_predicates(assert_thread_local, Dynamic, Src).
1058process_directive(multifile(Dynamic), Src) :-
1059 process_predicates(assert_multifile, Dynamic, Src).
1060process_directive(public(Public), Src) :-
1061 process_predicates(assert_public, Public, Src).
1062process_directive(export(Export), Src) :-
1063 process_predicates(assert_export, Export, Src).
1064process_directive(import(Import), Src) :-
1065 process_import(Import, Src).
1066process_directive(module(Module, Export), Src) :-
1067 assert_module(Src, Module),
1068 assert_module_export(Src, Export).
1069process_directive(module(Module, Export, Import), Src) :-
1070 assert_module(Src, Module),
1071 assert_module_export(Src, Export),
1072 assert_module3(Import, Src).
1073process_directive(begin_tests(Unit, _Options), Src) :-
1074 enter_test_unit(Unit, Src).
1075process_directive(begin_tests(Unit), Src) :-
1076 enter_test_unit(Unit, Src).
1077process_directive(end_tests(Unit), Src) :-
1078 leave_test_unit(Unit, Src).
1079process_directive('$set_source_module'(system), Src) :-
1080 assert_module(Src, system). 1081process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :-
1082 assert_defined_class(Src, Name, Meta, Super, Doc).
1083process_directive(pce_autoload(Name, From), Src) :-
1084 assert_defined_class(Src, Name, imported_from(From)).
1085
1086process_directive(op(P, A, N), Src) :-
1087 xref_push_op(Src, P, A, N).
1088process_directive(set_prolog_flag(Flag, Value), Src) :-
1089 ( Flag == character_escapes
1090 -> set_prolog_flag(character_escapes, Value)
1091 ; true
1092 ),
1093 current_source_line(Line),
1094 xref_set_prolog_flag(Flag, Value, Src, Line).
1095process_directive(style_check(X), _) :-
1096 style_check(X).
1097process_directive(encoding(Enc), _) :-
1098 ( xref_input_stream(Stream)
1099 -> catch(set_stream(Stream, encoding(Enc)), _, true)
1100 ; true 1101 ).
1102process_directive(pce_expansion:push_compile_operators, _) :-
1103 '$current_source_module'(SM),
1104 call(pce_expansion:push_compile_operators(SM)). 1105process_directive(pce_expansion:pop_compile_operators, _) :-
1106 call(pce_expansion:pop_compile_operators).
1107process_directive(meta_predicate(Meta), Src) :-
1108 process_meta_predicate(Meta, Src).
1109process_directive(arithmetic_function(FSpec), Src) :-
1110 arith_callable(FSpec, Goal),
1111 !,
1112 current_source_line(Line),
1113 assert_called(Src, '<directive>'(Line), Goal, Line).
1114process_directive(format_predicate(_, Goal), Src) :-
1115 !,
1116 current_source_line(Line),
1117 assert_called(Src, '<directive>'(Line), Goal, Line).
1118process_directive(if(Cond), Src) :-
1119 !,
1120 current_source_line(Line),
1121 assert_called(Src, '<directive>'(Line), Cond, Line).
1122process_directive(elif(Cond), Src) :-
1123 !,
1124 current_source_line(Line),
1125 assert_called(Src, '<directive>'(Line), Cond, Line).
1126process_directive(else, _) :- !.
1127process_directive(endif, _) :- !.
1128process_directive(Goal, Src) :-
1129 current_source_line(Line),
1130 process_body(Goal, '<directive>'(Line), Src).
1131
1135
1136process_meta_predicate((A,B), Src) :-
1137 !,
1138 process_meta_predicate(A, Src),
1139 process_meta_predicate(B, Src).
1140process_meta_predicate(Decl, Src) :-
1141 process_meta_head(Src, Decl).
1142
1143process_meta_head(Src, Decl) :- 1144 compound(Decl),
1145 compound_name_arity(Decl, Name, Arity),
1146 compound_name_arity(Head, Name, Arity),
1147 meta_args(1, Arity, Decl, Head, Meta),
1148 ( ( prolog:meta_goal(Head, _)
1149 ; prolog:called_by(Head, _, _, _)
1150 ; prolog:called_by(Head, _)
1151 ; meta_goal(Head, _)
1152 )
1153 -> true
1154 ; assert(meta_goal(Head, Meta, Src))
1155 ).
1156
1157meta_args(I, Arity, _, _, []) :-
1158 I > Arity,
1159 !.
1160meta_args(I, Arity, Decl, Head, [H|T]) :- 1161 arg(I, Decl, 0),
1162 !,
1163 arg(I, Head, H),
1164 I2 is I + 1,
1165 meta_args(I2, Arity, Decl, Head, T).
1166meta_args(I, Arity, Decl, Head, [H|T]) :- 1167 arg(I, Decl, ^),
1168 !,
1169 arg(I, Head, EH),
1170 setof_goal(EH, H),
1171 I2 is I + 1,
1172 meta_args(I2, Arity, Decl, Head, T).
1173meta_args(I, Arity, Decl, Head, [//(H)|T]) :-
1174 arg(I, Decl, //),
1175 !,
1176 arg(I, Head, H),
1177 I2 is I + 1,
1178 meta_args(I2, Arity, Decl, Head, T).
1179meta_args(I, Arity, Decl, Head, [H+A|T]) :- 1180 arg(I, Decl, A),
1181 integer(A), A > 0,
1182 !,
1183 arg(I, Head, H),
1184 I2 is I + 1,
1185 meta_args(I2, Arity, Decl, Head, T).
1186meta_args(I, Arity, Decl, Head, Meta) :-
1187 I2 is I + 1,
1188 meta_args(I2, Arity, Decl, Head, Meta).
1189
1190
1191 1194
1201
1202xref_meta(Source, Head, Called) :-
1203 canonical_source(Source, Src),
1204 xref_meta_src(Head, Called, Src).
1205
1218
1219xref_meta_src(Head, Called, Src) :-
1220 meta_goal(Head, Called, Src),
1221 !.
1222xref_meta_src(Head, Called, _) :-
1223 xref_meta(Head, Called),
1224 !.
1225xref_meta_src(Head, Called, _) :-
1226 compound(Head),
1227 compound_name_arity(Head, Name, Arity),
1228 apply_pred(Name),
1229 Arity > 5,
1230 !,
1231 Extra is Arity - 1,
1232 arg(1, Head, G),
1233 Called = [G+Extra].
1234xref_meta_src(Head, Called, _) :-
1235 predicate_property('$xref_tmp':Head, meta_predicate(Meta)),
1236 !,
1237 Meta =.. [_|Args],
1238 meta_args(Args, 1, Head, Called).
1239
1240meta_args([], _, _, []).
1241meta_args([H0|T0], I, Head, [H|T]) :-
1242 xargs(H0, N),
1243 !,
1244 arg(I, Head, A),
1245 ( N == 0
1246 -> H = A
1247 ; H = (A+N)
1248 ),
1249 I2 is I+1,
1250 meta_args(T0, I2, Head, T).
1251meta_args([_|T0], I, Head, T) :-
1252 I2 is I+1,
1253 meta_args(T0, I2, Head, T).
1254
1255xargs(N, N) :- integer(N), !.
1256xargs(//, 2).
1257xargs(^, 0).
1258
1259apply_pred(call). 1260apply_pred(maplist). 1261
1262xref_meta((A, B), [A, B]).
1263xref_meta((A; B), [A, B]).
1264xref_meta((A| B), [A, B]).
1265xref_meta((A -> B), [A, B]).
1266xref_meta((A *-> B), [A, B]).
1267xref_meta(findall(_V,G,_L), [G]).
1268xref_meta(findall(_V,G,_L,_T), [G]).
1269xref_meta(findnsols(_N,_V,G,_L), [G]).
1270xref_meta(findnsols(_N,_V,G,_L,_T), [G]).
1271xref_meta(setof(_V, EG, _L), [G]) :-
1272 setof_goal(EG, G).
1273xref_meta(bagof(_V, EG, _L), [G]) :-
1274 setof_goal(EG, G).
1275xref_meta(forall(A, B), [A, B]).
1276xref_meta(maplist(G,_), [G+1]).
1277xref_meta(maplist(G,_,_), [G+2]).
1278xref_meta(maplist(G,_,_,_), [G+3]).
1279xref_meta(maplist(G,_,_,_,_), [G+4]).
1280xref_meta(map_list_to_pairs(G,_,_), [G+2]).
1281xref_meta(map_assoc(G, _), [G+1]).
1282xref_meta(map_assoc(G, _, _), [G+2]).
1283xref_meta(checklist(G, _L), [G+1]).
1284xref_meta(sublist(G, _, _), [G+1]).
1285xref_meta(include(G, _, _), [G+1]).
1286xref_meta(exclude(G, _, _), [G+1]).
1287xref_meta(partition(G, _, _, _, _), [G+2]).
1288xref_meta(partition(G, _, _, _),[G+1]).
1289xref_meta(call(G), [G]).
1290xref_meta(call(G, _), [G+1]).
1291xref_meta(call(G, _, _), [G+2]).
1292xref_meta(call(G, _, _, _), [G+3]).
1293xref_meta(call(G, _, _, _, _), [G+4]).
1294xref_meta(not(G), [G]).
1295xref_meta(notrace(G), [G]).
1296xref_meta('$notrace'(G), [G]).
1297xref_meta(\+(G), [G]).
1298xref_meta(ignore(G), [G]).
1299xref_meta(once(G), [G]).
1300xref_meta(initialization(G), [G]).
1301xref_meta(initialization(G,_), [G]).
1302xref_meta(retract(Rule), [G]) :- head_of(Rule, G).
1303xref_meta(clause(G, _), [G]).
1304xref_meta(clause(G, _, _), [G]).
1305xref_meta(phrase(G, _A), [//(G)]).
1306xref_meta(phrase(G, _A, _R), [//(G)]).
1307xref_meta(call_dcg(G, _A, _R), [//(G)]).
1308xref_meta(phrase_from_file(G,_),[//(G)]).
1309xref_meta(catch(A, _, B), [A, B]).
1310xref_meta(catch_with_backtrace(A, _, B), [A, B]).
1311xref_meta(thread_create(A,_,_), [A]).
1312xref_meta(thread_create(A,_), [A]).
1313xref_meta(thread_signal(_,A), [A]).
1314xref_meta(thread_idle(A,_), [A]).
1315xref_meta(thread_at_exit(A), [A]).
1316xref_meta(thread_initialization(A), [A]).
1317xref_meta(engine_create(_,A,_), [A]).
1318xref_meta(engine_create(_,A,_,_), [A]).
1319xref_meta(transaction(A), [A]).
1320xref_meta(transaction(A,B,_), [A,B]).
1321xref_meta(snapshot(A), [A]).
1322xref_meta(predsort(A,_,_), [A+3]).
1323xref_meta(call_cleanup(A, B), [A, B]).
1324xref_meta(call_cleanup(A, _, B),[A, B]).
1325xref_meta(setup_call_cleanup(A, B, C),[A, B, C]).
1326xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]).
1327xref_meta(call_residue_vars(A,_), [A]).
1328xref_meta(with_mutex(_,A), [A]).
1329xref_meta(assume(G), [G]). 1330xref_meta(assertion(G), [G]). 1331xref_meta(freeze(_, G), [G]).
1332xref_meta(when(C, A), [C, A]).
1333xref_meta(time(G), [G]). 1334xref_meta(call_time(G, _), [G]). 1335xref_meta(call_time(G, _, _), [G]). 1336xref_meta(profile(G), [G]).
1337xref_meta(at_halt(G), [G]).
1338xref_meta(call_with_time_limit(_, G), [G]).
1339xref_meta(call_with_depth_limit(G, _, _), [G]).
1340xref_meta(call_with_inference_limit(G, _, _), [G]).
1341xref_meta(alarm(_, G, _), [G]).
1342xref_meta(alarm(_, G, _, _), [G]).
1343xref_meta('$add_directive_wic'(G), [G]).
1344xref_meta(with_output_to(_, G), [G]).
1345xref_meta(if(G), [G]).
1346xref_meta(elif(G), [G]).
1347xref_meta(meta_options(G,_,_), [G+1]).
1348xref_meta(on_signal(_,_,H), [H+1]) :- H \== default.
1349xref_meta(distinct(G), [G]). 1350xref_meta(distinct(_, G), [G]).
1351xref_meta(order_by(_, G), [G]).
1352xref_meta(limit(_, G), [G]).
1353xref_meta(offset(_, G), [G]).
1354xref_meta(reset(G,_,_), [G]).
1355xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N).
1356xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N).
1357xref_meta(tnot(G), [G]).
1358xref_meta(not_exists(G), [G]).
1359xref_meta(with_tty_raw(G), [G]).
1360xref_meta(residual_goals(G), [G+2]).
1361
1362 1363xref_meta(pce_global(_, new(_)), _) :- !, fail.
1364xref_meta(pce_global(_, B), [B+1]).
1365xref_meta(ifmaintainer(G), [G]). 1366xref_meta(listen(_, G), [G]). 1367xref_meta(listen(_, _, G), [G]).
1368xref_meta(in_pce_thread(G), [G]).
1369
1370xref_meta(G, Meta) :- 1371 prolog:meta_goal(G, Meta).
1372xref_meta(G, Meta) :- 1373 meta_goal(G, Meta).
1374
1375setof_goal(EG, G) :-
1376 var(EG), !, G = EG.
1377setof_goal(_^EG, G) :-
1378 !,
1379 setof_goal(EG, G).
1380setof_goal(G, G).
1381
1382event_xargs(abort, 0).
1383event_xargs(erase, 1).
1384event_xargs(break, 3).
1385event_xargs(frame_finished, 1).
1386event_xargs(thread_exit, 1).
1387event_xargs(this_thread_exit, 0).
1388event_xargs(PI, 2) :- pi_to_head(PI, _).
1389
1393
1394head_of(Var, _) :-
1395 var(Var), !, fail.
1396head_of((Head :- _), Head).
1397head_of(Head, Head).
1398
1404
1405xref_hook(Hook) :-
1406 prolog:hook(Hook).
1407xref_hook(Hook) :-
1408 hook(Hook).
1409
1410
1411hook(attr_portray_hook(_,_)).
1412hook(attr_unify_hook(_,_)).
1413hook(attribute_goals(_,_,_)).
1414hook(goal_expansion(_,_)).
1415hook(term_expansion(_,_)).
1416hook(resource(_,_,_)).
1417hook('$pred_option'(_,_,_,_)).
1418
1419hook(emacs_prolog_colours:goal_classification(_,_)).
1420hook(emacs_prolog_colours:term_colours(_,_)).
1421hook(emacs_prolog_colours:goal_colours(_,_)).
1422hook(emacs_prolog_colours:style(_,_)).
1423hook(emacs_prolog_colours:identify(_,_)).
1424hook(pce_principal:pce_class(_,_,_,_,_,_)).
1425hook(pce_principal:send_implementation(_,_,_)).
1426hook(pce_principal:get_implementation(_,_,_,_)).
1427hook(pce_principal:pce_lazy_get_method(_,_,_)).
1428hook(pce_principal:pce_lazy_send_method(_,_,_)).
1429hook(pce_principal:pce_uses_template(_,_)).
1430hook(prolog:locate_clauses(_,_)).
1431hook(prolog:message(_,_,_)).
1432hook(prolog:error_message(_,_,_)).
1433hook(prolog:message_location(_,_,_)).
1434hook(prolog:message_context(_,_,_)).
1435hook(prolog:message_line_element(_,_)).
1436hook(prolog:debug_control_hook(_)).
1437hook(prolog:help_hook(_)).
1438hook(prolog:show_profile_hook(_,_)).
1439hook(prolog:general_exception(_,_)).
1440hook(prolog:predicate_summary(_,_)).
1441hook(prolog:residual_goals(_,_)).
1442hook(prolog_edit:load).
1443hook(prolog_edit:locate(_,_,_)).
1444hook(shlib:unload_all_foreign_libraries).
1445hook(system:'$foreign_registered'(_, _)).
1446hook(predicate_options:option_decl(_,_,_)).
1447hook(user:exception(_,_,_)).
1448hook(user:file_search_path(_,_)).
1449hook(user:library_directory(_)).
1450hook(user:message_hook(_,_,_)).
1451hook(user:portray(_)).
1452hook(user:prolog_clause_name(_,_)).
1453hook(user:prolog_list_goal(_)).
1454hook(user:prolog_predicate_name(_,_)).
1455hook(user:prolog_trace_interception(_,_,_,_)).
1456hook(prolog:prolog_exception_hook(_,_,_,_,_)).
1457hook(sandbox:safe_primitive(_)).
1458hook(sandbox:safe_meta_predicate(_)).
1459hook(sandbox:safe_meta(_,_)).
1460hook(sandbox:safe_global_variable(_)).
1461hook(sandbox:safe_directive(_)).
1462
1463
1467
1468arith_callable(Var, _) :-
1469 var(Var), !, fail.
1470arith_callable(Module:Spec, Module:Goal) :-
1471 !,
1472 arith_callable(Spec, Goal).
1473arith_callable(Name/Arity, Goal) :-
1474 PredArity is Arity + 1,
1475 functor(Goal, Name, PredArity).
1476
1485
1486process_body(Body, Origin, Src) :-
1487 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1488 true).
1489
1494
1495process_goal(Var, _, _, _) :-
1496 var(Var),
1497 !.
1498process_goal(_:Goal, _, _, _) :-
1499 var(Goal),
1500 !.
1501process_goal(Goal, Origin, Src, P) :-
1502 Goal = (_,_), 1503 !,
1504 phrase(conjunction(Goal), Goals),
1505 process_conjunction(Goals, Origin, Src, P).
1506process_goal(Goal, Origin, Src, _) :- 1507 Goal = (_;_), 1508 !,
1509 phrase(disjunction(Goal), Goals),
1510 forall(member(G, Goals),
1511 process_body(G, Origin, Src)).
1512process_goal(Goal, Origin, Src, P) :-
1513 ( ( xmodule(M, Src)
1514 -> true
1515 ; M = user
1516 ),
1517 pi_head(PI, M:Goal),
1518 ( current_predicate(PI),
1519 predicate_property(M:Goal, imported_from(IM))
1520 -> true
1521 ; PI = M:Name/Arity,
1522 '$find_library'(M, Name, Arity, IM, _Library)
1523 -> true
1524 ; IM = M
1525 ),
1526 prolog:called_by(Goal, IM, M, Called)
1527 ; prolog:called_by(Goal, Called)
1528 ),
1529 !,
1530 must_be(list, Called),
1531 current_source_line(Here),
1532 assert_called(Src, Origin, Goal, Here),
1533 process_called_list(Called, Origin, Src, P).
1534process_goal(Goal, Origin, Src, _) :-
1535 process_xpce_goal(Goal, Origin, Src),
1536 !.
1537process_goal(load_foreign_library(File), _Origin, Src, _) :-
1538 process_foreign(File, Src).
1539process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :-
1540 process_foreign(File, Src).
1541process_goal(use_foreign_library(File), _Origin, Src, _) :-
1542 process_foreign(File, Src).
1543process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :-
1544 process_foreign(File, Src).
1545process_goal(Goal, Origin, Src, P) :-
1546 xref_meta_src(Goal, Metas, Src),
1547 !,
1548 current_source_line(Here),
1549 assert_called(Src, Origin, Goal, Here),
1550 process_called_list(Metas, Origin, Src, P).
1551process_goal(Goal, Origin, Src, _) :-
1552 asserting_goal(Goal, Rule),
1553 !,
1554 current_source_line(Here),
1555 assert_called(Src, Origin, Goal, Here),
1556 process_assert(Rule, Origin, Src).
1557process_goal(Goal, Origin, Src, P) :-
1558 partial_evaluate(Goal, P),
1559 current_source_line(Here),
1560 assert_called(Src, Origin, Goal, Here).
1561
1562disjunction(Var) --> {var(Var), !}, [Var].
1563disjunction((A;B)) --> !, disjunction(A), disjunction(B).
1564disjunction(G) --> [G].
1565
1566conjunction(Var) --> {var(Var), !}, [Var].
1567conjunction((A,B)) --> !, conjunction(A), conjunction(B).
1568conjunction(G) --> [G].
1569
1570shares_vars(RVars, T) :-
1571 term_variables(T, TVars0),
1572 sort(TVars0, TVars),
1573 ord_intersect(RVars, TVars).
1574
1575process_conjunction([], _, _, _).
1576process_conjunction([Disj|Rest], Origin, Src, P) :-
1577 nonvar(Disj),
1578 Disj = (_;_),
1579 Rest \== [],
1580 !,
1581 phrase(disjunction(Disj), Goals),
1582 term_variables(Rest, RVars0),
1583 sort(RVars0, RVars),
1584 partition(shares_vars(RVars), Goals, Sharing, NonSHaring),
1585 forall(member(G, NonSHaring),
1586 process_body(G, Origin, Src)),
1587 ( Sharing == []
1588 -> true
1589 ; maplist(term_variables, Sharing, GVars0),
1590 append(GVars0, GVars1),
1591 sort(GVars1, GVars),
1592 ord_intersection(GVars, RVars, SVars),
1593 VT =.. [v|SVars],
1594 findall(VT,
1595 ( member(G, Sharing),
1596 process_goal(G, Origin, Src, PS),
1597 PS == true
1598 ),
1599 Alts0),
1600 ( Alts0 == []
1601 -> true
1602 ; ( true
1603 ; P = true,
1604 sort(Alts0, Alts1),
1605 variants(Alts1, 10, Alts),
1606 member(VT, Alts)
1607 )
1608 )
1609 ),
1610 process_conjunction(Rest, Origin, Src, P).
1611process_conjunction([H|T], Origin, Src, P) :-
1612 process_goal(H, Origin, Src, P),
1613 process_conjunction(T, Origin, Src, P).
1614
1615
1616process_called_list([], _, _, _).
1617process_called_list([H|T], Origin, Src, P) :-
1618 process_meta(H, Origin, Src, P),
1619 process_called_list(T, Origin, Src, P).
1620
1621process_meta(A+N, Origin, Src, P) :-
1622 !,
1623 ( extend(A, N, AX)
1624 -> process_goal(AX, Origin, Src, P)
1625 ; true
1626 ).
1627process_meta(//(A), Origin, Src, P) :-
1628 !,
1629 process_dcg_goal(A, Origin, Src, P).
1630process_meta(G, Origin, Src, P) :-
1631 process_goal(G, Origin, Src, P).
1632
1637
1638process_dcg_goal(Var, _, _, _) :-
1639 var(Var),
1640 !.
1641process_dcg_goal((A,B), Origin, Src, P) :-
1642 !,
1643 process_dcg_goal(A, Origin, Src, P),
1644 process_dcg_goal(B, Origin, Src, P).
1645process_dcg_goal((A;B), Origin, Src, P) :-
1646 !,
1647 process_dcg_goal(A, Origin, Src, P),
1648 process_dcg_goal(B, Origin, Src, P).
1649process_dcg_goal((A|B), Origin, Src, P) :-
1650 !,
1651 process_dcg_goal(A, Origin, Src, P),
1652 process_dcg_goal(B, Origin, Src, P).
1653process_dcg_goal((A->B), Origin, Src, P) :-
1654 !,
1655 process_dcg_goal(A, Origin, Src, P),
1656 process_dcg_goal(B, Origin, Src, P).
1657process_dcg_goal((A*->B), Origin, Src, P) :-
1658 !,
1659 process_dcg_goal(A, Origin, Src, P),
1660 process_dcg_goal(B, Origin, Src, P).
1661process_dcg_goal({Goal}, Origin, Src, P) :-
1662 !,
1663 process_goal(Goal, Origin, Src, P).
1664process_dcg_goal(List, _Origin, _Src, _) :-
1665 is_list(List),
1666 !. 1667process_dcg_goal(List, _Origin, _Src, _) :-
1668 string(List),
1669 !. 1670process_dcg_goal(Callable, Origin, Src, P) :-
1671 extend(Callable, 2, Goal),
1672 !,
1673 process_goal(Goal, Origin, Src, P).
1674process_dcg_goal(_, _, _, _).
1675
1676
1677extend(Var, _, _) :-
1678 var(Var), !, fail.
1679extend(M:G, N, M:GX) :-
1680 !,
1681 callable(G),
1682 extend(G, N, GX).
1683extend(G, N, GX) :-
1684 ( compound(G)
1685 -> compound_name_arguments(G, Name, Args),
1686 length(Rest, N),
1687 append(Args, Rest, NArgs),
1688 compound_name_arguments(GX, Name, NArgs)
1689 ; atom(G)
1690 -> length(NArgs, N),
1691 compound_name_arguments(GX, G, NArgs)
1692 ).
1693
1694asserting_goal(assert(Rule), Rule).
1695asserting_goal(asserta(Rule), Rule).
1696asserting_goal(assertz(Rule), Rule).
1697asserting_goal(assert(Rule,_), Rule).
1698asserting_goal(asserta(Rule,_), Rule).
1699asserting_goal(assertz(Rule,_), Rule).
1700
1701process_assert(0, _, _) :- !. 1702process_assert((_:-Body), Origin, Src) :-
1703 !,
1704 process_body(Body, Origin, Src).
1705process_assert(_, _, _).
1706
1708
1709variants([], _, []).
1710variants([H|T], Max, List) :-
1711 variants(T, H, Max, List).
1712
1713variants([], H, _, [H]).
1714variants(_, _, 0, []) :- !.
1715variants([H|T], V, Max, List) :-
1716 ( H =@= V
1717 -> variants(T, V, Max, List)
1718 ; List = [V|List2],
1719 Max1 is Max-1,
1720 variants(T, H, Max1, List2)
1721 ).
1722
1734
1735partial_evaluate(Goal, P) :-
1736 eval(Goal),
1737 !,
1738 P = true.
1739partial_evaluate(_, _).
1740
1741eval(X = Y) :-
1742 unify_with_occurs_check(X, Y).
1743
1744 1747
1748enter_test_unit(Unit, _Src) :-
1749 current_source_line(Line),
1750 asserta(current_test_unit(Unit, Line)).
1751
1752leave_test_unit(Unit, _Src) :-
1753 retractall(current_test_unit(Unit, _)).
1754
1755
1756 1759
1760pce_goal(new(_,_), new(-, new)).
1761pce_goal(send(_,_), send(arg, msg)).
1762pce_goal(send_class(_,_,_), send_class(arg, arg, msg)).
1763pce_goal(get(_,_,_), get(arg, msg, -)).
1764pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)).
1765pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)).
1766pce_goal(get_object(_,_,_), get_object(arg, msg, -)).
1767
1768process_xpce_goal(G, Origin, Src) :-
1769 pce_goal(G, Process),
1770 !,
1771 current_source_line(Here),
1772 assert_called(Src, Origin, G, Here),
1773 ( arg(I, Process, How),
1774 arg(I, G, Term),
1775 process_xpce_arg(How, Term, Origin, Src),
1776 fail
1777 ; true
1778 ).
1779
1780process_xpce_arg(new, Term, Origin, Src) :-
1781 callable(Term),
1782 process_new(Term, Origin, Src).
1783process_xpce_arg(arg, Term, Origin, Src) :-
1784 compound(Term),
1785 process_new(Term, Origin, Src).
1786process_xpce_arg(msg, Term, Origin, Src) :-
1787 compound(Term),
1788 ( arg(_, Term, Arg),
1789 process_xpce_arg(arg, Arg, Origin, Src),
1790 fail
1791 ; true
1792 ).
1793
1794process_new(_M:_Term, _, _) :- !. 1795process_new(Term, Origin, Src) :-
1796 assert_new(Src, Origin, Term),
1797 ( compound(Term),
1798 arg(_, Term, Arg),
1799 process_xpce_arg(arg, Arg, Origin, Src),
1800 fail
1801 ; true
1802 ).
1803
1804assert_new(_, _, Term) :-
1805 \+ callable(Term),
1806 !.
1807assert_new(Src, Origin, Control) :-
1808 functor_name(Control, Class),
1809 pce_control_class(Class),
1810 !,
1811 forall(arg(_, Control, Arg),
1812 assert_new(Src, Origin, Arg)).
1813assert_new(Src, Origin, Term) :-
1814 compound(Term),
1815 arg(1, Term, Prolog),
1816 Prolog == @(prolog),
1817 ( Term =.. [message, _, Selector | T],
1818 atom(Selector)
1819 -> Called =.. [Selector|T],
1820 process_body(Called, Origin, Src)
1821 ; Term =.. [?, _, Selector | T],
1822 atom(Selector)
1823 -> append(T, [_R], T2),
1824 Called =.. [Selector|T2],
1825 process_body(Called, Origin, Src)
1826 ),
1827 fail.
1828assert_new(_, _, @(_)) :- !.
1829assert_new(Src, _, Term) :-
1830 functor_name(Term, Name),
1831 assert_used_class(Src, Name).
1832
1833
1834pce_control_class(and).
1835pce_control_class(or).
1836pce_control_class(if).
1837pce_control_class(not).
1838
1839
1840 1843
1845
1846process_use_module(_Module:_Files, _, _) :- !. 1847process_use_module([], _, _) :- !.
1848process_use_module([H|T], Src, Reexport) :-
1849 !,
1850 process_use_module(H, Src, Reexport),
1851 process_use_module(T, Src, Reexport).
1852process_use_module(library(pce), Src, Reexport) :- 1853 !,
1854 xref_public_list(library(pce), Path, Exports, Src),
1855 forall(member(Import, Exports),
1856 process_pce_import(Import, Src, Path, Reexport)).
1857process_use_module(File, Src, Reexport) :-
1858 load_module_if_needed(File),
1859 ( xoption(Src, silent(Silent))
1860 -> Extra = [silent(Silent)]
1861 ; Extra = [silent(true)]
1862 ),
1863 ( xref_public_list(File, Src,
1864 [ path(Path),
1865 module(M),
1866 exports(Exports),
1867 public(Public),
1868 meta(Meta)
1869 | Extra
1870 ])
1871 -> assert(uses_file(File, Src, Path)),
1872 assert_import(Src, Exports, _, Path, Reexport),
1873 assert_xmodule_callable(Exports, M, Src, Path),
1874 assert_xmodule_callable(Public, M, Src, Path),
1875 maplist(process_meta_head(Src), Meta),
1876 ( File = library(chr) 1877 -> assert(mode(chr, Src))
1878 ; true
1879 )
1880 ; assert(uses_file(File, Src, '<not_found>'))
1881 ).
1882
1883process_pce_import(Name/Arity, Src, Path, Reexport) :-
1884 atom(Name),
1885 integer(Arity),
1886 !,
1887 functor(Term, Name, Arity),
1888 ( \+ system_predicate(Term),
1889 \+ Term = pce_error(_) 1890 -> assert_import(Src, [Name/Arity], _, Path, Reexport)
1891 ; true
1892 ).
1893process_pce_import(op(P,T,N), Src, _, _) :-
1894 xref_push_op(Src, P, T, N).
1895
1899
1900process_use_module2(File, Import, Src, Reexport) :-
1901 load_module_if_needed(File),
1902 ( xref_source_file(File, Path, Src)
1903 -> assert(uses_file(File, Src, Path)),
1904 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1905 -> assert_import(Src, Import, Export, Path, Reexport),
1906 forall(( member(Head, Meta),
1907 imported(Head, _, Path)
1908 ),
1909 process_meta_head(Src, Head))
1910 ; true
1911 )
1912 ; assert(uses_file(File, Src, '<not_found>'))
1913 ).
1914
1915
1921
1922load_module_if_needed(File) :-
1923 prolog:no_autoload_module(File),
1924 !,
1925 use_module(File, []).
1926load_module_if_needed(_).
1927
1928prolog:no_autoload_module(library(apply_macros)).
1929prolog:no_autoload_module(library(arithmetic)).
1930prolog:no_autoload_module(library(record)).
1931prolog:no_autoload_module(library(persistency)).
1932prolog:no_autoload_module(library(pldoc)).
1933prolog:no_autoload_module(library(settings)).
1934prolog:no_autoload_module(library(debug)).
1935prolog:no_autoload_module(library(plunit)).
1936
1937
1939
1940process_requires(Import, Src) :-
1941 is_list(Import),
1942 !,
1943 require_list(Import, Src).
1944process_requires(Var, _Src) :-
1945 var(Var),
1946 !.
1947process_requires((A,B), Src) :-
1948 !,
1949 process_requires(A, Src),
1950 process_requires(B, Src).
1951process_requires(PI, Src) :-
1952 requires(PI, Src).
1953
1954require_list([], _).
1955require_list([H|T], Src) :-
1956 requires(H, Src),
1957 require_list(T, Src).
1958
1959requires(PI, _Src) :-
1960 '$pi_head'(PI, Head),
1961 '$get_predicate_attribute'(system:Head, defined, 1),
1962 !.
1963requires(PI, Src) :-
1964 '$pi_head'(PI, Head),
1965 '$pi_head'(Name/Arity, Head),
1966 '$find_library'(_Module, Name, Arity, _LoadModule, Library),
1967 ( imported(Head, Src, Library)
1968 -> true
1969 ; assertz(imported(Head, Src, Library))
1970 ).
1971
1972
2000
2001xref_public_list(File, Src, Options) :-
2002 option(path(Path), Options, _),
2003 option(module(Module), Options, _),
2004 option(exports(Exports), Options, _),
2005 option(public(Public), Options, _),
2006 option(meta(Meta), Options, _),
2007 xref_source_file(File, Path, Src, Options),
2008 public_list(Path, Module, Meta, Exports, Public, Options).
2009
2029
2030xref_public_list(File, Path, Export, Src) :-
2031 xref_source_file(File, Path, Src),
2032 public_list(Path, _, _, Export, _, []).
2033xref_public_list(File, Path, Module, Export, Meta, Src) :-
2034 xref_source_file(File, Path, Src),
2035 public_list(Path, Module, Meta, Export, _, []).
2036xref_public_list(File, Path, Module, Export, Public, Meta, Src) :-
2037 xref_source_file(File, Path, Src),
2038 public_list(Path, Module, Meta, Export, Public, []).
2039
2047
2048:- dynamic public_list_cache/6. 2049:- volatile public_list_cache/6. 2050
2051public_list(Path, Module, Meta, Export, Public, _Options) :-
2052 public_list_cache(Path, Modified,
2053 Module0, Meta0, Export0, Public0),
2054 time_file(Path, ModifiedNow),
2055 ( abs(Modified-ModifiedNow) < 0.0001
2056 -> !,
2057 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0)
2058 ; retractall(public_list_cache(Path, _, _, _, _, _)),
2059 fail
2060 ).
2061public_list(Path, Module, Meta, Export, Public, Options) :-
2062 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options),
2063 ( Error = error(_,_),
2064 catch(time_file(Path, Modified), Error, fail)
2065 -> asserta(public_list_cache(Path, Modified,
2066 Module0, Meta0, Export0, Public0))
2067 ; true
2068 ),
2069 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0).
2070
2071public_list_nc(Path, Module, Meta, Export, Public, Options) :-
2072 in_temporary_module(
2073 TempModule,
2074 true,
2075 public_list_diff(TempModule, Path, Module,
2076 Meta, [], Export, [], Public, [], Options)).
2077
2078
2079public_list_diff(TempModule,
2080 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :-
2081 setup_call_cleanup(
2082 public_list_setup(TempModule, Path, In, State),
2083 phrase(read_directives(In, Options, [true]), Directives),
2084 public_list_cleanup(In, State)),
2085 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT).
2086
2087public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :-
2088 prolog_open_source(Path, In),
2089 '$set_source_module'(OldM, TempModule),
2090 set_xref(OldXref).
2091
2092public_list_cleanup(In, state(OldM, OldXref)) :-
2093 '$set_source_module'(OldM),
2094 set_prolog_flag(xref, OldXref),
2095 prolog_close_source(In).
2096
2097
2098read_directives(In, Options, State) -->
2099 { repeat,
2100 catch(prolog_read_source_term(In, Term, Expanded,
2101 [ process_comment(true),
2102 syntax_errors(error)
2103 ]),
2104 E, report_syntax_error(E, -, Options))
2105 -> nonvar(Term),
2106 Term = (:-_)
2107 },
2108 !,
2109 terms(Expanded, State, State1),
2110 read_directives(In, Options, State1).
2111read_directives(_, _, _) --> [].
2112
2113terms(Var, State, State) --> { var(Var) }, !.
2114terms([H|T], State0, State) -->
2115 !,
2116 terms(H, State0, State1),
2117 terms(T, State1, State).
2118terms((:-if(Cond)), State0, [True|State0]) -->
2119 !,
2120 { eval_cond(Cond, True) }.
2121terms((:-elif(Cond)), [True0|State], [True|State]) -->
2122 !,
2123 { eval_cond(Cond, True1),
2124 elif(True0, True1, True)
2125 }.
2126terms((:-else), [True0|State], [True|State]) -->
2127 !,
2128 { negate(True0, True) }.
2129terms((:-endif), [_|State], State) --> !.
2130terms(H, State, State) -->
2131 ( {State = [true|_]}
2132 -> [H]
2133 ; []
2134 ).
2135
2136eval_cond(Cond, true) :-
2137 catch(Cond, _, fail),
2138 !.
2139eval_cond(_, false).
2140
2141elif(true, _, else_false) :- !.
2142elif(false, true, true) :- !.
2143elif(True, _, True).
2144
2145negate(true, false).
2146negate(false, true).
2147negate(else_false, else_false).
2148
2149public_list([(:- module(Module, Export0))|Decls], Path,
2150 Module, Meta, MT, Export, Rest, Public, PT) :-
2151 !,
2152 ( is_list(Export0)
2153 -> append(Export0, Reexport, Export)
2154 ; Reexport = Export
2155 ),
2156 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT).
2157public_list([(:- encoding(_))|Decls], Path,
2158 Module, Meta, MT, Export, Rest, Public, PT) :-
2159 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT).
2160
2161public_list_([], _, Meta, Meta, Export, Export, Public, Public).
2162public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :-
2163 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0),
2164 !,
2165 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT).
2166public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :-
2167 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT).
2168
2169public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :-
2170 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT).
2171public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :-
2172 public_from_import(Import, Spec, Path, Reexport, Rest).
2173public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :-
2174 phrase(meta_decls(Decl), Meta, MT).
2175public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :-
2176 phrase(public_decls(Decl), Public, PT).
2177
2181
2182reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !.
2183reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :-
2184 !,
2185 xref_source_file(H, Path, Src),
2186 public_list(Path, _Module, Meta0, Export0, Public0, []),
2187 append(Meta0, MT1, Meta),
2188 append(Export0, ET1, Export),
2189 append(Public0, PT1, Public),
2190 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT).
2191reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :-
2192 xref_source_file(Spec, Path, Src),
2193 public_list(Path, _Module, Meta0, Export0, Public0, []),
2194 append(Meta0, MT, Meta),
2195 append(Export0, ET, Export),
2196 append(Public0, PT, Public).
2197
2198public_from_import(except(Map), Path, Src, Export, Rest) :-
2199 !,
2200 xref_public_list(Path, _, AllExports, Src),
2201 except(Map, AllExports, NewExports),
2202 append(NewExports, Rest, Export).
2203public_from_import(Import, _, _, Export, Rest) :-
2204 import_name_map(Import, Export, Rest).
2205
2206
2208
2209except([], Exports, Exports).
2210except([PI0 as NewName|Map], Exports0, Exports) :-
2211 !,
2212 canonical_pi(PI0, PI),
2213 map_as(Exports0, PI, NewName, Exports1),
2214 except(Map, Exports1, Exports).
2215except([PI0|Map], Exports0, Exports) :-
2216 canonical_pi(PI0, PI),
2217 select(PI2, Exports0, Exports1),
2218 same_pi(PI, PI2),
2219 !,
2220 except(Map, Exports1, Exports).
2221
2222
2223map_as([PI|T], Repl, As, [PI2|T]) :-
2224 same_pi(Repl, PI),
2225 !,
2226 pi_as(PI, As, PI2).
2227map_as([H|T0], Repl, As, [H|T]) :-
2228 map_as(T0, Repl, As, T).
2229
2230pi_as(_/Arity, Name, Name/Arity).
2231pi_as(_//Arity, Name, Name//Arity).
2232
2233import_name_map([], L, L).
2234import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :-
2235 !,
2236 import_name_map(T0, T, Tail).
2237import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :-
2238 !,
2239 import_name_map(T0, T, Tail).
2240import_name_map([H|T0], [H|T], Tail) :-
2241 import_name_map(T0, T, Tail).
2242
2243canonical_pi(Name//Arity0, PI) :-
2244 integer(Arity0),
2245 !,
2246 PI = Name/Arity,
2247 Arity is Arity0 + 2.
2248canonical_pi(PI, PI).
2249
2250same_pi(Canonical, PI2) :-
2251 canonical_pi(PI2, Canonical).
2252
2253meta_decls(Var) -->
2254 { var(Var) },
2255 !.
2256meta_decls((A,B)) -->
2257 !,
2258 meta_decls(A),
2259 meta_decls(B).
2260meta_decls(A) -->
2261 [A].
2262
2263public_decls(Var) -->
2264 { var(Var) },
2265 !.
2266public_decls((A,B)) -->
2267 !,
2268 public_decls(A),
2269 public_decls(B).
2270public_decls(A) -->
2271 [A].
2272
2273 2276
2277process_include([], _) :- !.
2278process_include([H|T], Src) :-
2279 !,
2280 process_include(H, Src),
2281 process_include(T, Src).
2282process_include(File, Src) :-
2283 callable(File),
2284 !,
2285 ( once(xref_input(ParentSrc, _)),
2286 xref_source_file(File, Path, ParentSrc)
2287 -> ( ( uses_file(_, Src, Path)
2288 ; Path == Src
2289 )
2290 -> true
2291 ; assert(uses_file(File, Src, Path)),
2292 ( xoption(Src, process_include(true))
2293 -> findall(O, xoption(Src, O), Options),
2294 setup_call_cleanup(
2295 open_include_file(Path, In, Refs),
2296 collect(Src, Path, In, Options),
2297 close_include(In, Refs))
2298 ; true
2299 )
2300 )
2301 ; assert(uses_file(File, Src, '<not_found>'))
2302 ).
2303process_include(_, _).
2304
2310
2311open_include_file(Path, In, [Ref]) :-
2312 once(xref_input(_, Parent)),
2313 stream_property(Parent, encoding(Enc)),
2314 '$push_input_context'(xref_include),
2315 catch(( prolog:xref_open_source(Path, In)
2316 -> catch(set_stream(In, encoding(Enc)),
2317 error(_,_), true) 2318 ; include_encoding(Enc, Options),
2319 open(Path, read, In, Options)
2320 ), E,
2321 ( '$pop_input_context', throw(E))),
2322 catch(( peek_char(In, #) 2323 -> skip(In, 10)
2324 ; true
2325 ), E,
2326 ( close_include(In, []), throw(E))),
2327 asserta(xref_input(Path, In), Ref).
2328
2329include_encoding(wchar_t, []) :- !.
2330include_encoding(Enc, [encoding(Enc)]).
2331
2332
2333close_include(In, Refs) :-
2334 maplist(erase, Refs),
2335 close(In, [force(true)]),
2336 '$pop_input_context'.
2337
2341
2342process_foreign(Spec, Src) :-
2343 ground(Spec),
2344 current_foreign_library(Spec, Defined),
2345 !,
2346 ( xmodule(Module, Src)
2347 -> true
2348 ; Module = user
2349 ),
2350 process_foreign_defined(Defined, Module, Src).
2351process_foreign(_, _).
2352
2353process_foreign_defined([], _, _).
2354process_foreign_defined([H|T], M, Src) :-
2355 ( H = M:Head
2356 -> assert_foreign(Src, Head)
2357 ; assert_foreign(Src, H)
2358 ),
2359 process_foreign_defined(T, M, Src).
2360
2361
2362 2365
2375
2376process_chr(@(_Name, Rule), Src) :-
2377 mode(chr, Src),
2378 process_chr(Rule, Src).
2379process_chr(pragma(Rule, _Pragma), Src) :-
2380 mode(chr, Src),
2381 process_chr(Rule, Src).
2382process_chr(<=>(Head, Body), Src) :-
2383 mode(chr, Src),
2384 chr_head(Head, Src, H),
2385 chr_body(Body, H, Src).
2386process_chr(==>(Head, Body), Src) :-
2387 mode(chr, Src),
2388 chr_head(Head, H, Src),
2389 chr_body(Body, H, Src).
2390process_chr((:- chr_constraint(_)), Src) :-
2391 ( mode(chr, Src)
2392 -> true
2393 ; assert(mode(chr, Src))
2394 ).
2395
2396chr_head(X, _, _) :-
2397 var(X),
2398 !. 2399chr_head(\(A,B), Src, H) :-
2400 chr_head(A, Src, H),
2401 process_body(B, H, Src).
2402chr_head((H0,B), Src, H) :-
2403 chr_defined(H0, Src, H),
2404 process_body(B, H, Src).
2405chr_head(H0, Src, H) :-
2406 chr_defined(H0, Src, H).
2407
2408chr_defined(X, _, _) :-
2409 var(X),
2410 !.
2411chr_defined(#(C,_Id), Src, C) :-
2412 !,
2413 assert_constraint(Src, C).
2414chr_defined(A, Src, A) :-
2415 assert_constraint(Src, A).
2416
2417chr_body(X, From, Src) :-
2418 var(X),
2419 !,
2420 process_body(X, From, Src).
2421chr_body('|'(Guard, Goals), H, Src) :-
2422 !,
2423 chr_body(Guard, H, Src),
2424 chr_body(Goals, H, Src).
2425chr_body(G, From, Src) :-
2426 process_body(G, From, Src).
2427
2428assert_constraint(_, Head) :-
2429 var(Head),
2430 !.
2431assert_constraint(Src, Head) :-
2432 constraint(Head, Src, _),
2433 !.
2434assert_constraint(Src, Head) :-
2435 generalise_term(Head, Term),
2436 current_source_line(Line),
2437 assert(constraint(Term, Src, Line)).
2438
2439
2440 2443
2448
2449assert_called(_, _, Var, _) :-
2450 var(Var),
2451 !.
2452assert_called(Src, From, Goal, Line) :-
2453 var(From),
2454 !,
2455 assert_called(Src, '<unknown>', Goal, Line).
2456assert_called(_, _, Goal, _) :-
2457 expand_hide_called(Goal),
2458 !.
2459assert_called(Src, Origin, M:G, Line) :-
2460 !,
2461 ( atom(M),
2462 callable(G)
2463 -> current_condition(Cond),
2464 ( xmodule(M, Src) 2465 -> assert_called(Src, Origin, G, Line)
2466 ; called(M:G, Src, Origin, Cond, Line) 2467 -> true
2468 ; hide_called(M:G, Src) 2469 -> true
2470 ; generalise(Origin, OTerm),
2471 generalise(G, GTerm)
2472 -> assert(called(M:GTerm, Src, OTerm, Cond, Line))
2473 ; true
2474 )
2475 ; true 2476 ).
2477assert_called(Src, _, Goal, _) :-
2478 ( xmodule(M, Src)
2479 -> M \== system
2480 ; M = user
2481 ),
2482 hide_called(M:Goal, Src),
2483 !.
2484assert_called(Src, Origin, Goal, Line) :-
2485 current_condition(Cond),
2486 ( called(Goal, Src, Origin, Cond, Line)
2487 -> true
2488 ; generalise(Origin, OTerm),
2489 generalise(Goal, Term)
2490 -> assert(called(Term, Src, OTerm, Cond, Line))
2491 ; true
2492 ).
2493
2494
2499
2500expand_hide_called(pce_principal:send_implementation(_, _, _)).
2501expand_hide_called(pce_principal:get_implementation(_, _, _, _)).
2502expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)).
2503expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)).
2504
2505assert_defined(Src, Goal) :-
2506 Goal = test(_Test),
2507 current_test_unit(Unit, Line),
2508 assert_called(Src, '<test_unit>'(Unit), Goal, Line),
2509 fail.
2510assert_defined(Src, Goal) :-
2511 Goal = test(_Test, _Options),
2512 current_test_unit(Unit, Line),
2513 assert_called(Src, '<test_unit>'(Unit), Goal, Line),
2514 fail.
2515assert_defined(Src, Goal) :-
2516 defined(Goal, Src, _),
2517 !.
2518assert_defined(Src, Goal) :-
2519 generalise(Goal, Term),
2520 current_source_line(Line),
2521 assert(defined(Term, Src, Line)).
2522
2523assert_foreign(Src, Goal) :-
2524 foreign(Goal, Src, _),
2525 !.
2526assert_foreign(Src, Goal) :-
2527 generalise(Goal, Term),
2528 current_source_line(Line),
2529 assert(foreign(Term, Src, Line)).
2530
2540
2541assert_import(_, [], _, _, _) :- !.
2542assert_import(Src, [H|T], Export, From, Reexport) :-
2543 !,
2544 assert_import(Src, H, Export, From, Reexport),
2545 assert_import(Src, T, Export, From, Reexport).
2546assert_import(Src, except(Except), Export, From, Reexport) :-
2547 !,
2548 is_list(Export),
2549 !,
2550 except(Except, Export, Import),
2551 assert_import(Src, Import, _All, From, Reexport).
2552assert_import(Src, Import as Name, Export, From, Reexport) :-
2553 !,
2554 pi_to_head(Import, Term0),
2555 rename_goal(Term0, Name, Term),
2556 ( in_export_list(Term0, Export)
2557 -> assert(imported(Term, Src, From)),
2558 assert_reexport(Reexport, Src, Term)
2559 ; current_source_line(Line),
2560 assert_called(Src, '<directive>'(Line), Term0, Line)
2561 ).
2562assert_import(Src, Import, Export, From, Reexport) :-
2563 pi_to_head(Import, Term),
2564 !,
2565 ( in_export_list(Term, Export)
2566 -> assert(imported(Term, Src, From)),
2567 assert_reexport(Reexport, Src, Term)
2568 ; current_source_line(Line),
2569 assert_called(Src, '<directive>'(Line), Term, Line)
2570 ).
2571assert_import(Src, op(P,T,N), _, _, _) :-
2572 xref_push_op(Src, P,T,N).
2573
2574in_export_list(_Head, Export) :-
2575 var(Export),
2576 !.
2577in_export_list(Head, Export) :-
2578 member(PI, Export),
2579 pi_to_head(PI, Head).
2580
2581assert_reexport(false, _, _) :- !.
2582assert_reexport(true, Src, Term) :-
2583 assert(exported(Term, Src)).
2584
2588
2589process_import(M:PI, Src) :-
2590 pi_to_head(PI, Head),
2591 !,
2592 ( atom(M),
2593 current_module(M),
2594 module_property(M, file(From))
2595 -> true
2596 ; From = '<unknown>'
2597 ),
2598 assert(imported(Head, Src, From)).
2599process_import(_, _).
2600
2607
2608assert_xmodule_callable([], _, _, _).
2609assert_xmodule_callable([PI|T], M, Src, From) :-
2610 ( pi_to_head(M:PI, Head)
2611 -> assert(imported(Head, Src, From))
2612 ; true
2613 ),
2614 assert_xmodule_callable(T, M, Src, From).
2615
2616
2620
2621assert_op(Src, op(P,T,M:N)) :-
2622 ( '$current_source_module'(M)
2623 -> Name = N
2624 ; Name = M:N
2625 ),
2626 ( xop(Src, op(P,T,Name))
2627 -> true
2628 ; assert(xop(Src, op(P,T,Name)))
2629 ).
2630
2635
2636assert_module(Src, Module) :-
2637 xmodule(Module, Src),
2638 !.
2639assert_module(Src, Module) :-
2640 '$set_source_module'(Module),
2641 assert(xmodule(Module, Src)),
2642 ( module_property(Module, class(system))
2643 -> retractall(xoption(Src, register_called(_))),
2644 assert(xoption(Src, register_called(all)))
2645 ; true
2646 ).
2647
2648assert_module_export(_, []) :- !.
2649assert_module_export(Src, [H|T]) :-
2650 !,
2651 assert_module_export(Src, H),
2652 assert_module_export(Src, T).
2653assert_module_export(Src, PI) :-
2654 pi_to_head(PI, Term),
2655 !,
2656 assert(exported(Term, Src)).
2657assert_module_export(Src, op(P, A, N)) :-
2658 xref_push_op(Src, P, A, N).
2659
2663
2664assert_module3([], _) :- !.
2665assert_module3([H|T], Src) :-
2666 !,
2667 assert_module3(H, Src),
2668 assert_module3(T, Src).
2669assert_module3(Option, Src) :-
2670 process_use_module(library(dialect/Option), Src, false).
2671
2672
2678
2679process_predicates(Closure, Preds, Src) :-
2680 is_list(Preds),
2681 !,
2682 process_predicate_list(Preds, Closure, Src).
2683process_predicates(Closure, as(Preds, _Options), Src) :-
2684 !,
2685 process_predicates(Closure, Preds, Src).
2686process_predicates(Closure, Preds, Src) :-
2687 process_predicate_comma(Preds, Closure, Src).
2688
2689process_predicate_list([], _, _).
2690process_predicate_list([H|T], Closure, Src) :-
2691 ( nonvar(H)
2692 -> call(Closure, H, Src)
2693 ; true
2694 ),
2695 process_predicate_list(T, Closure, Src).
2696
2697process_predicate_comma(Var, _, _) :-
2698 var(Var),
2699 !.
2700process_predicate_comma(M:(A,B), Closure, Src) :-
2701 !,
2702 process_predicate_comma(M:A, Closure, Src),
2703 process_predicate_comma(M:B, Closure, Src).
2704process_predicate_comma((A,B), Closure, Src) :-
2705 !,
2706 process_predicate_comma(A, Closure, Src),
2707 process_predicate_comma(B, Closure, Src).
2708process_predicate_comma(as(Spec, _Options), Closure, Src) :-
2709 !,
2710 process_predicate_comma(Spec, Closure, Src).
2711process_predicate_comma(A, Closure, Src) :-
2712 call(Closure, A, Src).
2713
2714
2715assert_dynamic(PI, Src) :-
2716 pi_to_head(PI, Term),
2717 ( thread_local(Term, Src, _) 2718 -> true 2719 ; current_source_line(Line),
2720 assert(dynamic(Term, Src, Line))
2721 ).
2722
2723assert_thread_local(PI, Src) :-
2724 pi_to_head(PI, Term),
2725 current_source_line(Line),
2726 assert(thread_local(Term, Src, Line)).
2727
2728assert_multifile(PI, Src) :- 2729 pi_to_head(PI, Term),
2730 current_source_line(Line),
2731 assert(multifile(Term, Src, Line)).
2732
2733assert_public(PI, Src) :- 2734 pi_to_head(PI, Term),
2735 current_source_line(Line),
2736 assert_called(Src, '<public>'(Line), Term, Line),
2737 assert(public(Term, Src, Line)).
2738
2739assert_export(PI, Src) :- 2740 pi_to_head(PI, Term),
2741 !,
2742 assert(exported(Term, Src)).
2743
2748
2749pi_to_head(Var, _) :-
2750 var(Var), !, fail.
2751pi_to_head(M:PI, M:Term) :-
2752 !,
2753 pi_to_head(PI, Term).
2754pi_to_head(Name/Arity, Term) :-
2755 functor(Term, Name, Arity).
2756pi_to_head(Name//DCGArity, Term) :-
2757 Arity is DCGArity+2,
2758 functor(Term, Name, Arity).
2759
2760
2761assert_used_class(Src, Name) :-
2762 used_class(Name, Src),
2763 !.
2764assert_used_class(Src, Name) :-
2765 assert(used_class(Name, Src)).
2766
2767assert_defined_class(Src, Name, _Meta, _Super, _) :-
2768 defined_class(Name, _, _, Src, _),
2769 !.
2770assert_defined_class(_, _, _, -, _) :- !. 2771assert_defined_class(Src, Name, Meta, Super, Summary) :-
2772 current_source_line(Line),
2773 ( Summary == @(default)
2774 -> Atom = ''
2775 ; is_list(Summary)
2776 -> atom_codes(Atom, Summary)
2777 ; string(Summary)
2778 -> atom_concat(Summary, '', Atom)
2779 ),
2780 assert(defined_class(Name, Super, Atom, Src, Line)),
2781 ( Meta = @(_)
2782 -> true
2783 ; assert_used_class(Src, Meta)
2784 ),
2785 assert_used_class(Src, Super).
2786
2787assert_defined_class(Src, Name, imported_from(_File)) :-
2788 defined_class(Name, _, _, Src, _),
2789 !.
2790assert_defined_class(Src, Name, imported_from(File)) :-
2791 assert(defined_class(Name, _, '', Src, file(File))).
2792
2793
2794 2797
2801
2802generalise(Var, Var) :-
2803 var(Var),
2804 !. 2805generalise(pce_principal:send_implementation(Id, _, _),
2806 pce_principal:send_implementation(Id, _, _)) :-
2807 atom(Id),
2808 !.
2809generalise(pce_principal:get_implementation(Id, _, _, _),
2810 pce_principal:get_implementation(Id, _, _, _)) :-
2811 atom(Id),
2812 !.
2813generalise('<directive>'(Line), '<directive>'(Line)) :- !.
2814generalise(test(Test), test(Test)) :-
2815 current_test_unit(_,_),
2816 ground(Test),
2817 !.
2818generalise(test(Test, _), test(Test, _)) :-
2819 current_test_unit(_,_),
2820 ground(Test),
2821 !.
2822generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !.
2823generalise(Module:Goal0, Module:Goal) :-
2824 atom(Module),
2825 !,
2826 generalise(Goal0, Goal).
2827generalise(Term0, Term) :-
2828 callable(Term0),
2829 generalise_term(Term0, Term).
2830
2831
2832 2835
2843
2844:- multifile
2845 prolog:xref_source_directory/2, 2846 prolog:xref_source_file/3. 2847
2848
2853
2854xref_source_file(Plain, File, Source) :-
2855 xref_source_file(Plain, File, Source, []).
2856
2857xref_source_file(QSpec, File, Source, Options) :-
2858 nonvar(QSpec), QSpec = _:Spec,
2859 !,
2860 must_be(acyclic, Spec),
2861 xref_source_file(Spec, File, Source, Options).
2862xref_source_file(Spec, File, Source, Options) :-
2863 nonvar(Spec),
2864 prolog:xref_source_file(Spec, File,
2865 [ relative_to(Source)
2866 | Options
2867 ]),
2868 !.
2869xref_source_file(Plain, File, Source, Options) :-
2870 atom(Plain),
2871 \+ is_absolute_file_name(Plain),
2872 ( prolog:xref_source_directory(Source, Dir)
2873 -> true
2874 ; atom(Source),
2875 file_directory_name(Source, Dir)
2876 ),
2877 atomic_list_concat([Dir, /, Plain], Spec0),
2878 absolute_file_name(Spec0, Spec),
2879 do_xref_source_file(Spec, File, Options),
2880 !.
2881xref_source_file(Spec, File, Source, Options) :-
2882 do_xref_source_file(Spec, File,
2883 [ relative_to(Source)
2884 | Options
2885 ]),
2886 !.
2887xref_source_file(_, _, _, Options) :-
2888 option(silent(true), Options),
2889 !,
2890 fail.
2891xref_source_file(Spec, _, Src, _Options) :-
2892 verbose(Src),
2893 print_message(warning, error(existence_error(file, Spec), _)),
2894 fail.
2895
2896do_xref_source_file(Spec, File, Options) :-
2897 nonvar(Spec),
2898 option(file_type(Type), Options, prolog),
2899 absolute_file_name(Spec, File,
2900 [ file_type(Type),
2901 access(read),
2902 file_errors(fail)
2903 ]),
2904 !.
2905
2909
2910canonical_source(Source, Src) :-
2911 ( ground(Source)
2912 -> prolog_canonical_source(Source, Src)
2913 ; Source = Src
2914 ).
2915
2920
2921goal_name_arity(Goal, Name, Arity) :-
2922 ( compound(Goal)
2923 -> compound_name_arity(Goal, Name, Arity)
2924 ; atom(Goal)
2925 -> Name = Goal, Arity = 0
2926 ).
2927
2928generalise_term(Specific, General) :-
2929 ( compound(Specific)
2930 -> compound_name_arity(Specific, Name, Arity),
2931 compound_name_arity(General, Name, Arity)
2932 ; General = Specific
2933 ).
2934
2935functor_name(Term, Name) :-
2936 ( compound(Term)
2937 -> compound_name_arity(Term, Name, _)
2938 ; atom(Term)
2939 -> Name = Term
2940 ).
2941
2942rename_goal(Goal0, Name, Goal) :-
2943 ( compound(Goal0)
2944 -> compound_name_arity(Goal0, _, Arity),
2945 compound_name_arity(Goal, Name, Arity)
2946 ; Goal = Name
2947 )