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 grammar_rule/2, 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(grammar_rule(_, Src)),
534 retractall(xoption(Src, _)),
535 retractall(xflag(_Name, _Value, Src, Line)),
536 retractall(source(Src, _)),
537 retractall(used_class(_, Src)),
538 retractall(defined_class(_, _, _, Src, _)),
539 retractall(mode(_, Src)),
540 retractall(module_comment(Src, _, _)),
541 retractall(pred_comment(_, Src, _, _)),
542 retractall(pred_comment_link(_, Src, _)),
543 retractall(pred_mode(_, Src, _)).
544
545
546 549
553
554xref_current_source(Source) :-
555 source(Source, _Time).
556
557
561
562xref_done(Source, Time) :-
563 prolog_canonical_source(Source, Src),
564 source(Src, Time).
565
566
585
586xref_called(Source, Called, By) :-
587 xref_called(Source, Called, By, _).
588
589xref_called(Source, Called, By, Cond) :-
590 canonical_source(Source, Src),
591 distinct(Called-By, called(Called, Src, By, Cond, _)).
592
593xref_called(Source, Called, By, Cond, Line) :-
594 canonical_source(Source, Src),
595 called(Called, Src, By, Cond, Line).
596
616
617xref_defined(Source, Called, How) :-
618 nonvar(Source),
619 !,
620 canonical_source(Source, Src),
621 xref_defined2(How, Src, Called).
622xref_defined(Source, Called, How) :-
623 xref_defined2(How, Src, Called),
624 canonical_source(Source, Src).
625
626xref_defined2(dynamic(Line), Src, Called) :-
627 dynamic(Called, Src, Line).
628xref_defined2(thread_local(Line), Src, Called) :-
629 thread_local(Called, Src, Line).
630xref_defined2(multifile(Line), Src, Called) :-
631 multifile(Called, Src, Line).
632xref_defined2(public(Line), Src, Called) :-
633 public(Called, Src, Line).
634xref_defined2(local(Line), Src, Called) :-
635 defined(Called, Src, Line).
636xref_defined2(foreign(Line), Src, Called) :-
637 foreign(Called, Src, Line).
638xref_defined2(constraint(Line), Src, Called) :-
639 constraint(Called, Src, Line).
640xref_defined2(imported(From), Src, Called) :-
641 imported(Called, Src, From).
642xref_defined2(dcg, Src, Called) :-
643 grammar_rule(Called, Src).
644
645
650
651xref_definition_line(local(Line), Line).
652xref_definition_line(dynamic(Line), Line).
653xref_definition_line(thread_local(Line), Line).
654xref_definition_line(multifile(Line), Line).
655xref_definition_line(public(Line), Line).
656xref_definition_line(constraint(Line), Line).
657xref_definition_line(foreign(Line), Line).
658
659
663
664xref_exported(Source, Called) :-
665 prolog_canonical_source(Source, Src),
666 exported(Called, Src).
667
671
672xref_module(Source, Module) :-
673 nonvar(Source),
674 !,
675 prolog_canonical_source(Source, Src),
676 xmodule(Module, Src).
677xref_module(Source, Module) :-
678 xmodule(Module, Src),
679 prolog_canonical_source(Source, Src).
680
688
689xref_uses_file(Source, Spec, Path) :-
690 prolog_canonical_source(Source, Src),
691 uses_file(Spec, Src, Path).
692
700
701xref_op(Source, Op) :-
702 prolog_canonical_source(Source, Src),
703 xop(Src, Op).
704
710
711xref_prolog_flag(Source, Flag, Value, Line) :-
712 prolog_canonical_source(Source, Src),
713 xflag(Flag, Value, Src, Line).
714
715xref_built_in(Head) :-
716 system_predicate(Head).
717
718xref_used_class(Source, Class) :-
719 prolog_canonical_source(Source, Src),
720 used_class(Class, Src).
721
722xref_defined_class(Source, Class, local(Line, Super, Summary)) :-
723 prolog_canonical_source(Source, Src),
724 defined_class(Class, Super, Summary, Src, Line),
725 integer(Line),
726 !.
727xref_defined_class(Source, Class, file(File)) :-
728 prolog_canonical_source(Source, Src),
729 defined_class(Class, _, _, Src, file(File)).
730
731:- thread_local
732 current_cond/1,
733 source_line/1,
734 current_test_unit/2. 735
736current_source_line(Line) :-
737 source_line(Var),
738 !,
739 Line = Var.
740
746
747collect(Src, File, In, Options) :-
748 ( Src == File
749 -> SrcSpec = Line
750 ; SrcSpec = (File:Line)
751 ),
752 option(comments(CommentHandling), Options, collect),
753 ( CommentHandling == ignore
754 -> CommentOptions = [],
755 Comments = []
756 ; CommentHandling == store
757 -> CommentOptions = [ process_comment(true) ],
758 Comments = [],
759 set_prolog_flag(xref_store_comments, true)
760 ; CommentOptions = [ comments(Comments) ]
761 ),
762 repeat,
763 catch(prolog_read_source_term(
764 In, Term, Expanded,
765 [ term_position(TermPos)
766 | CommentOptions
767 ]),
768 E, report_syntax_error(E, Src, [])),
769 update_condition(Term),
770 stream_position_data(line_count, TermPos, Line),
771 setup_call_cleanup(
772 asserta(source_line(SrcSpec), Ref),
773 catch(process(Expanded, Comments, Term, TermPos, Src, EOF),
774 E, print_message(error, E)),
775 erase(Ref)),
776 EOF == true,
777 !,
778 set_prolog_flag(xref_store_comments, false).
779
780report_syntax_error(E, _, _) :-
781 fatal_error(E),
782 throw(E).
783report_syntax_error(_, _, Options) :-
784 option(silent(true), Options),
785 !,
786 fail.
787report_syntax_error(E, Src, _Options) :-
788 ( verbose(Src)
789 -> print_message(error, E)
790 ; true
791 ),
792 fail.
793
794fatal_error(time_limit_exceeded).
795fatal_error(error(resource_error(_),_)).
796
800
801update_condition((:-Directive)) :-
802 !,
803 update_cond(Directive).
804update_condition(_).
805
806update_cond(if(Cond)) :-
807 !,
808 asserta(current_cond(Cond)).
809update_cond(else) :-
810 retract(current_cond(C0)),
811 !,
812 assert(current_cond(\+C0)).
813update_cond(elif(Cond)) :-
814 retract(current_cond(C0)),
815 !,
816 assert(current_cond((\+C0,Cond))).
817update_cond(endif) :-
818 retract(current_cond(_)),
819 !.
820update_cond(_).
821
826
827current_condition(Condition) :-
828 \+ current_cond(_),
829 !,
830 Condition = true.
831current_condition(Condition) :-
832 findall(C, current_cond(C), List),
833 list_to_conj(List, Condition).
834
835list_to_conj([], true).
836list_to_conj([C], C) :- !.
837list_to_conj([H|T], (H,C)) :-
838 list_to_conj(T, C).
839
840
841 844
854
855process(Expanded, Comments, Term0, TermPos, Src, EOF) :-
856 is_list(Expanded), 857 !,
858 ( member(Term, Expanded),
859 process(Term, Term0, Src),
860 Term == end_of_file
861 -> EOF = true
862 ; EOF = false
863 ),
864 xref_comments(Comments, TermPos, Src).
865process(end_of_file, _, _, _, _, true) :-
866 !.
867process(Term, Comments, Term0, TermPos, Src, false) :-
868 process(Term, Term0, Src),
869 xref_comments(Comments, TermPos, Src).
870
872
873process(_, Term0, _) :-
874 ignore_raw_term(Term0),
875 !.
876process(Head :- Body, Head0 --> _, Src) :-
877 pi_head(F/A, Head),
878 pi_head(F/A0, Head0),
879 A =:= A0 + 2,
880 !,
881 assert_grammar_rule(Src, Head),
882 process((Head :- Body), Src).
883process(Term, _Term0, Src) :-
884 process(Term, Src).
885
886ignore_raw_term((:- predicate_options(_,_,_))).
887
889
890process(Var, _) :-
891 var(Var),
892 !. 893process(end_of_file, _) :- !.
894process((:- Directive), Src) :-
895 !,
896 process_directive(Directive, Src),
897 !.
898process((?- Directive), Src) :-
899 !,
900 process_directive(Directive, Src),
901 !.
902process((Head :- Body), Src) :-
903 !,
904 assert_defined(Src, Head),
905 process_body(Body, Head, Src).
906process((Left => Body), Src) :-
907 !,
908 ( nonvar(Left),
909 Left = (Head, Guard)
910 -> assert_defined(Src, Head),
911 process_body(Guard, Head, Src),
912 process_body(Body, Head, Src)
913 ; assert_defined(Src, Left),
914 process_body(Body, Left, Src)
915 ).
916process(?=>(Head, Body), Src) :-
917 !,
918 assert_defined(Src, Head),
919 process_body(Body, Head, Src).
920process('$source_location'(_File, _Line):Clause, Src) :-
921 !,
922 process(Clause, Src).
923process(Term, Src) :-
924 process_chr(Term, Src),
925 !.
926process(M:(Head :- Body), Src) :-
927 !,
928 process((M:Head :- M:Body), Src).
929process(Head, Src) :-
930 assert_defined(Src, Head).
931
932
933 936
938
([], _Pos, _Src).
940:- if(current_predicate(parse_comment/3)). 941xref_comments([Pos-Comment|T], TermPos, Src) :-
942 ( Pos @> TermPos 943 -> true
944 ; stream_position_data(line_count, Pos, Line),
945 FilePos = Src:Line,
946 ( parse_comment(Comment, FilePos, Parsed)
947 -> assert_comments(Parsed, Src)
948 ; true
949 ),
950 xref_comments(T, TermPos, Src)
951 ).
952
([], _).
954assert_comments([H|T], Src) :-
955 assert_comment(H, Src),
956 assert_comments(T, Src).
957
(section(_Id, Title, Comment), Src) :-
959 assertz(module_comment(Src, Title, Comment)).
960assert_comment(predicate(PI, Summary, Comment), Src) :-
961 pi_to_head(PI, Src, Head),
962 assertz(pred_comment(Head, Src, Summary, Comment)).
963assert_comment(link(PI, PITo), Src) :-
964 pi_to_head(PI, Src, Head),
965 pi_to_head(PITo, Src, HeadTo),
966 assertz(pred_comment_link(Head, Src, HeadTo)).
967assert_comment(mode(Head, Det), Src) :-
968 assertz(pred_mode(Head, Src, Det)).
969
970pi_to_head(PI, Src, Head) :-
971 pi_to_head(PI, Head0),
972 ( Head0 = _:_
973 -> strip_module(Head0, M, Plain),
974 ( xmodule(M, Src)
975 -> Head = Plain
976 ; Head = M:Plain
977 )
978 ; Head = Head0
979 ).
980:- endif. 981
985
(Source, Title, Comment) :-
987 canonical_source(Source, Src),
988 module_comment(Src, Title, Comment).
989
993
(Source, Head, Summary, Comment) :-
995 canonical_source(Source, Src),
996 ( pred_comment(Head, Src, Summary, Comment)
997 ; pred_comment_link(Head, Src, HeadTo),
998 pred_comment(HeadTo, Src, Summary, Comment)
999 ).
1000
1005
1006xref_mode(Source, Mode, Det) :-
1007 canonical_source(Source, Src),
1008 pred_mode(Mode, Src, Det).
1009
1014
1015xref_option(Source, Option) :-
1016 canonical_source(Source, Src),
1017 xoption(Src, Option).
1018
1019
1020 1023
1024process_directive(Var, _) :-
1025 var(Var),
1026 !. 1027process_directive(Dir, _Src) :-
1028 debug(xref(directive), 'Processing :- ~q', [Dir]),
1029 fail.
1030process_directive((A,B), Src) :- 1031 !,
1032 process_directive(A, Src), 1033 process_directive(B, Src).
1034process_directive(List, Src) :-
1035 is_list(List),
1036 !,
1037 process_directive(consult(List), Src).
1038process_directive(use_module(File, Import), Src) :-
1039 process_use_module2(File, Import, Src, false).
1040process_directive(autoload(File, Import), Src) :-
1041 process_use_module2(File, Import, Src, false).
1042process_directive(require(Import), Src) :-
1043 process_requires(Import, Src).
1044process_directive(expects_dialect(Dialect), Src) :-
1045 process_directive(use_module(library(dialect/Dialect)), Src),
1046 expects_dialect(Dialect).
1047process_directive(reexport(File, Import), Src) :-
1048 process_use_module2(File, Import, Src, true).
1049process_directive(reexport(Modules), Src) :-
1050 process_use_module(Modules, Src, true).
1051process_directive(autoload(Modules), Src) :-
1052 process_use_module(Modules, Src, false).
1053process_directive(use_module(Modules), Src) :-
1054 process_use_module(Modules, Src, false).
1055process_directive(consult(Modules), Src) :-
1056 process_use_module(Modules, Src, false).
1057process_directive(ensure_loaded(Modules), Src) :-
1058 process_use_module(Modules, Src, false).
1059process_directive(load_files(Files, _Options), Src) :-
1060 process_use_module(Files, Src, false).
1061process_directive(include(Files), Src) :-
1062 process_include(Files, Src).
1063process_directive(dynamic(Dynamic), Src) :-
1064 process_predicates(assert_dynamic, Dynamic, Src).
1065process_directive(dynamic(Dynamic, _Options), Src) :-
1066 process_predicates(assert_dynamic, Dynamic, Src).
1067process_directive(thread_local(Dynamic), Src) :-
1068 process_predicates(assert_thread_local, Dynamic, Src).
1069process_directive(multifile(Dynamic), Src) :-
1070 process_predicates(assert_multifile, Dynamic, Src).
1071process_directive(public(Public), Src) :-
1072 process_predicates(assert_public, Public, Src).
1073process_directive(export(Export), Src) :-
1074 process_predicates(assert_export, Export, Src).
1075process_directive(import(Import), Src) :-
1076 process_import(Import, Src).
1077process_directive(module(Module, Export), Src) :-
1078 assert_module(Src, Module),
1079 assert_module_export(Src, Export).
1080process_directive(module(Module, Export, Import), Src) :-
1081 assert_module(Src, Module),
1082 assert_module_export(Src, Export),
1083 assert_module3(Import, Src).
1084process_directive(begin_tests(Unit, _Options), Src) :-
1085 enter_test_unit(Unit, Src).
1086process_directive(begin_tests(Unit), Src) :-
1087 enter_test_unit(Unit, Src).
1088process_directive(end_tests(Unit), Src) :-
1089 leave_test_unit(Unit, Src).
1090process_directive('$set_source_module'(system), Src) :-
1091 assert_module(Src, system). 1092process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :-
1093 assert_defined_class(Src, Name, Meta, Super, Doc).
1094process_directive(pce_autoload(Name, From), Src) :-
1095 assert_defined_class(Src, Name, imported_from(From)).
1096
1097process_directive(op(P, A, N), Src) :-
1098 xref_push_op(Src, P, A, N).
1099process_directive(set_prolog_flag(Flag, Value), Src) :-
1100 ( Flag == character_escapes
1101 -> set_prolog_flag(character_escapes, Value)
1102 ; true
1103 ),
1104 current_source_line(Line),
1105 xref_set_prolog_flag(Flag, Value, Src, Line).
1106process_directive(style_check(X), _) :-
1107 style_check(X).
1108process_directive(encoding(Enc), _) :-
1109 ( xref_input_stream(Stream)
1110 -> catch(set_stream(Stream, encoding(Enc)), _, true)
1111 ; true 1112 ).
1113process_directive(pce_expansion:push_compile_operators, _) :-
1114 '$current_source_module'(SM),
1115 call(pce_expansion:push_compile_operators(SM)). 1116process_directive(pce_expansion:pop_compile_operators, _) :-
1117 call(pce_expansion:pop_compile_operators).
1118process_directive(meta_predicate(Meta), Src) :-
1119 process_meta_predicate(Meta, Src).
1120process_directive(arithmetic_function(FSpec), Src) :-
1121 arith_callable(FSpec, Goal),
1122 !,
1123 current_source_line(Line),
1124 assert_called(Src, '<directive>'(Line), Goal, Line).
1125process_directive(format_predicate(_, Goal), Src) :-
1126 !,
1127 current_source_line(Line),
1128 assert_called(Src, '<directive>'(Line), Goal, Line).
1129process_directive(if(Cond), Src) :-
1130 !,
1131 current_source_line(Line),
1132 assert_called(Src, '<directive>'(Line), Cond, Line).
1133process_directive(elif(Cond), Src) :-
1134 !,
1135 current_source_line(Line),
1136 assert_called(Src, '<directive>'(Line), Cond, Line).
1137process_directive(else, _) :- !.
1138process_directive(endif, _) :- !.
1139process_directive(Goal, Src) :-
1140 current_source_line(Line),
1141 process_body(Goal, '<directive>'(Line), Src).
1142
1146
1147process_meta_predicate((A,B), Src) :-
1148 !,
1149 process_meta_predicate(A, Src),
1150 process_meta_predicate(B, Src).
1151process_meta_predicate(Decl, Src) :-
1152 process_meta_head(Src, Decl).
1153
1154process_meta_head(Src, Decl) :- 1155 compound(Decl),
1156 compound_name_arity(Decl, Name, Arity),
1157 compound_name_arity(Head, Name, Arity),
1158 meta_args(1, Arity, Decl, Head, Meta),
1159 ( ( prolog:meta_goal(Head, _)
1160 ; prolog:called_by(Head, _, _, _)
1161 ; prolog:called_by(Head, _)
1162 ; meta_goal(Head, _)
1163 )
1164 -> true
1165 ; assert(meta_goal(Head, Meta, Src))
1166 ).
1167
1168meta_args(I, Arity, _, _, []) :-
1169 I > Arity,
1170 !.
1171meta_args(I, Arity, Decl, Head, [H|T]) :- 1172 arg(I, Decl, 0),
1173 !,
1174 arg(I, Head, H),
1175 I2 is I + 1,
1176 meta_args(I2, Arity, Decl, Head, T).
1177meta_args(I, Arity, Decl, Head, [H|T]) :- 1178 arg(I, Decl, ^),
1179 !,
1180 arg(I, Head, EH),
1181 setof_goal(EH, H),
1182 I2 is I + 1,
1183 meta_args(I2, Arity, Decl, Head, T).
1184meta_args(I, Arity, Decl, Head, [//(H)|T]) :-
1185 arg(I, Decl, //),
1186 !,
1187 arg(I, Head, H),
1188 I2 is I + 1,
1189 meta_args(I2, Arity, Decl, Head, T).
1190meta_args(I, Arity, Decl, Head, [H+A|T]) :- 1191 arg(I, Decl, A),
1192 integer(A), A > 0,
1193 !,
1194 arg(I, Head, H),
1195 I2 is I + 1,
1196 meta_args(I2, Arity, Decl, Head, T).
1197meta_args(I, Arity, Decl, Head, Meta) :-
1198 I2 is I + 1,
1199 meta_args(I2, Arity, Decl, Head, Meta).
1200
1201
1202 1205
1212
1213xref_meta(Source, Head, Called) :-
1214 canonical_source(Source, Src),
1215 xref_meta_src(Head, Called, Src).
1216
1229
1230xref_meta_src(Head, Called, Src) :-
1231 meta_goal(Head, Called, Src),
1232 !.
1233xref_meta_src(Head, Called, _) :-
1234 xref_meta(Head, Called),
1235 !.
1236xref_meta_src(Head, Called, _) :-
1237 compound(Head),
1238 compound_name_arity(Head, Name, Arity),
1239 apply_pred(Name),
1240 Arity > 5,
1241 !,
1242 Extra is Arity - 1,
1243 arg(1, Head, G),
1244 Called = [G+Extra].
1245xref_meta_src(Head, Called, _) :-
1246 predicate_property('$xref_tmp':Head, meta_predicate(Meta)),
1247 !,
1248 Meta =.. [_|Args],
1249 meta_args(Args, 1, Head, Called).
1250
1251meta_args([], _, _, []).
1252meta_args([H0|T0], I, Head, [H|T]) :-
1253 xargs(H0, N),
1254 !,
1255 arg(I, Head, A),
1256 ( N == 0
1257 -> H = A
1258 ; H = (A+N)
1259 ),
1260 I2 is I+1,
1261 meta_args(T0, I2, Head, T).
1262meta_args([_|T0], I, Head, T) :-
1263 I2 is I+1,
1264 meta_args(T0, I2, Head, T).
1265
1266xargs(N, N) :- integer(N), !.
1267xargs(//, 2).
1268xargs(^, 0).
1269
1270apply_pred(call). 1271apply_pred(maplist). 1272
1273xref_meta((A, B), [A, B]).
1274xref_meta((A; B), [A, B]).
1275xref_meta((A| B), [A, B]).
1276xref_meta((A -> B), [A, B]).
1277xref_meta((A *-> B), [A, B]).
1278xref_meta(findall(_V,G,_L), [G]).
1279xref_meta(findall(_V,G,_L,_T), [G]).
1280xref_meta(findnsols(_N,_V,G,_L), [G]).
1281xref_meta(findnsols(_N,_V,G,_L,_T), [G]).
1282xref_meta(setof(_V, EG, _L), [G]) :-
1283 setof_goal(EG, G).
1284xref_meta(bagof(_V, EG, _L), [G]) :-
1285 setof_goal(EG, G).
1286xref_meta(forall(A, B), [A, B]).
1287xref_meta(maplist(G,_), [G+1]).
1288xref_meta(maplist(G,_,_), [G+2]).
1289xref_meta(maplist(G,_,_,_), [G+3]).
1290xref_meta(maplist(G,_,_,_,_), [G+4]).
1291xref_meta(map_list_to_pairs(G,_,_), [G+2]).
1292xref_meta(map_assoc(G, _), [G+1]).
1293xref_meta(map_assoc(G, _, _), [G+2]).
1294xref_meta(checklist(G, _L), [G+1]).
1295xref_meta(sublist(G, _, _), [G+1]).
1296xref_meta(include(G, _, _), [G+1]).
1297xref_meta(exclude(G, _, _), [G+1]).
1298xref_meta(partition(G, _, _, _, _), [G+2]).
1299xref_meta(partition(G, _, _, _),[G+1]).
1300xref_meta(call(G), [G]).
1301xref_meta(call(G, _), [G+1]).
1302xref_meta(call(G, _, _), [G+2]).
1303xref_meta(call(G, _, _, _), [G+3]).
1304xref_meta(call(G, _, _, _, _), [G+4]).
1305xref_meta(not(G), [G]).
1306xref_meta(notrace(G), [G]).
1307xref_meta('$notrace'(G), [G]).
1308xref_meta(\+(G), [G]).
1309xref_meta(ignore(G), [G]).
1310xref_meta(once(G), [G]).
1311xref_meta(initialization(G), [G]).
1312xref_meta(initialization(G,_), [G]).
1313xref_meta(retract(Rule), [G]) :- head_of(Rule, G).
1314xref_meta(clause(G, _), [G]).
1315xref_meta(clause(G, _, _), [G]).
1316xref_meta(phrase(G, _A), [//(G)]).
1317xref_meta(phrase(G, _A, _R), [//(G)]).
1318xref_meta(call_dcg(G, _A, _R), [//(G)]).
1319xref_meta(phrase_from_file(G,_),[//(G)]).
1320xref_meta(catch(A, _, B), [A, B]).
1321xref_meta(catch_with_backtrace(A, _, B), [A, B]).
1322xref_meta(thread_create(A,_,_), [A]).
1323xref_meta(thread_create(A,_), [A]).
1324xref_meta(thread_signal(_,A), [A]).
1325xref_meta(thread_idle(A,_), [A]).
1326xref_meta(thread_at_exit(A), [A]).
1327xref_meta(thread_initialization(A), [A]).
1328xref_meta(engine_create(_,A,_), [A]).
1329xref_meta(engine_create(_,A,_,_), [A]).
1330xref_meta(transaction(A), [A]).
1331xref_meta(transaction(A,B,_), [A,B]).
1332xref_meta(snapshot(A), [A]).
1333xref_meta(predsort(A,_,_), [A+3]).
1334xref_meta(call_cleanup(A, B), [A, B]).
1335xref_meta(call_cleanup(A, _, B),[A, B]).
1336xref_meta(setup_call_cleanup(A, B, C),[A, B, C]).
1337xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]).
1338xref_meta(call_residue_vars(A,_), [A]).
1339xref_meta(with_mutex(_,A), [A]).
1340xref_meta(assume(G), [G]). 1341xref_meta(assertion(G), [G]). 1342xref_meta(freeze(_, G), [G]).
1343xref_meta(when(C, A), [C, A]).
1344xref_meta(time(G), [G]). 1345xref_meta(call_time(G, _), [G]). 1346xref_meta(call_time(G, _, _), [G]). 1347xref_meta(profile(G), [G]).
1348xref_meta(at_halt(G), [G]).
1349xref_meta(call_with_time_limit(_, G), [G]).
1350xref_meta(call_with_depth_limit(G, _, _), [G]).
1351xref_meta(call_with_inference_limit(G, _, _), [G]).
1352xref_meta(alarm(_, G, _), [G]).
1353xref_meta(alarm(_, G, _, _), [G]).
1354xref_meta('$add_directive_wic'(G), [G]).
1355xref_meta(with_output_to(_, G), [G]).
1356xref_meta(if(G), [G]).
1357xref_meta(elif(G), [G]).
1358xref_meta(meta_options(G,_,_), [G+1]).
1359xref_meta(on_signal(_,_,H), [H+1]) :- H \== default.
1360xref_meta(distinct(G), [G]). 1361xref_meta(distinct(_, G), [G]).
1362xref_meta(order_by(_, G), [G]).
1363xref_meta(limit(_, G), [G]).
1364xref_meta(offset(_, G), [G]).
1365xref_meta(reset(G,_,_), [G]).
1366xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N).
1367xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N).
1368xref_meta(tnot(G), [G]).
1369xref_meta(not_exists(G), [G]).
1370xref_meta(with_tty_raw(G), [G]).
1371xref_meta(residual_goals(G), [G+2]).
1372
1373 1374xref_meta(pce_global(_, new(_)), _) :- !, fail.
1375xref_meta(pce_global(_, B), [B+1]).
1376xref_meta(ifmaintainer(G), [G]). 1377xref_meta(listen(_, G), [G]). 1378xref_meta(listen(_, _, G), [G]).
1379xref_meta(in_pce_thread(G), [G]).
1380
1381xref_meta(G, Meta) :- 1382 prolog:meta_goal(G, Meta).
1383xref_meta(G, Meta) :- 1384 meta_goal(G, Meta).
1385
1386setof_goal(EG, G) :-
1387 var(EG), !, G = EG.
1388setof_goal(_^EG, G) :-
1389 !,
1390 setof_goal(EG, G).
1391setof_goal(G, G).
1392
1393event_xargs(abort, 0).
1394event_xargs(erase, 1).
1395event_xargs(break, 3).
1396event_xargs(frame_finished, 1).
1397event_xargs(thread_exit, 1).
1398event_xargs(this_thread_exit, 0).
1399event_xargs(PI, 2) :- pi_to_head(PI, _).
1400
1404
1405head_of(Var, _) :-
1406 var(Var), !, fail.
1407head_of((Head :- _), Head).
1408head_of(Head, Head).
1409
1415
1416xref_hook(Hook) :-
1417 prolog:hook(Hook).
1418xref_hook(Hook) :-
1419 hook(Hook).
1420
1421
1422hook(attr_portray_hook(_,_)).
1423hook(attr_unify_hook(_,_)).
1424hook(attribute_goals(_,_,_)).
1425hook(goal_expansion(_,_)).
1426hook(term_expansion(_,_)).
1427hook(resource(_,_,_)).
1428hook('$pred_option'(_,_,_,_)).
1429
1430hook(emacs_prolog_colours:goal_classification(_,_)).
1431hook(emacs_prolog_colours:term_colours(_,_)).
1432hook(emacs_prolog_colours:goal_colours(_,_)).
1433hook(emacs_prolog_colours:style(_,_)).
1434hook(emacs_prolog_colours:identify(_,_)).
1435hook(pce_principal:pce_class(_,_,_,_,_,_)).
1436hook(pce_principal:send_implementation(_,_,_)).
1437hook(pce_principal:get_implementation(_,_,_,_)).
1438hook(pce_principal:pce_lazy_get_method(_,_,_)).
1439hook(pce_principal:pce_lazy_send_method(_,_,_)).
1440hook(pce_principal:pce_uses_template(_,_)).
1441hook(prolog:locate_clauses(_,_)).
1442hook(prolog:message(_,_,_)).
1443hook(prolog:error_message(_,_,_)).
1444hook(prolog:message_location(_,_,_)).
1445hook(prolog:message_context(_,_,_)).
1446hook(prolog:message_line_element(_,_)).
1447hook(prolog:debug_control_hook(_)).
1448hook(prolog:help_hook(_)).
1449hook(prolog:show_profile_hook(_,_)).
1450hook(prolog:general_exception(_,_)).
1451hook(prolog:predicate_summary(_,_)).
1452hook(prolog:residual_goals(_,_)).
1453hook(prolog_edit:load).
1454hook(prolog_edit:locate(_,_,_)).
1455hook(shlib:unload_all_foreign_libraries).
1456hook(system:'$foreign_registered'(_, _)).
1457hook(predicate_options:option_decl(_,_,_)).
1458hook(user:exception(_,_,_)).
1459hook(user:file_search_path(_,_)).
1460hook(user:library_directory(_)).
1461hook(user:message_hook(_,_,_)).
1462hook(user:portray(_)).
1463hook(user:prolog_clause_name(_,_)).
1464hook(user:prolog_list_goal(_)).
1465hook(user:prolog_predicate_name(_,_)).
1466hook(user:prolog_trace_interception(_,_,_,_)).
1467hook(prolog:prolog_exception_hook(_,_,_,_,_)).
1468hook(sandbox:safe_primitive(_)).
1469hook(sandbox:safe_meta_predicate(_)).
1470hook(sandbox:safe_meta(_,_)).
1471hook(sandbox:safe_global_variable(_)).
1472hook(sandbox:safe_directive(_)).
1473
1474
1478
1479arith_callable(Var, _) :-
1480 var(Var), !, fail.
1481arith_callable(Module:Spec, Module:Goal) :-
1482 !,
1483 arith_callable(Spec, Goal).
1484arith_callable(Name/Arity, Goal) :-
1485 PredArity is Arity + 1,
1486 functor(Goal, Name, PredArity).
1487
1496
1497process_body(Body, Origin, Src) :-
1498 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1499 true).
1500
1505
1506process_goal(Var, _, _, _) :-
1507 var(Var),
1508 !.
1509process_goal(_:Goal, _, _, _) :-
1510 var(Goal),
1511 !.
1512process_goal(Goal, Origin, Src, P) :-
1513 Goal = (_,_), 1514 !,
1515 phrase(conjunction(Goal), Goals),
1516 process_conjunction(Goals, Origin, Src, P).
1517process_goal(Goal, Origin, Src, _) :- 1518 Goal = (_;_), 1519 !,
1520 phrase(disjunction(Goal), Goals),
1521 forall(member(G, Goals),
1522 process_body(G, Origin, Src)).
1523process_goal(Goal, Origin, Src, P) :-
1524 ( ( xmodule(M, Src)
1525 -> true
1526 ; M = user
1527 ),
1528 pi_head(PI, M:Goal),
1529 ( current_predicate(PI),
1530 predicate_property(M:Goal, imported_from(IM))
1531 -> true
1532 ; PI = M:Name/Arity,
1533 '$find_library'(M, Name, Arity, IM, _Library)
1534 -> true
1535 ; IM = M
1536 ),
1537 prolog:called_by(Goal, IM, M, Called)
1538 ; prolog:called_by(Goal, Called)
1539 ),
1540 !,
1541 must_be(list, Called),
1542 current_source_line(Here),
1543 assert_called(Src, Origin, Goal, Here),
1544 process_called_list(Called, Origin, Src, P).
1545process_goal(Goal, Origin, Src, _) :-
1546 process_xpce_goal(Goal, Origin, Src),
1547 !.
1548process_goal(load_foreign_library(File), _Origin, Src, _) :-
1549 process_foreign(File, Src).
1550process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :-
1551 process_foreign(File, Src).
1552process_goal(use_foreign_library(File), _Origin, Src, _) :-
1553 process_foreign(File, Src).
1554process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :-
1555 process_foreign(File, Src).
1556process_goal(Goal, Origin, Src, P) :-
1557 xref_meta_src(Goal, Metas, Src),
1558 !,
1559 current_source_line(Here),
1560 assert_called(Src, Origin, Goal, Here),
1561 process_called_list(Metas, Origin, Src, P).
1562process_goal(Goal, Origin, Src, _) :-
1563 asserting_goal(Goal, Rule),
1564 !,
1565 current_source_line(Here),
1566 assert_called(Src, Origin, Goal, Here),
1567 process_assert(Rule, Origin, Src).
1568process_goal(Goal, Origin, Src, P) :-
1569 partial_evaluate(Goal, P),
1570 current_source_line(Here),
1571 assert_called(Src, Origin, Goal, Here).
1572
1573disjunction(Var) --> {var(Var), !}, [Var].
1574disjunction((A;B)) --> !, disjunction(A), disjunction(B).
1575disjunction(G) --> [G].
1576
1577conjunction(Var) --> {var(Var), !}, [Var].
1578conjunction((A,B)) --> !, conjunction(A), conjunction(B).
1579conjunction(G) --> [G].
1580
1581shares_vars(RVars, T) :-
1582 term_variables(T, TVars0),
1583 sort(TVars0, TVars),
1584 ord_intersect(RVars, TVars).
1585
1586process_conjunction([], _, _, _).
1587process_conjunction([Disj|Rest], Origin, Src, P) :-
1588 nonvar(Disj),
1589 Disj = (_;_),
1590 Rest \== [],
1591 !,
1592 phrase(disjunction(Disj), Goals),
1593 term_variables(Rest, RVars0),
1594 sort(RVars0, RVars),
1595 partition(shares_vars(RVars), Goals, Sharing, NonSHaring),
1596 forall(member(G, NonSHaring),
1597 process_body(G, Origin, Src)),
1598 ( Sharing == []
1599 -> true
1600 ; maplist(term_variables, Sharing, GVars0),
1601 append(GVars0, GVars1),
1602 sort(GVars1, GVars),
1603 ord_intersection(GVars, RVars, SVars),
1604 VT =.. [v|SVars],
1605 findall(VT,
1606 ( member(G, Sharing),
1607 process_goal(G, Origin, Src, PS),
1608 PS == true
1609 ),
1610 Alts0),
1611 ( Alts0 == []
1612 -> true
1613 ; ( true
1614 ; P = true,
1615 sort(Alts0, Alts1),
1616 variants(Alts1, 10, Alts),
1617 member(VT, Alts)
1618 )
1619 )
1620 ),
1621 process_conjunction(Rest, Origin, Src, P).
1622process_conjunction([H|T], Origin, Src, P) :-
1623 process_goal(H, Origin, Src, P),
1624 process_conjunction(T, Origin, Src, P).
1625
1626
1627process_called_list([], _, _, _).
1628process_called_list([H|T], Origin, Src, P) :-
1629 process_meta(H, Origin, Src, P),
1630 process_called_list(T, Origin, Src, P).
1631
1632process_meta(A+N, Origin, Src, P) :-
1633 !,
1634 ( extend(A, N, AX)
1635 -> process_goal(AX, Origin, Src, P)
1636 ; true
1637 ).
1638process_meta(//(A), Origin, Src, P) :-
1639 !,
1640 process_dcg_goal(A, Origin, Src, P).
1641process_meta(G, Origin, Src, P) :-
1642 process_goal(G, Origin, Src, P).
1643
1648
1649process_dcg_goal(Var, _, _, _) :-
1650 var(Var),
1651 !.
1652process_dcg_goal((A,B), Origin, Src, P) :-
1653 !,
1654 process_dcg_goal(A, Origin, Src, P),
1655 process_dcg_goal(B, Origin, Src, P).
1656process_dcg_goal((A;B), Origin, Src, P) :-
1657 !,
1658 process_dcg_goal(A, Origin, Src, P),
1659 process_dcg_goal(B, Origin, Src, P).
1660process_dcg_goal((A|B), Origin, Src, P) :-
1661 !,
1662 process_dcg_goal(A, Origin, Src, P),
1663 process_dcg_goal(B, Origin, Src, P).
1664process_dcg_goal((A->B), Origin, Src, P) :-
1665 !,
1666 process_dcg_goal(A, Origin, Src, P),
1667 process_dcg_goal(B, Origin, Src, P).
1668process_dcg_goal((A*->B), Origin, Src, P) :-
1669 !,
1670 process_dcg_goal(A, Origin, Src, P),
1671 process_dcg_goal(B, Origin, Src, P).
1672process_dcg_goal({Goal}, Origin, Src, P) :-
1673 !,
1674 process_goal(Goal, Origin, Src, P).
1675process_dcg_goal(List, _Origin, _Src, _) :-
1676 is_list(List),
1677 !. 1678process_dcg_goal(List, _Origin, _Src, _) :-
1679 string(List),
1680 !. 1681process_dcg_goal(Callable, Origin, Src, P) :-
1682 extend(Callable, 2, Goal),
1683 !,
1684 process_goal(Goal, Origin, Src, P).
1685process_dcg_goal(_, _, _, _).
1686
1687
1688extend(Var, _, _) :-
1689 var(Var), !, fail.
1690extend(M:G, N, M:GX) :-
1691 !,
1692 callable(G),
1693 extend(G, N, GX).
1694extend(G, N, GX) :-
1695 ( compound(G)
1696 -> compound_name_arguments(G, Name, Args),
1697 length(Rest, N),
1698 append(Args, Rest, NArgs),
1699 compound_name_arguments(GX, Name, NArgs)
1700 ; atom(G)
1701 -> length(NArgs, N),
1702 compound_name_arguments(GX, G, NArgs)
1703 ).
1704
1705asserting_goal(assert(Rule), Rule).
1706asserting_goal(asserta(Rule), Rule).
1707asserting_goal(assertz(Rule), Rule).
1708asserting_goal(assert(Rule,_), Rule).
1709asserting_goal(asserta(Rule,_), Rule).
1710asserting_goal(assertz(Rule,_), Rule).
1711
1712process_assert(0, _, _) :- !. 1713process_assert((_:-Body), Origin, Src) :-
1714 !,
1715 process_body(Body, Origin, Src).
1716process_assert(_, _, _).
1717
1719
1720variants([], _, []).
1721variants([H|T], Max, List) :-
1722 variants(T, H, Max, List).
1723
1724variants([], H, _, [H]).
1725variants(_, _, 0, []) :- !.
1726variants([H|T], V, Max, List) :-
1727 ( H =@= V
1728 -> variants(T, V, Max, List)
1729 ; List = [V|List2],
1730 Max1 is Max-1,
1731 variants(T, H, Max1, List2)
1732 ).
1733
1745
1746partial_evaluate(Goal, P) :-
1747 eval(Goal),
1748 !,
1749 P = true.
1750partial_evaluate(_, _).
1751
1752eval(X = Y) :-
1753 unify_with_occurs_check(X, Y).
1754
1755 1758
1759enter_test_unit(Unit, _Src) :-
1760 current_source_line(Line),
1761 asserta(current_test_unit(Unit, Line)).
1762
1763leave_test_unit(Unit, _Src) :-
1764 retractall(current_test_unit(Unit, _)).
1765
1766
1767 1770
1771pce_goal(new(_,_), new(-, new)).
1772pce_goal(send(_,_), send(arg, msg)).
1773pce_goal(send_class(_,_,_), send_class(arg, arg, msg)).
1774pce_goal(get(_,_,_), get(arg, msg, -)).
1775pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)).
1776pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)).
1777pce_goal(get_object(_,_,_), get_object(arg, msg, -)).
1778
1779process_xpce_goal(G, Origin, Src) :-
1780 pce_goal(G, Process),
1781 !,
1782 current_source_line(Here),
1783 assert_called(Src, Origin, G, Here),
1784 ( arg(I, Process, How),
1785 arg(I, G, Term),
1786 process_xpce_arg(How, Term, Origin, Src),
1787 fail
1788 ; true
1789 ).
1790
1791process_xpce_arg(new, Term, Origin, Src) :-
1792 callable(Term),
1793 process_new(Term, Origin, Src).
1794process_xpce_arg(arg, Term, Origin, Src) :-
1795 compound(Term),
1796 process_new(Term, Origin, Src).
1797process_xpce_arg(msg, Term, Origin, Src) :-
1798 compound(Term),
1799 ( arg(_, Term, Arg),
1800 process_xpce_arg(arg, Arg, Origin, Src),
1801 fail
1802 ; true
1803 ).
1804
1805process_new(_M:_Term, _, _) :- !. 1806process_new(Term, Origin, Src) :-
1807 assert_new(Src, Origin, Term),
1808 ( compound(Term),
1809 arg(_, Term, Arg),
1810 process_xpce_arg(arg, Arg, Origin, Src),
1811 fail
1812 ; true
1813 ).
1814
1815assert_new(_, _, Term) :-
1816 \+ callable(Term),
1817 !.
1818assert_new(Src, Origin, Control) :-
1819 functor_name(Control, Class),
1820 pce_control_class(Class),
1821 !,
1822 forall(arg(_, Control, Arg),
1823 assert_new(Src, Origin, Arg)).
1824assert_new(Src, Origin, Term) :-
1825 compound(Term),
1826 arg(1, Term, Prolog),
1827 Prolog == @(prolog),
1828 ( Term =.. [message, _, Selector | T],
1829 atom(Selector)
1830 -> Called =.. [Selector|T],
1831 process_body(Called, Origin, Src)
1832 ; Term =.. [?, _, Selector | T],
1833 atom(Selector)
1834 -> append(T, [_R], T2),
1835 Called =.. [Selector|T2],
1836 process_body(Called, Origin, Src)
1837 ),
1838 fail.
1839assert_new(_, _, @(_)) :- !.
1840assert_new(Src, _, Term) :-
1841 functor_name(Term, Name),
1842 assert_used_class(Src, Name).
1843
1844
1845pce_control_class(and).
1846pce_control_class(or).
1847pce_control_class(if).
1848pce_control_class(not).
1849
1850
1851 1854
1856
1857process_use_module(_Module:_Files, _, _) :- !. 1858process_use_module([], _, _) :- !.
1859process_use_module([H|T], Src, Reexport) :-
1860 !,
1861 process_use_module(H, Src, Reexport),
1862 process_use_module(T, Src, Reexport).
1863process_use_module(library(pce), Src, Reexport) :- 1864 !,
1865 xref_public_list(library(pce), Path, Exports, Src),
1866 forall(member(Import, Exports),
1867 process_pce_import(Import, Src, Path, Reexport)).
1868process_use_module(File, Src, Reexport) :-
1869 load_module_if_needed(File),
1870 ( xoption(Src, silent(Silent))
1871 -> Extra = [silent(Silent)]
1872 ; Extra = [silent(true)]
1873 ),
1874 ( xref_public_list(File, Src,
1875 [ path(Path),
1876 module(M),
1877 exports(Exports),
1878 public(Public),
1879 meta(Meta)
1880 | Extra
1881 ])
1882 -> assert(uses_file(File, Src, Path)),
1883 assert_import(Src, Exports, _, Path, Reexport),
1884 assert_xmodule_callable(Exports, M, Src, Path),
1885 assert_xmodule_callable(Public, M, Src, Path),
1886 maplist(process_meta_head(Src), Meta),
1887 ( File = library(chr) 1888 -> assert(mode(chr, Src))
1889 ; true
1890 )
1891 ; assert(uses_file(File, Src, '<not_found>'))
1892 ).
1893
1894process_pce_import(Name/Arity, Src, Path, Reexport) :-
1895 atom(Name),
1896 integer(Arity),
1897 !,
1898 functor(Term, Name, Arity),
1899 ( \+ system_predicate(Term),
1900 \+ Term = pce_error(_) 1901 -> assert_import(Src, [Name/Arity], _, Path, Reexport)
1902 ; true
1903 ).
1904process_pce_import(op(P,T,N), Src, _, _) :-
1905 xref_push_op(Src, P, T, N).
1906
1910
1911process_use_module2(File, Import, Src, Reexport) :-
1912 load_module_if_needed(File),
1913 ( xref_source_file(File, Path, Src)
1914 -> assert(uses_file(File, Src, Path)),
1915 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1916 -> assert_import(Src, Import, Export, Path, Reexport),
1917 forall(( member(Head, Meta),
1918 imported(Head, _, Path)
1919 ),
1920 process_meta_head(Src, Head))
1921 ; true
1922 )
1923 ; assert(uses_file(File, Src, '<not_found>'))
1924 ).
1925
1926
1932
1933load_module_if_needed(File) :-
1934 prolog:no_autoload_module(File),
1935 !,
1936 use_module(File, []).
1937load_module_if_needed(_).
1938
1939prolog:no_autoload_module(library(apply_macros)).
1940prolog:no_autoload_module(library(arithmetic)).
1941prolog:no_autoload_module(library(record)).
1942prolog:no_autoload_module(library(persistency)).
1943prolog:no_autoload_module(library(pldoc)).
1944prolog:no_autoload_module(library(settings)).
1945prolog:no_autoload_module(library(debug)).
1946prolog:no_autoload_module(library(plunit)).
1947prolog:no_autoload_module(library(macros)).
1948
1949
1951
1952process_requires(Import, Src) :-
1953 is_list(Import),
1954 !,
1955 require_list(Import, Src).
1956process_requires(Var, _Src) :-
1957 var(Var),
1958 !.
1959process_requires((A,B), Src) :-
1960 !,
1961 process_requires(A, Src),
1962 process_requires(B, Src).
1963process_requires(PI, Src) :-
1964 requires(PI, Src).
1965
1966require_list([], _).
1967require_list([H|T], Src) :-
1968 requires(H, Src),
1969 require_list(T, Src).
1970
1971requires(PI, _Src) :-
1972 '$pi_head'(PI, Head),
1973 '$get_predicate_attribute'(system:Head, defined, 1),
1974 !.
1975requires(PI, Src) :-
1976 '$pi_head'(PI, Head),
1977 '$pi_head'(Name/Arity, Head),
1978 '$find_library'(_Module, Name, Arity, _LoadModule, Library),
1979 ( imported(Head, Src, Library)
1980 -> true
1981 ; assertz(imported(Head, Src, Library))
1982 ).
1983
1984
2012
2013xref_public_list(File, Src, Options) :-
2014 option(path(Path), Options, _),
2015 option(module(Module), Options, _),
2016 option(exports(Exports), Options, _),
2017 option(public(Public), Options, _),
2018 option(meta(Meta), Options, _),
2019 xref_source_file(File, Path, Src, Options),
2020 public_list(Path, Module, Meta, Exports, Public, Options).
2021
2041
2042xref_public_list(File, Path, Export, Src) :-
2043 xref_source_file(File, Path, Src),
2044 public_list(Path, _, _, Export, _, []).
2045xref_public_list(File, Path, Module, Export, Meta, Src) :-
2046 xref_source_file(File, Path, Src),
2047 public_list(Path, Module, Meta, Export, _, []).
2048xref_public_list(File, Path, Module, Export, Public, Meta, Src) :-
2049 xref_source_file(File, Path, Src),
2050 public_list(Path, Module, Meta, Export, Public, []).
2051
2059
2060:- dynamic public_list_cache/6. 2061:- volatile public_list_cache/6. 2062
2063public_list(Path, Module, Meta, Export, Public, _Options) :-
2064 public_list_cache(Path, Modified,
2065 Module0, Meta0, Export0, Public0),
2066 time_file(Path, ModifiedNow),
2067 ( abs(Modified-ModifiedNow) < 0.0001
2068 -> !,
2069 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0)
2070 ; retractall(public_list_cache(Path, _, _, _, _, _)),
2071 fail
2072 ).
2073public_list(Path, Module, Meta, Export, Public, Options) :-
2074 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options),
2075 ( Error = error(_,_),
2076 catch(time_file(Path, Modified), Error, fail)
2077 -> asserta(public_list_cache(Path, Modified,
2078 Module0, Meta0, Export0, Public0))
2079 ; true
2080 ),
2081 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0).
2082
2083public_list_nc(Path, Module, Meta, Export, Public, Options) :-
2084 in_temporary_module(
2085 TempModule,
2086 true,
2087 public_list_diff(TempModule, Path, Module,
2088 Meta, [], Export, [], Public, [], Options)).
2089
2090
2091public_list_diff(TempModule,
2092 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :-
2093 setup_call_cleanup(
2094 public_list_setup(TempModule, Path, In, State),
2095 phrase(read_directives(In, Options, [true]), Directives),
2096 public_list_cleanup(In, State)),
2097 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT).
2098
2099public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :-
2100 prolog_open_source(Path, In),
2101 '$set_source_module'(OldM, TempModule),
2102 set_xref(OldXref).
2103
2104public_list_cleanup(In, state(OldM, OldXref)) :-
2105 '$set_source_module'(OldM),
2106 set_prolog_flag(xref, OldXref),
2107 prolog_close_source(In).
2108
2109
2110read_directives(In, Options, State) -->
2111 { repeat,
2112 catch(prolog_read_source_term(In, Term, Expanded,
2113 [ process_comment(true),
2114 syntax_errors(error)
2115 ]),
2116 E, report_syntax_error(E, -, Options))
2117 -> nonvar(Term),
2118 Term = (:-_)
2119 },
2120 !,
2121 terms(Expanded, State, State1),
2122 read_directives(In, Options, State1).
2123read_directives(_, _, _) --> [].
2124
2125terms(Var, State, State) --> { var(Var) }, !.
2126terms([H|T], State0, State) -->
2127 !,
2128 terms(H, State0, State1),
2129 terms(T, State1, State).
2130terms((:-if(Cond)), State0, [True|State0]) -->
2131 !,
2132 { eval_cond(Cond, True) }.
2133terms((:-elif(Cond)), [True0|State], [True|State]) -->
2134 !,
2135 { eval_cond(Cond, True1),
2136 elif(True0, True1, True)
2137 }.
2138terms((:-else), [True0|State], [True|State]) -->
2139 !,
2140 { negate(True0, True) }.
2141terms((:-endif), [_|State], State) --> !.
2142terms(H, State, State) -->
2143 ( {State = [true|_]}
2144 -> [H]
2145 ; []
2146 ).
2147
2148eval_cond(Cond, true) :-
2149 catch(Cond, _, fail),
2150 !.
2151eval_cond(_, false).
2152
2153elif(true, _, else_false) :- !.
2154elif(false, true, true) :- !.
2155elif(True, _, True).
2156
2157negate(true, false).
2158negate(false, true).
2159negate(else_false, else_false).
2160
2161public_list([(:- module(Module, Export0))|Decls], Path,
2162 Module, Meta, MT, Export, Rest, Public, PT) :-
2163 !,
2164 ( is_list(Export0)
2165 -> append(Export0, Reexport, Export)
2166 ; Reexport = Export
2167 ),
2168 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT).
2169public_list([(:- encoding(_))|Decls], Path,
2170 Module, Meta, MT, Export, Rest, Public, PT) :-
2171 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT).
2172
2173public_list_([], _, Meta, Meta, Export, Export, Public, Public).
2174public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :-
2175 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0),
2176 !,
2177 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT).
2178public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :-
2179 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT).
2180
2181public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :-
2182 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT).
2183public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :-
2184 public_from_import(Import, Spec, Path, Reexport, Rest).
2185public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :-
2186 phrase(meta_decls(Decl), Meta, MT).
2187public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :-
2188 phrase(public_decls(Decl), Public, PT).
2189
2193
2194reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !.
2195reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :-
2196 !,
2197 xref_source_file(H, Path, Src),
2198 public_list(Path, _Module, Meta0, Export0, Public0, []),
2199 append(Meta0, MT1, Meta),
2200 append(Export0, ET1, Export),
2201 append(Public0, PT1, Public),
2202 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT).
2203reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :-
2204 xref_source_file(Spec, Path, Src),
2205 public_list(Path, _Module, Meta0, Export0, Public0, []),
2206 append(Meta0, MT, Meta),
2207 append(Export0, ET, Export),
2208 append(Public0, PT, Public).
2209
2210public_from_import(except(Map), Path, Src, Export, Rest) :-
2211 !,
2212 xref_public_list(Path, _, AllExports, Src),
2213 except(Map, AllExports, NewExports),
2214 append(NewExports, Rest, Export).
2215public_from_import(Import, _, _, Export, Rest) :-
2216 import_name_map(Import, Export, Rest).
2217
2218
2220
2221except([], Exports, Exports).
2222except([PI0 as NewName|Map], Exports0, Exports) :-
2223 !,
2224 canonical_pi(PI0, PI),
2225 map_as(Exports0, PI, NewName, Exports1),
2226 except(Map, Exports1, Exports).
2227except([PI0|Map], Exports0, Exports) :-
2228 canonical_pi(PI0, PI),
2229 select(PI2, Exports0, Exports1),
2230 same_pi(PI, PI2),
2231 !,
2232 except(Map, Exports1, Exports).
2233
2234
2235map_as([PI|T], Repl, As, [PI2|T]) :-
2236 same_pi(Repl, PI),
2237 !,
2238 pi_as(PI, As, PI2).
2239map_as([H|T0], Repl, As, [H|T]) :-
2240 map_as(T0, Repl, As, T).
2241
2242pi_as(_/Arity, Name, Name/Arity).
2243pi_as(_//Arity, Name, Name//Arity).
2244
2245import_name_map([], L, L).
2246import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :-
2247 !,
2248 import_name_map(T0, T, Tail).
2249import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :-
2250 !,
2251 import_name_map(T0, T, Tail).
2252import_name_map([H|T0], [H|T], Tail) :-
2253 import_name_map(T0, T, Tail).
2254
2255canonical_pi(Name//Arity0, PI) :-
2256 integer(Arity0),
2257 !,
2258 PI = Name/Arity,
2259 Arity is Arity0 + 2.
2260canonical_pi(PI, PI).
2261
2262same_pi(Canonical, PI2) :-
2263 canonical_pi(PI2, Canonical).
2264
2265meta_decls(Var) -->
2266 { var(Var) },
2267 !.
2268meta_decls((A,B)) -->
2269 !,
2270 meta_decls(A),
2271 meta_decls(B).
2272meta_decls(A) -->
2273 [A].
2274
2275public_decls(Var) -->
2276 { var(Var) },
2277 !.
2278public_decls((A,B)) -->
2279 !,
2280 public_decls(A),
2281 public_decls(B).
2282public_decls(A) -->
2283 [A].
2284
2285 2288
2289process_include([], _) :- !.
2290process_include([H|T], Src) :-
2291 !,
2292 process_include(H, Src),
2293 process_include(T, Src).
2294process_include(File, Src) :-
2295 callable(File),
2296 !,
2297 ( once(xref_input(ParentSrc, _)),
2298 xref_source_file(File, Path, ParentSrc)
2299 -> ( ( uses_file(_, Src, Path)
2300 ; Path == Src
2301 )
2302 -> true
2303 ; assert(uses_file(File, Src, Path)),
2304 ( xoption(Src, process_include(true))
2305 -> findall(O, xoption(Src, O), Options),
2306 setup_call_cleanup(
2307 open_include_file(Path, In, Refs),
2308 collect(Src, Path, In, Options),
2309 close_include(In, Refs))
2310 ; true
2311 )
2312 )
2313 ; assert(uses_file(File, Src, '<not_found>'))
2314 ).
2315process_include(_, _).
2316
2322
2323open_include_file(Path, In, [Ref]) :-
2324 once(xref_input(_, Parent)),
2325 stream_property(Parent, encoding(Enc)),
2326 '$push_input_context'(xref_include),
2327 catch(( prolog:xref_open_source(Path, In)
2328 -> catch(set_stream(In, encoding(Enc)),
2329 error(_,_), true) 2330 ; include_encoding(Enc, Options),
2331 open(Path, read, In, Options)
2332 ), E,
2333 ( '$pop_input_context', throw(E))),
2334 catch(( peek_char(In, #) 2335 -> skip(In, 10)
2336 ; true
2337 ), E,
2338 ( close_include(In, []), throw(E))),
2339 asserta(xref_input(Path, In), Ref).
2340
2341include_encoding(wchar_t, []) :- !.
2342include_encoding(Enc, [encoding(Enc)]).
2343
2344
2345close_include(In, Refs) :-
2346 maplist(erase, Refs),
2347 close(In, [force(true)]),
2348 '$pop_input_context'.
2349
2353
2354process_foreign(Spec, Src) :-
2355 ground(Spec),
2356 current_foreign_library(Spec, Defined),
2357 !,
2358 ( xmodule(Module, Src)
2359 -> true
2360 ; Module = user
2361 ),
2362 process_foreign_defined(Defined, Module, Src).
2363process_foreign(_, _).
2364
2365process_foreign_defined([], _, _).
2366process_foreign_defined([H|T], M, Src) :-
2367 ( H = M:Head
2368 -> assert_foreign(Src, Head)
2369 ; assert_foreign(Src, H)
2370 ),
2371 process_foreign_defined(T, M, Src).
2372
2373
2374 2377
2387
2388process_chr(@(_Name, Rule), Src) :-
2389 mode(chr, Src),
2390 process_chr(Rule, Src).
2391process_chr(pragma(Rule, _Pragma), Src) :-
2392 mode(chr, Src),
2393 process_chr(Rule, Src).
2394process_chr(<=>(Head, Body), Src) :-
2395 mode(chr, Src),
2396 chr_head(Head, Src, H),
2397 chr_body(Body, H, Src).
2398process_chr(==>(Head, Body), Src) :-
2399 mode(chr, Src),
2400 chr_head(Head, H, Src),
2401 chr_body(Body, H, Src).
2402process_chr((:- chr_constraint(_)), Src) :-
2403 ( mode(chr, Src)
2404 -> true
2405 ; assert(mode(chr, Src))
2406 ).
2407
2408chr_head(X, _, _) :-
2409 var(X),
2410 !. 2411chr_head(\(A,B), Src, H) :-
2412 chr_head(A, Src, H),
2413 process_body(B, H, Src).
2414chr_head((H0,B), Src, H) :-
2415 chr_defined(H0, Src, H),
2416 process_body(B, H, Src).
2417chr_head(H0, Src, H) :-
2418 chr_defined(H0, Src, H).
2419
2420chr_defined(X, _, _) :-
2421 var(X),
2422 !.
2423chr_defined(#(C,_Id), Src, C) :-
2424 !,
2425 assert_constraint(Src, C).
2426chr_defined(A, Src, A) :-
2427 assert_constraint(Src, A).
2428
2429chr_body(X, From, Src) :-
2430 var(X),
2431 !,
2432 process_body(X, From, Src).
2433chr_body('|'(Guard, Goals), H, Src) :-
2434 !,
2435 chr_body(Guard, H, Src),
2436 chr_body(Goals, H, Src).
2437chr_body(G, From, Src) :-
2438 process_body(G, From, Src).
2439
2440assert_constraint(_, Head) :-
2441 var(Head),
2442 !.
2443assert_constraint(Src, Head) :-
2444 constraint(Head, Src, _),
2445 !.
2446assert_constraint(Src, Head) :-
2447 generalise_term(Head, Term),
2448 current_source_line(Line),
2449 assert(constraint(Term, Src, Line)).
2450
2451
2452 2455
2460
2461assert_called(_, _, Var, _) :-
2462 var(Var),
2463 !.
2464assert_called(Src, From, Goal, Line) :-
2465 var(From),
2466 !,
2467 assert_called(Src, '<unknown>', Goal, Line).
2468assert_called(_, _, Goal, _) :-
2469 expand_hide_called(Goal),
2470 !.
2471assert_called(Src, Origin, M:G, Line) :-
2472 !,
2473 ( atom(M),
2474 callable(G)
2475 -> current_condition(Cond),
2476 ( xmodule(M, Src) 2477 -> assert_called(Src, Origin, G, Line)
2478 ; called(M:G, Src, Origin, Cond, Line) 2479 -> true
2480 ; hide_called(M:G, Src) 2481 -> true
2482 ; generalise(Origin, OTerm),
2483 generalise(G, GTerm)
2484 -> assert(called(M:GTerm, Src, OTerm, Cond, Line))
2485 ; true
2486 )
2487 ; true 2488 ).
2489assert_called(Src, _, Goal, _) :-
2490 ( xmodule(M, Src)
2491 -> M \== system
2492 ; M = user
2493 ),
2494 hide_called(M:Goal, Src),
2495 !.
2496assert_called(Src, Origin, Goal, Line) :-
2497 current_condition(Cond),
2498 ( called(Goal, Src, Origin, Cond, Line)
2499 -> true
2500 ; generalise(Origin, OTerm),
2501 generalise(Goal, Term)
2502 -> assert(called(Term, Src, OTerm, Cond, Line))
2503 ; true
2504 ).
2505
2506
2511
2512expand_hide_called(pce_principal:send_implementation(_, _, _)).
2513expand_hide_called(pce_principal:get_implementation(_, _, _, _)).
2514expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)).
2515expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)).
2516
2517assert_defined(Src, Goal) :-
2518 Goal = test(_Test),
2519 current_test_unit(Unit, Line),
2520 assert_called(Src, '<test_unit>'(Unit), Goal, Line),
2521 fail.
2522assert_defined(Src, Goal) :-
2523 Goal = test(_Test, _Options),
2524 current_test_unit(Unit, Line),
2525 assert_called(Src, '<test_unit>'(Unit), Goal, Line),
2526 fail.
2527assert_defined(Src, Goal) :-
2528 defined(Goal, Src, _),
2529 !.
2530assert_defined(Src, Goal) :-
2531 generalise(Goal, Term),
2532 current_source_line(Line),
2533 assert(defined(Term, Src, Line)).
2534
2535assert_foreign(Src, Goal) :-
2536 foreign(Goal, Src, _),
2537 !.
2538assert_foreign(Src, Goal) :-
2539 generalise(Goal, Term),
2540 current_source_line(Line),
2541 assert(foreign(Term, Src, Line)).
2542
2543assert_grammar_rule(Src, Goal) :-
2544 grammar_rule(Goal, Src),
2545 !.
2546assert_grammar_rule(Src, Goal) :-
2547 generalise(Goal, Term),
2548 assert(grammar_rule(Term, Src)).
2549
2550
2560
2561assert_import(_, [], _, _, _) :- !.
2562assert_import(Src, [H|T], Export, From, Reexport) :-
2563 !,
2564 assert_import(Src, H, Export, From, Reexport),
2565 assert_import(Src, T, Export, From, Reexport).
2566assert_import(Src, except(Except), Export, From, Reexport) :-
2567 !,
2568 is_list(Export),
2569 !,
2570 except(Except, Export, Import),
2571 assert_import(Src, Import, _All, From, Reexport).
2572assert_import(Src, Import as Name, Export, From, Reexport) :-
2573 !,
2574 pi_to_head(Import, Term0),
2575 rename_goal(Term0, Name, Term),
2576 ( in_export_list(Term0, Export)
2577 -> assert(imported(Term, Src, From)),
2578 assert_reexport(Reexport, Src, Term)
2579 ; current_source_line(Line),
2580 assert_called(Src, '<directive>'(Line), Term0, Line)
2581 ).
2582assert_import(Src, Import, Export, From, Reexport) :-
2583 pi_to_head(Import, Term),
2584 !,
2585 ( in_export_list(Term, Export)
2586 -> assert(imported(Term, Src, From)),
2587 assert_reexport(Reexport, Src, Term)
2588 ; current_source_line(Line),
2589 assert_called(Src, '<directive>'(Line), Term, Line)
2590 ).
2591assert_import(Src, op(P,T,N), _, _, _) :-
2592 xref_push_op(Src, P,T,N).
2593
2594in_export_list(_Head, Export) :-
2595 var(Export),
2596 !.
2597in_export_list(Head, Export) :-
2598 member(PI, Export),
2599 pi_to_head(PI, Head).
2600
2601assert_reexport(false, _, _) :- !.
2602assert_reexport(true, Src, Term) :-
2603 assert(exported(Term, Src)).
2604
2608
2609process_import(M:PI, Src) :-
2610 pi_to_head(PI, Head),
2611 !,
2612 ( atom(M),
2613 current_module(M),
2614 module_property(M, file(From))
2615 -> true
2616 ; From = '<unknown>'
2617 ),
2618 assert(imported(Head, Src, From)).
2619process_import(_, _).
2620
2627
2628assert_xmodule_callable([], _, _, _).
2629assert_xmodule_callable([PI|T], M, Src, From) :-
2630 ( pi_to_head(M:PI, Head)
2631 -> assert(imported(Head, Src, From))
2632 ; true
2633 ),
2634 assert_xmodule_callable(T, M, Src, From).
2635
2636
2640
2641assert_op(Src, op(P,T,M:N)) :-
2642 ( '$current_source_module'(M)
2643 -> Name = N
2644 ; Name = M:N
2645 ),
2646 ( xop(Src, op(P,T,Name))
2647 -> true
2648 ; assert(xop(Src, op(P,T,Name)))
2649 ).
2650
2655
2656assert_module(Src, Module) :-
2657 xmodule(Module, Src),
2658 !.
2659assert_module(Src, Module) :-
2660 '$set_source_module'(Module),
2661 assert(xmodule(Module, Src)),
2662 ( module_property(Module, class(system))
2663 -> retractall(xoption(Src, register_called(_))),
2664 assert(xoption(Src, register_called(all)))
2665 ; true
2666 ).
2667
2668assert_module_export(_, []) :- !.
2669assert_module_export(Src, [H|T]) :-
2670 !,
2671 assert_module_export(Src, H),
2672 assert_module_export(Src, T).
2673assert_module_export(Src, PI) :-
2674 pi_to_head(PI, Term),
2675 !,
2676 assert(exported(Term, Src)).
2677assert_module_export(Src, op(P, A, N)) :-
2678 xref_push_op(Src, P, A, N).
2679
2683
2684assert_module3([], _) :- !.
2685assert_module3([H|T], Src) :-
2686 !,
2687 assert_module3(H, Src),
2688 assert_module3(T, Src).
2689assert_module3(Option, Src) :-
2690 process_use_module(library(dialect/Option), Src, false).
2691
2692
2698
2699process_predicates(Closure, Preds, Src) :-
2700 is_list(Preds),
2701 !,
2702 process_predicate_list(Preds, Closure, Src).
2703process_predicates(Closure, as(Preds, _Options), Src) :-
2704 !,
2705 process_predicates(Closure, Preds, Src).
2706process_predicates(Closure, Preds, Src) :-
2707 process_predicate_comma(Preds, Closure, Src).
2708
2709process_predicate_list([], _, _).
2710process_predicate_list([H|T], Closure, Src) :-
2711 ( nonvar(H)
2712 -> call(Closure, H, Src)
2713 ; true
2714 ),
2715 process_predicate_list(T, Closure, Src).
2716
2717process_predicate_comma(Var, _, _) :-
2718 var(Var),
2719 !.
2720process_predicate_comma(M:(A,B), Closure, Src) :-
2721 !,
2722 process_predicate_comma(M:A, Closure, Src),
2723 process_predicate_comma(M:B, Closure, Src).
2724process_predicate_comma((A,B), Closure, Src) :-
2725 !,
2726 process_predicate_comma(A, Closure, Src),
2727 process_predicate_comma(B, Closure, Src).
2728process_predicate_comma(as(Spec, _Options), Closure, Src) :-
2729 !,
2730 process_predicate_comma(Spec, Closure, Src).
2731process_predicate_comma(A, Closure, Src) :-
2732 call(Closure, A, Src).
2733
2734
2735assert_dynamic(PI, Src) :-
2736 pi_to_head(PI, Term),
2737 ( thread_local(Term, Src, _) 2738 -> true 2739 ; current_source_line(Line),
2740 assert(dynamic(Term, Src, Line))
2741 ).
2742
2743assert_thread_local(PI, Src) :-
2744 pi_to_head(PI, Term),
2745 current_source_line(Line),
2746 assert(thread_local(Term, Src, Line)).
2747
2748assert_multifile(PI, Src) :- 2749 pi_to_head(PI, Term),
2750 current_source_line(Line),
2751 assert(multifile(Term, Src, Line)).
2752
2753assert_public(PI, Src) :- 2754 pi_to_head(PI, Term),
2755 current_source_line(Line),
2756 assert_called(Src, '<public>'(Line), Term, Line),
2757 assert(public(Term, Src, Line)).
2758
2759assert_export(PI, Src) :- 2760 pi_to_head(PI, Term),
2761 !,
2762 assert(exported(Term, Src)).
2763
2768
2769pi_to_head(Var, _) :-
2770 var(Var), !, fail.
2771pi_to_head(M:PI, M:Term) :-
2772 !,
2773 pi_to_head(PI, Term).
2774pi_to_head(Name/Arity, Term) :-
2775 functor(Term, Name, Arity).
2776pi_to_head(Name//DCGArity, Term) :-
2777 Arity is DCGArity+2,
2778 functor(Term, Name, Arity).
2779
2780
2781assert_used_class(Src, Name) :-
2782 used_class(Name, Src),
2783 !.
2784assert_used_class(Src, Name) :-
2785 assert(used_class(Name, Src)).
2786
2787assert_defined_class(Src, Name, _Meta, _Super, _) :-
2788 defined_class(Name, _, _, Src, _),
2789 !.
2790assert_defined_class(_, _, _, -, _) :- !. 2791assert_defined_class(Src, Name, Meta, Super, Summary) :-
2792 current_source_line(Line),
2793 ( Summary == @(default)
2794 -> Atom = ''
2795 ; is_list(Summary)
2796 -> atom_codes(Atom, Summary)
2797 ; string(Summary)
2798 -> atom_concat(Summary, '', Atom)
2799 ),
2800 assert(defined_class(Name, Super, Atom, Src, Line)),
2801 ( Meta = @(_)
2802 -> true
2803 ; assert_used_class(Src, Meta)
2804 ),
2805 assert_used_class(Src, Super).
2806
2807assert_defined_class(Src, Name, imported_from(_File)) :-
2808 defined_class(Name, _, _, Src, _),
2809 !.
2810assert_defined_class(Src, Name, imported_from(File)) :-
2811 assert(defined_class(Name, _, '', Src, file(File))).
2812
2813
2814 2817
2821
2822generalise(Var, Var) :-
2823 var(Var),
2824 !. 2825generalise(pce_principal:send_implementation(Id, _, _),
2826 pce_principal:send_implementation(Id, _, _)) :-
2827 atom(Id),
2828 !.
2829generalise(pce_principal:get_implementation(Id, _, _, _),
2830 pce_principal:get_implementation(Id, _, _, _)) :-
2831 atom(Id),
2832 !.
2833generalise('<directive>'(Line), '<directive>'(Line)) :- !.
2834generalise(test(Test), test(Test)) :-
2835 current_test_unit(_,_),
2836 ground(Test),
2837 !.
2838generalise(test(Test, _), test(Test, _)) :-
2839 current_test_unit(_,_),
2840 ground(Test),
2841 !.
2842generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !.
2843generalise(Module:Goal0, Module:Goal) :-
2844 atom(Module),
2845 !,
2846 generalise(Goal0, Goal).
2847generalise(Term0, Term) :-
2848 callable(Term0),
2849 generalise_term(Term0, Term).
2850
2851
2852 2855
2863
2864:- multifile
2865 prolog:xref_source_directory/2, 2866 prolog:xref_source_file/3. 2867
2868
2873
2874xref_source_file(Plain, File, Source) :-
2875 xref_source_file(Plain, File, Source, []).
2876
2877xref_source_file(QSpec, File, Source, Options) :-
2878 nonvar(QSpec), QSpec = _:Spec,
2879 !,
2880 must_be(acyclic, Spec),
2881 xref_source_file(Spec, File, Source, Options).
2882xref_source_file(Spec, File, Source, Options) :-
2883 nonvar(Spec),
2884 prolog:xref_source_file(Spec, File,
2885 [ relative_to(Source)
2886 | Options
2887 ]),
2888 !.
2889xref_source_file(Plain, File, Source, Options) :-
2890 atom(Plain),
2891 \+ is_absolute_file_name(Plain),
2892 ( prolog:xref_source_directory(Source, Dir)
2893 -> true
2894 ; atom(Source),
2895 file_directory_name(Source, Dir)
2896 ),
2897 atomic_list_concat([Dir, /, Plain], Spec0),
2898 absolute_file_name(Spec0, Spec),
2899 do_xref_source_file(Spec, File, Options),
2900 !.
2901xref_source_file(Spec, File, Source, Options) :-
2902 do_xref_source_file(Spec, File,
2903 [ relative_to(Source)
2904 | Options
2905 ]),
2906 !.
2907xref_source_file(_, _, _, Options) :-
2908 option(silent(true), Options),
2909 !,
2910 fail.
2911xref_source_file(Spec, _, Src, _Options) :-
2912 verbose(Src),
2913 print_message(warning, error(existence_error(file, Spec), _)),
2914 fail.
2915
2916do_xref_source_file(Spec, File, Options) :-
2917 nonvar(Spec),
2918 option(file_type(Type), Options, prolog),
2919 absolute_file_name(Spec, File,
2920 [ file_type(Type),
2921 access(read),
2922 file_errors(fail)
2923 ]),
2924 !.
2925
2929
2930canonical_source(Source, Src) :-
2931 ( ground(Source)
2932 -> prolog_canonical_source(Source, Src)
2933 ; Source = Src
2934 ).
2935
2940
2941goal_name_arity(Goal, Name, Arity) :-
2942 ( compound(Goal)
2943 -> compound_name_arity(Goal, Name, Arity)
2944 ; atom(Goal)
2945 -> Name = Goal, Arity = 0
2946 ).
2947
2948generalise_term(Specific, General) :-
2949 ( compound(Specific)
2950 -> compound_name_arity(Specific, Name, Arity),
2951 compound_name_arity(General, Name, Arity)
2952 ; General = Specific
2953 ).
2954
2955functor_name(Term, Name) :-
2956 ( compound(Term)
2957 -> compound_name_arity(Term, Name, _)
2958 ; atom(Term)
2959 -> Name = Term
2960 ).
2961
2962rename_goal(Goal0, Name, Goal) :-
2963 ( compound(Goal0)
2964 -> compound_name_arity(Goal0, _, Arity),
2965 compound_name_arity(Goal, Name, Arity)
2966 ; Goal = Name
2967 )