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:- use_module(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
428:- meta_predicate
429 with_xref(0). 430
431with_xref(Goal) :-
432 current_prolog_flag(xref, Xref),
433 ( Xref == true
434 -> call(Goal)
435 ; setup_call_cleanup(
436 set_prolog_flag(xref, true),
437 Goal,
438 set_prolog_flag(xref, Xref))
439 ).
440
441
448
449set_initial_mode(_Stream, Options) :-
450 option(module(Module), Options),
451 !,
452 '$set_source_module'(Module).
453set_initial_mode(Stream, _) :-
454 stream_property(Stream, file_name(Path)),
455 source_file_property(Path, load_context(M, _, Opts)),
456 !,
457 '$set_source_module'(M),
458 ( option(dialect(Dialect), Opts)
459 -> expects_dialect(Dialect)
460 ; true
461 ).
462set_initial_mode(_, _) :-
463 '$set_source_module'(user).
464
468
469xref_input_stream(Stream) :-
470 xref_input(_, Var),
471 !,
472 Stream = Var.
473
478
479xref_push_op(Src, P, T, N0) :-
480 '$current_source_module'(M0),
481 strip_module(M0:N0, M, N),
482 ( is_list(N),
483 N \== []
484 -> maplist(push_op(Src, P, T, M), N)
485 ; push_op(Src, P, T, M, N)
486 ).
487
488push_op(Src, P, T, M0, N0) :-
489 strip_module(M0:N0, M, N),
490 Name = M:N,
491 valid_op(op(P,T,Name)),
492 push_op(P, T, Name),
493 assert_op(Src, op(P,T,Name)),
494 debug(xref(op), ':- ~w.', [op(P,T,Name)]).
495
496valid_op(op(P,T,M:N)) :-
497 atom(M),
498 valid_op_name(N),
499 integer(P),
500 between(0, 1200, P),
501 atom(T),
502 op_type(T).
503
504valid_op_name(N) :-
505 atom(N),
506 !.
507valid_op_name(N) :-
508 N == [].
509
510op_type(xf).
511op_type(yf).
512op_type(fx).
513op_type(fy).
514op_type(xfx).
515op_type(xfy).
516op_type(yfx).
517
521
522xref_set_prolog_flag(Flag, Value, Src, Line) :-
523 atom(Flag),
524 !,
525 assertz(xflag(Flag, Value, Src, Line)).
526xref_set_prolog_flag(_, _, _, _).
527
531
532xref_clean(Source) :-
533 prolog_canonical_source(Source, Src),
534 retractall(called(_, Src, _Origin, _Cond, _Line)),
535 retractall(dynamic(_, Src, Line)),
536 retractall(multifile(_, Src, Line)),
537 retractall(public(_, Src, Line)),
538 retractall(defined(_, Src, Line)),
539 retractall(meta_goal(_, _, Src)),
540 retractall(foreign(_, Src, Line)),
541 retractall(constraint(_, Src, Line)),
542 retractall(imported(_, Src, _From)),
543 retractall(exported(_, Src)),
544 retractall(uses_file(_, Src, _)),
545 retractall(xmodule(_, Src)),
546 retractall(xop(Src, _)),
547 retractall(grammar_rule(_, Src)),
548 retractall(xoption(Src, _)),
549 retractall(xflag(_Name, _Value, Src, Line)),
550 retractall(source(Src, _)),
551 retractall(used_class(_, Src)),
552 retractall(defined_class(_, _, _, Src, _)),
553 retractall(mode(_, Src)),
554 retractall(module_comment(Src, _, _)),
555 retractall(pred_comment(_, Src, _, _)),
556 retractall(pred_comment_link(_, Src, _)),
557 retractall(pred_mode(_, Src, _)).
558
559
560 563
567
568xref_current_source(Source) :-
569 source(Source, _Time).
570
571
575
576xref_done(Source, Time) :-
577 prolog_canonical_source(Source, Src),
578 source(Src, Time).
579
580
599
600xref_called(Source, Called, By) :-
601 xref_called(Source, Called, By, _).
602
603xref_called(Source, Called, By, Cond) :-
604 canonical_source(Source, Src),
605 distinct(Called-By, called(Called, Src, By, Cond, _)).
606
607xref_called(Source, Called, By, Cond, Line) :-
608 canonical_source(Source, Src),
609 called(Called, Src, By, Cond, Line).
610
630
631xref_defined(Source, Called, How) :-
632 nonvar(Source),
633 !,
634 canonical_source(Source, Src),
635 xref_defined2(How, Src, Called).
636xref_defined(Source, Called, How) :-
637 xref_defined2(How, Src, Called),
638 canonical_source(Source, Src).
639
640xref_defined2(dynamic(Line), Src, Called) :-
641 dynamic(Called, Src, Line).
642xref_defined2(thread_local(Line), Src, Called) :-
643 thread_local(Called, Src, Line).
644xref_defined2(multifile(Line), Src, Called) :-
645 multifile(Called, Src, Line).
646xref_defined2(public(Line), Src, Called) :-
647 public(Called, Src, Line).
648xref_defined2(local(Line), Src, Called) :-
649 defined(Called, Src, Line).
650xref_defined2(foreign(Line), Src, Called) :-
651 foreign(Called, Src, Line).
652xref_defined2(constraint(Line), Src, Called) :-
653 constraint(Called, Src, Line).
654xref_defined2(imported(From), Src, Called) :-
655 imported(Called, Src, From).
656xref_defined2(dcg, Src, Called) :-
657 grammar_rule(Called, Src).
658
659
664
665xref_definition_line(local(Line), Line).
666xref_definition_line(dynamic(Line), Line).
667xref_definition_line(thread_local(Line), Line).
668xref_definition_line(multifile(Line), Line).
669xref_definition_line(public(Line), Line).
670xref_definition_line(constraint(Line), Line).
671xref_definition_line(foreign(Line), Line).
672
673
677
678xref_exported(Source, Called) :-
679 prolog_canonical_source(Source, Src),
680 exported(Called, Src).
681
685
686xref_module(Source, Module) :-
687 nonvar(Source),
688 !,
689 prolog_canonical_source(Source, Src),
690 xmodule(Module, Src).
691xref_module(Source, Module) :-
692 xmodule(Module, Src),
693 prolog_canonical_source(Source, Src).
694
702
703xref_uses_file(Source, Spec, Path) :-
704 prolog_canonical_source(Source, Src),
705 uses_file(Spec, Src, Path).
706
714
715xref_op(Source, Op) :-
716 prolog_canonical_source(Source, Src),
717 xop(Src, Op).
718
724
725xref_prolog_flag(Source, Flag, Value, Line) :-
726 prolog_canonical_source(Source, Src),
727 xflag(Flag, Value, Src, Line).
728
729xref_built_in(Head) :-
730 system_predicate(Head).
731
732xref_used_class(Source, Class) :-
733 prolog_canonical_source(Source, Src),
734 used_class(Class, Src).
735
736xref_defined_class(Source, Class, local(Line, Super, Summary)) :-
737 prolog_canonical_source(Source, Src),
738 defined_class(Class, Super, Summary, Src, Line),
739 integer(Line),
740 !.
741xref_defined_class(Source, Class, file(File)) :-
742 prolog_canonical_source(Source, Src),
743 defined_class(Class, _, _, Src, file(File)).
744
745:- thread_local
746 current_cond/1,
747 source_line/1,
748 current_test_unit/2. 749
750current_source_line(Line) :-
751 source_line(Var),
752 !,
753 Line = Var.
754
760
761collect(Src, File, In, Options) :-
762 ( Src == File
763 -> SrcSpec = Line
764 ; SrcSpec = (File:Line)
765 ),
766 option(comments(CommentHandling), Options, collect),
767 ( CommentHandling == ignore
768 -> CommentOptions = [],
769 Comments = []
770 ; CommentHandling == store
771 -> CommentOptions = [ process_comment(true) ],
772 Comments = [],
773 set_prolog_flag(xref_store_comments, true)
774 ; CommentOptions = [ comments(Comments) ]
775 ),
776 repeat,
777 catch(prolog_read_source_term(
778 In, Term, Expanded,
779 [ term_position(TermPos)
780 | CommentOptions
781 ]),
782 E, report_syntax_error(E, Src, [])),
783 update_condition(Term),
784 stream_position_data(line_count, TermPos, Line),
785 setup_call_cleanup(
786 asserta(source_line(SrcSpec), Ref),
787 catch(process(Expanded, Comments, Term, TermPos, Src, EOF),
788 E, print_message(error, E)),
789 erase(Ref)),
790 EOF == true,
791 !,
792 set_prolog_flag(xref_store_comments, false).
793
794report_syntax_error(E, _, _) :-
795 fatal_error(E),
796 throw(E).
797report_syntax_error(_, _, Options) :-
798 option(silent(true), Options),
799 !,
800 fail.
801report_syntax_error(E, Src, _Options) :-
802 ( verbose(Src)
803 -> print_message(error, E)
804 ; true
805 ),
806 fail.
807
808fatal_error(time_limit_exceeded).
809fatal_error(error(resource_error(_),_)).
810
814
815update_condition((:-Directive)) :-
816 !,
817 update_cond(Directive).
818update_condition(_).
819
820update_cond(if(Cond)) :-
821 !,
822 asserta(current_cond(Cond)).
823update_cond(else) :-
824 retract(current_cond(C0)),
825 !,
826 assert(current_cond(\+C0)).
827update_cond(elif(Cond)) :-
828 retract(current_cond(C0)),
829 !,
830 assert(current_cond((\+C0,Cond))).
831update_cond(endif) :-
832 retract(current_cond(_)),
833 !.
834update_cond(_).
835
840
841current_condition(Condition) :-
842 \+ current_cond(_),
843 !,
844 Condition = true.
845current_condition(Condition) :-
846 findall(C, current_cond(C), List),
847 list_to_conj(List, Condition).
848
849list_to_conj([], true).
850list_to_conj([C], C) :- !.
851list_to_conj([H|T], (H,C)) :-
852 list_to_conj(T, C).
853
854
855 858
868
869process(Expanded, Comments, Term0, TermPos, Src, EOF) :-
870 is_list(Expanded), 871 !,
872 ( member(Term, Expanded),
873 process(Term, Term0, Src),
874 Term == end_of_file
875 -> EOF = true
876 ; EOF = false
877 ),
878 xref_comments(Comments, TermPos, Src).
879process(end_of_file, _, _, _, _, true) :-
880 !.
881process(Term, Comments, Term0, TermPos, Src, false) :-
882 process(Term, Term0, Src),
883 xref_comments(Comments, TermPos, Src).
884
886
887process(_, Term0, _) :-
888 ignore_raw_term(Term0),
889 !.
890process(Head :- Body, Head0 --> _, Src) :-
891 pi_head(F/A, Head),
892 pi_head(F/A0, Head0),
893 A =:= A0 + 2,
894 !,
895 assert_grammar_rule(Src, Head),
896 process((Head :- Body), Src).
897process(Term, _Term0, Src) :-
898 process(Term, Src).
899
900ignore_raw_term((:- predicate_options(_,_,_))).
901
903
904process(Var, _) :-
905 var(Var),
906 !. 907process(end_of_file, _) :- !.
908process((:- Directive), Src) :-
909 !,
910 process_directive(Directive, Src),
911 !.
912process((?- Directive), Src) :-
913 !,
914 process_directive(Directive, Src),
915 !.
916process((Head :- Body), Src) :-
917 !,
918 assert_defined(Src, Head),
919 process_body(Body, Head, Src).
920process((Left => Body), Src) :-
921 !,
922 ( nonvar(Left),
923 Left = (Head, Guard)
924 -> assert_defined(Src, Head),
925 process_body(Guard, Head, Src),
926 process_body(Body, Head, Src)
927 ; assert_defined(Src, Left),
928 process_body(Body, Left, Src)
929 ).
930process(?=>(Head, Body), Src) :-
931 !,
932 assert_defined(Src, Head),
933 process_body(Body, Head, Src).
934process('$source_location'(_File, _Line):Clause, Src) :-
935 !,
936 process(Clause, Src).
937process(Term, Src) :-
938 process_chr(Term, Src),
939 !.
940process(M:(Head :- Body), Src) :-
941 !,
942 process((M:Head :- M:Body), Src).
943process(Head, Src) :-
944 assert_defined(Src, Head).
945
946
947 950
952
([], _Pos, _Src).
954:- if(current_predicate(parse_comment/3)). 955xref_comments([Pos-Comment|T], TermPos, Src) :-
956 ( Pos @> TermPos 957 -> true
958 ; stream_position_data(line_count, Pos, Line),
959 FilePos = Src:Line,
960 ( parse_comment(Comment, FilePos, Parsed)
961 -> assert_comments(Parsed, Src)
962 ; true
963 ),
964 xref_comments(T, TermPos, Src)
965 ).
966
([], _).
968assert_comments([H|T], Src) :-
969 assert_comment(H, Src),
970 assert_comments(T, Src).
971
(section(_Id, Title, Comment), Src) :-
973 assertz(module_comment(Src, Title, Comment)).
974assert_comment(predicate(PI, Summary, Comment), Src) :-
975 pi_to_head(PI, Src, Head),
976 assertz(pred_comment(Head, Src, Summary, Comment)).
977assert_comment(link(PI, PITo), Src) :-
978 pi_to_head(PI, Src, Head),
979 pi_to_head(PITo, Src, HeadTo),
980 assertz(pred_comment_link(Head, Src, HeadTo)).
981assert_comment(mode(Head, Det), Src) :-
982 assertz(pred_mode(Head, Src, Det)).
983
984pi_to_head(PI, Src, Head) :-
985 pi_to_head(PI, Head0),
986 ( Head0 = _:_
987 -> strip_module(Head0, M, Plain),
988 ( xmodule(M, Src)
989 -> Head = Plain
990 ; Head = M:Plain
991 )
992 ; Head = Head0
993 ).
994:- endif. 995
999
(Source, Title, Comment) :-
1001 canonical_source(Source, Src),
1002 module_comment(Src, Title, Comment).
1003
1007
(Source, Head, Summary, Comment) :-
1009 canonical_source(Source, Src),
1010 ( pred_comment(Head, Src, Summary, Comment)
1011 ; pred_comment_link(Head, Src, HeadTo),
1012 pred_comment(HeadTo, Src, Summary, Comment)
1013 ).
1014
1019
1020xref_mode(Source, Mode, Det) :-
1021 canonical_source(Source, Src),
1022 pred_mode(Mode, Src, Det).
1023
1028
1029xref_option(Source, Option) :-
1030 canonical_source(Source, Src),
1031 xoption(Src, Option).
1032
1033
1034 1037
1038process_directive(Var, _) :-
1039 var(Var),
1040 !. 1041process_directive(Dir, _Src) :-
1042 debug(xref(directive), 'Processing :- ~q', [Dir]),
1043 fail.
1044process_directive((A,B), Src) :- 1045 !,
1046 process_directive(A, Src), 1047 process_directive(B, Src).
1048process_directive(List, Src) :-
1049 is_list(List),
1050 !,
1051 process_directive(consult(List), Src).
1052process_directive(use_module(File, Import), Src) :-
1053 process_use_module2(File, Import, Src, false).
1054process_directive(autoload(File, Import), Src) :-
1055 process_use_module2(File, Import, Src, false).
1056process_directive(require(Import), Src) :-
1057 process_requires(Import, Src).
1058process_directive(expects_dialect(Dialect), Src) :-
1059 process_directive(use_module(library(dialect/Dialect)), Src),
1060 expects_dialect(Dialect).
1061process_directive(reexport(File, Import), Src) :-
1062 process_use_module2(File, Import, Src, true).
1063process_directive(reexport(Modules), Src) :-
1064 process_use_module(Modules, Src, true).
1065process_directive(autoload(Modules), Src) :-
1066 process_use_module(Modules, Src, false).
1067process_directive(use_module(Modules), Src) :-
1068 process_use_module(Modules, Src, false).
1069process_directive(consult(Modules), Src) :-
1070 process_use_module(Modules, Src, false).
1071process_directive(ensure_loaded(Modules), Src) :-
1072 process_use_module(Modules, Src, false).
1073process_directive(load_files(Files, _Options), Src) :-
1074 process_use_module(Files, Src, false).
1075process_directive(include(Files), Src) :-
1076 process_include(Files, Src).
1077process_directive(dynamic(Dynamic), Src) :-
1078 process_predicates(assert_dynamic, Dynamic, Src).
1079process_directive(dynamic(Dynamic, _Options), Src) :-
1080 process_predicates(assert_dynamic, Dynamic, Src).
1081process_directive(thread_local(Dynamic), Src) :-
1082 process_predicates(assert_thread_local, Dynamic, Src).
1083process_directive(multifile(Dynamic), Src) :-
1084 process_predicates(assert_multifile, Dynamic, Src).
1085process_directive(public(Public), Src) :-
1086 process_predicates(assert_public, Public, Src).
1087process_directive(export(Export), Src) :-
1088 process_predicates(assert_export, Export, Src).
1089process_directive(import(Import), Src) :-
1090 process_import(Import, Src).
1091process_directive(module(Module, Export), Src) :-
1092 assert_module(Src, Module),
1093 assert_module_export(Src, Export).
1094process_directive(module(Module, Export, Import), Src) :-
1095 assert_module(Src, Module),
1096 assert_module_export(Src, Export),
1097 assert_module3(Import, Src).
1098process_directive(begin_tests(Unit, _Options), Src) :-
1099 enter_test_unit(Unit, Src).
1100process_directive(begin_tests(Unit), Src) :-
1101 enter_test_unit(Unit, Src).
1102process_directive(end_tests(Unit), Src) :-
1103 leave_test_unit(Unit, Src).
1104process_directive('$set_source_module'(system), Src) :-
1105 assert_module(Src, system). 1106process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :-
1107 assert_defined_class(Src, Name, Meta, Super, Doc).
1108process_directive(pce_autoload(Name, From), Src) :-
1109 assert_defined_class(Src, Name, imported_from(From)).
1110
1111process_directive(op(P, A, N), Src) :-
1112 xref_push_op(Src, P, A, N).
1113process_directive(set_prolog_flag(Flag, Value), Src) :-
1114 ( Flag == character_escapes
1115 -> set_prolog_flag(character_escapes, Value)
1116 ; true
1117 ),
1118 current_source_line(Line),
1119 xref_set_prolog_flag(Flag, Value, Src, Line).
1120process_directive(style_check(X), _) :-
1121 style_check(X).
1122process_directive(encoding(Enc), _) :-
1123 ( xref_input_stream(Stream)
1124 -> catch(set_stream(Stream, encoding(Enc)), _, true)
1125 ; true 1126 ).
1127process_directive(pce_expansion:push_compile_operators, _) :-
1128 '$current_source_module'(SM),
1129 call(pce_expansion:push_compile_operators(SM)). 1130process_directive(pce_expansion:pop_compile_operators, _) :-
1131 call(pce_expansion:pop_compile_operators).
1132process_directive(meta_predicate(Meta), Src) :-
1133 process_meta_predicate(Meta, Src).
1134process_directive(arithmetic_function(FSpec), Src) :-
1135 arith_callable(FSpec, Goal),
1136 !,
1137 current_source_line(Line),
1138 assert_called(Src, '<directive>'(Line), Goal, Line).
1139process_directive(format_predicate(_, Goal), Src) :-
1140 !,
1141 current_source_line(Line),
1142 assert_called(Src, '<directive>'(Line), Goal, Line).
1143process_directive(if(Cond), Src) :-
1144 !,
1145 current_source_line(Line),
1146 assert_called(Src, '<directive>'(Line), Cond, Line).
1147process_directive(elif(Cond), Src) :-
1148 !,
1149 current_source_line(Line),
1150 assert_called(Src, '<directive>'(Line), Cond, Line).
1151process_directive(else, _) :- !.
1152process_directive(endif, _) :- !.
1153process_directive(Goal, Src) :-
1154 current_source_line(Line),
1155 process_body(Goal, '<directive>'(Line), Src).
1156
1160
1161process_meta_predicate((A,B), Src) :-
1162 !,
1163 process_meta_predicate(A, Src),
1164 process_meta_predicate(B, Src).
1165process_meta_predicate(Decl, Src) :-
1166 process_meta_head(Src, Decl).
1167
1168process_meta_head(Src, Decl) :- 1169 compound(Decl),
1170 compound_name_arity(Decl, Name, Arity),
1171 compound_name_arity(Head, Name, Arity),
1172 meta_args(1, Arity, Decl, Head, Meta),
1173 ( ( prolog:meta_goal(Head, _)
1174 ; prolog:called_by(Head, _, _, _)
1175 ; prolog:called_by(Head, _)
1176 ; meta_goal(Head, _)
1177 )
1178 -> true
1179 ; assert(meta_goal(Head, Meta, Src))
1180 ).
1181
1182meta_args(I, Arity, _, _, []) :-
1183 I > Arity,
1184 !.
1185meta_args(I, Arity, Decl, Head, [H|T]) :- 1186 arg(I, Decl, 0),
1187 !,
1188 arg(I, Head, H),
1189 I2 is I + 1,
1190 meta_args(I2, Arity, Decl, Head, T).
1191meta_args(I, Arity, Decl, Head, [H|T]) :- 1192 arg(I, Decl, ^),
1193 !,
1194 arg(I, Head, EH),
1195 setof_goal(EH, H),
1196 I2 is I + 1,
1197 meta_args(I2, Arity, Decl, Head, T).
1198meta_args(I, Arity, Decl, Head, [//(H)|T]) :-
1199 arg(I, Decl, //),
1200 !,
1201 arg(I, Head, H),
1202 I2 is I + 1,
1203 meta_args(I2, Arity, Decl, Head, T).
1204meta_args(I, Arity, Decl, Head, [H+A|T]) :- 1205 arg(I, Decl, A),
1206 integer(A), A > 0,
1207 !,
1208 arg(I, Head, H),
1209 I2 is I + 1,
1210 meta_args(I2, Arity, Decl, Head, T).
1211meta_args(I, Arity, Decl, Head, Meta) :-
1212 I2 is I + 1,
1213 meta_args(I2, Arity, Decl, Head, Meta).
1214
1215
1216 1219
1226
1227xref_meta(Source, Head, Called) :-
1228 canonical_source(Source, Src),
1229 xref_meta_src(Head, Called, Src).
1230
1243
1244xref_meta_src(Head, Called, Src) :-
1245 meta_goal(Head, Called, Src),
1246 !.
1247xref_meta_src(Head, Called, _) :-
1248 xref_meta(Head, Called),
1249 !.
1250xref_meta_src(Head, Called, _) :-
1251 compound(Head),
1252 compound_name_arity(Head, Name, Arity),
1253 apply_pred(Name),
1254 Arity > 5,
1255 !,
1256 Extra is Arity - 1,
1257 arg(1, Head, G),
1258 Called = [G+Extra].
1259xref_meta_src(Head, Called, _) :-
1260 with_xref(predicate_property('$xref_tmp':Head, meta_predicate(Meta))),
1261 !,
1262 Meta =.. [_|Args],
1263 meta_args(Args, 1, Head, Called).
1264
1265meta_args([], _, _, []).
1266meta_args([H0|T0], I, Head, [H|T]) :-
1267 xargs(H0, N),
1268 !,
1269 arg(I, Head, A),
1270 ( N == 0
1271 -> H = A
1272 ; H = (A+N)
1273 ),
1274 I2 is I+1,
1275 meta_args(T0, I2, Head, T).
1276meta_args([_|T0], I, Head, T) :-
1277 I2 is I+1,
1278 meta_args(T0, I2, Head, T).
1279
1280xargs(N, N) :- integer(N), !.
1281xargs(//, 2).
1282xargs(^, 0).
1283
1284apply_pred(call). 1285apply_pred(maplist). 1286
1287xref_meta((A, B), [A, B]).
1288xref_meta((A; B), [A, B]).
1289xref_meta((A| B), [A, B]).
1290xref_meta((A -> B), [A, B]).
1291xref_meta((A *-> B), [A, B]).
1292xref_meta(findall(_V,G,_L), [G]).
1293xref_meta(findall(_V,G,_L,_T), [G]).
1294xref_meta(findnsols(_N,_V,G,_L), [G]).
1295xref_meta(findnsols(_N,_V,G,_L,_T), [G]).
1296xref_meta(setof(_V, EG, _L), [G]) :-
1297 setof_goal(EG, G).
1298xref_meta(bagof(_V, EG, _L), [G]) :-
1299 setof_goal(EG, G).
1300xref_meta(forall(A, B), [A, B]).
1301xref_meta(maplist(G,_), [G+1]).
1302xref_meta(maplist(G,_,_), [G+2]).
1303xref_meta(maplist(G,_,_,_), [G+3]).
1304xref_meta(maplist(G,_,_,_,_), [G+4]).
1305xref_meta(map_list_to_pairs(G,_,_), [G+2]).
1306xref_meta(map_assoc(G, _), [G+1]).
1307xref_meta(map_assoc(G, _, _), [G+2]).
1308xref_meta(checklist(G, _L), [G+1]).
1309xref_meta(sublist(G, _, _), [G+1]).
1310xref_meta(include(G, _, _), [G+1]).
1311xref_meta(exclude(G, _, _), [G+1]).
1312xref_meta(partition(G, _, _, _, _), [G+2]).
1313xref_meta(partition(G, _, _, _),[G+1]).
1314xref_meta(call(G), [G]).
1315xref_meta(call(G, _), [G+1]).
1316xref_meta(call(G, _, _), [G+2]).
1317xref_meta(call(G, _, _, _), [G+3]).
1318xref_meta(call(G, _, _, _, _), [G+4]).
1319xref_meta(not(G), [G]).
1320xref_meta(notrace(G), [G]).
1321xref_meta('$notrace'(G), [G]).
1322xref_meta(\+(G), [G]).
1323xref_meta(ignore(G), [G]).
1324xref_meta(once(G), [G]).
1325xref_meta(initialization(G), [G]).
1326xref_meta(initialization(G,_), [G]).
1327xref_meta(retract(Rule), [G]) :- head_of(Rule, G).
1328xref_meta(clause(G, _), [G]).
1329xref_meta(clause(G, _, _), [G]).
1330xref_meta(phrase(G, _A), [//(G)]).
1331xref_meta(phrase(G, _A, _R), [//(G)]).
1332xref_meta(call_dcg(G, _A, _R), [//(G)]).
1333xref_meta(phrase_from_file(G,_),[//(G)]).
1334xref_meta(catch(A, _, B), [A, B]).
1335xref_meta(catch_with_backtrace(A, _, B), [A, B]).
1336xref_meta(thread_create(A,_,_), [A]).
1337xref_meta(thread_create(A,_), [A]).
1338xref_meta(thread_signal(_,A), [A]).
1339xref_meta(thread_idle(A,_), [A]).
1340xref_meta(thread_at_exit(A), [A]).
1341xref_meta(thread_initialization(A), [A]).
1342xref_meta(engine_create(_,A,_), [A]).
1343xref_meta(engine_create(_,A,_,_), [A]).
1344xref_meta(transaction(A), [A]).
1345xref_meta(transaction(A,B,_), [A,B]).
1346xref_meta(snapshot(A), [A]).
1347xref_meta(predsort(A,_,_), [A+3]).
1348xref_meta(call_cleanup(A, B), [A, B]).
1349xref_meta(call_cleanup(A, _, B),[A, B]).
1350xref_meta(setup_call_cleanup(A, B, C),[A, B, C]).
1351xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]).
1352xref_meta(call_residue_vars(A,_), [A]).
1353xref_meta(with_mutex(_,A), [A]).
1354xref_meta(assume(G), [G]). 1355xref_meta(assertion(G), [G]). 1356xref_meta(freeze(_, G), [G]).
1357xref_meta(when(C, A), [C, A]).
1358xref_meta(time(G), [G]). 1359xref_meta(call_time(G, _), [G]). 1360xref_meta(call_time(G, _, _), [G]). 1361xref_meta(profile(G), [G]).
1362xref_meta(at_halt(G), [G]).
1363xref_meta(call_with_time_limit(_, G), [G]).
1364xref_meta(call_with_depth_limit(G, _, _), [G]).
1365xref_meta(call_with_inference_limit(G, _, _), [G]).
1366xref_meta(alarm(_, G, _), [G]).
1367xref_meta(alarm(_, G, _, _), [G]).
1368xref_meta('$add_directive_wic'(G), [G]).
1369xref_meta(with_output_to(_, G), [G]).
1370xref_meta(if(G), [G]).
1371xref_meta(elif(G), [G]).
1372xref_meta(meta_options(G,_,_), [G+1]).
1373xref_meta(on_signal(_,_,H), [H+1]) :- H \== default.
1374xref_meta(distinct(G), [G]). 1375xref_meta(distinct(_, G), [G]).
1376xref_meta(order_by(_, G), [G]).
1377xref_meta(limit(_, G), [G]).
1378xref_meta(offset(_, G), [G]).
1379xref_meta(reset(G,_,_), [G]).
1380xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N).
1381xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N).
1382xref_meta(tnot(G), [G]).
1383xref_meta(not_exists(G), [G]).
1384xref_meta(with_tty_raw(G), [G]).
1385xref_meta(residual_goals(G), [G+2]).
1386
1387 1388xref_meta(pce_global(_, new(_)), _) :- !, fail.
1389xref_meta(pce_global(_, B), [B+1]).
1390xref_meta(ifmaintainer(G), [G]). 1391xref_meta(listen(_, G), [G]). 1392xref_meta(listen(_, _, G), [G]).
1393xref_meta(in_pce_thread(G), [G]).
1394
1395xref_meta(G, Meta) :- 1396 prolog:meta_goal(G, Meta).
1397xref_meta(G, Meta) :- 1398 meta_goal(G, Meta).
1399
1400setof_goal(EG, G) :-
1401 var(EG), !, G = EG.
1402setof_goal(_^EG, G) :-
1403 !,
1404 setof_goal(EG, G).
1405setof_goal(G, G).
1406
1407event_xargs(abort, 0).
1408event_xargs(erase, 1).
1409event_xargs(break, 3).
1410event_xargs(frame_finished, 1).
1411event_xargs(thread_exit, 1).
1412event_xargs(this_thread_exit, 0).
1413event_xargs(PI, 2) :- pi_to_head(PI, _).
1414
1418
1419head_of(Var, _) :-
1420 var(Var), !, fail.
1421head_of((Head :- _), Head).
1422head_of(Head, Head).
1423
1429
1430xref_hook(Hook) :-
1431 prolog:hook(Hook).
1432xref_hook(Hook) :-
1433 hook(Hook).
1434
1435
1436hook(attr_portray_hook(_,_)).
1437hook(attr_unify_hook(_,_)).
1438hook(attribute_goals(_,_,_)).
1439hook(goal_expansion(_,_)).
1440hook(term_expansion(_,_)).
1441hook(resource(_,_,_)).
1442hook('$pred_option'(_,_,_,_)).
1443
1444hook(emacs_prolog_colours:goal_classification(_,_)).
1445hook(emacs_prolog_colours:goal_colours(_,_)).
1446hook(emacs_prolog_colours:identify(_,_)).
1447hook(emacs_prolog_colours:style(_,_)).
1448hook(emacs_prolog_colours:term_colours(_,_)).
1449hook(pce_principal:get_implementation(_,_,_,_)).
1450hook(pce_principal:pce_class(_,_,_,_,_,_)).
1451hook(pce_principal:pce_lazy_get_method(_,_,_)).
1452hook(pce_principal:pce_lazy_send_method(_,_,_)).
1453hook(pce_principal:pce_uses_template(_,_)).
1454hook(pce_principal:send_implementation(_,_,_)).
1455hook(predicate_options:option_decl(_,_,_)).
1456hook(prolog:debug_control_hook(_)).
1457hook(prolog:error_message(_,_,_)).
1458hook(prolog:expand_answer(_,_,_)).
1459hook(prolog:general_exception(_,_)).
1460hook(prolog:help_hook(_)).
1461hook(prolog:locate_clauses(_,_)).
1462hook(prolog:message(_,_,_)).
1463hook(prolog:message_context(_,_,_)).
1464hook(prolog:message_line_element(_,_)).
1465hook(prolog:message_location(_,_,_)).
1466hook(prolog:predicate_summary(_,_)).
1467hook(prolog:prolog_exception_hook(_,_,_,_,_)).
1468hook(prolog:residual_goals(_,_)).
1469hook(prolog:show_profile_hook(_,_)).
1470hook(prolog_edit:load).
1471hook(prolog_edit:locate(_,_,_)).
1472hook(sandbox:safe_directive(_)).
1473hook(sandbox:safe_global_variable(_)).
1474hook(sandbox:safe_meta(_,_)).
1475hook(sandbox:safe_meta_predicate(_)).
1476hook(sandbox:safe_primitive(_)).
1477hook(sandbox:safe_prolog_flag(_,_)).
1478hook(shlib:unload_all_foreign_libraries).
1479hook(system:'$foreign_registered'(_, _)).
1480hook(user:exception(_,_,_)).
1481hook(user:expand_answer(_,_)).
1482hook(user:expand_query(_,_,_,_)).
1483hook(user:file_search_path(_,_)).
1484hook(user:library_directory(_)).
1485hook(user:message_hook(_,_,_)).
1486hook(user:portray(_)).
1487hook(user:prolog_clause_name(_,_)).
1488hook(user:prolog_list_goal(_)).
1489hook(user:prolog_predicate_name(_,_)).
1490hook(user:prolog_trace_interception(_,_,_,_)).
1491
1495
1496arith_callable(Var, _) :-
1497 var(Var), !, fail.
1498arith_callable(Module:Spec, Module:Goal) :-
1499 !,
1500 arith_callable(Spec, Goal).
1501arith_callable(Name/Arity, Goal) :-
1502 PredArity is Arity + 1,
1503 functor(Goal, Name, PredArity).
1504
1513
1514process_body(Body, Origin, Src) :-
1515 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1516 true).
1517
1522
1523process_goal(Var, _, _, _) :-
1524 var(Var),
1525 !.
1526process_goal(_:Goal, _, _, _) :-
1527 var(Goal),
1528 !.
1529process_goal(Goal, Origin, Src, P) :-
1530 Goal = (_,_), 1531 !,
1532 phrase(conjunction(Goal), Goals),
1533 process_conjunction(Goals, Origin, Src, P).
1534process_goal(Goal, Origin, Src, _) :- 1535 Goal = (_;_), 1536 !,
1537 phrase(disjunction(Goal), Goals),
1538 forall(member(G, Goals),
1539 process_body(G, Origin, Src)).
1540process_goal(Goal, Origin, Src, P) :-
1541 ( ( xmodule(M, Src)
1542 -> true
1543 ; M = user
1544 ),
1545 pi_head(PI, M:Goal),
1546 ( current_predicate(PI),
1547 predicate_property(M:Goal, imported_from(IM))
1548 -> true
1549 ; PI = M:Name/Arity,
1550 '$find_library'(M, Name, Arity, IM, _Library)
1551 -> true
1552 ; IM = M
1553 ),
1554 prolog:called_by(Goal, IM, M, Called)
1555 ; prolog:called_by(Goal, Called)
1556 ),
1557 !,
1558 must_be(list, Called),
1559 current_source_line(Here),
1560 assert_called(Src, Origin, Goal, Here),
1561 process_called_list(Called, Origin, Src, P).
1562process_goal(Goal, Origin, Src, _) :-
1563 process_xpce_goal(Goal, Origin, Src),
1564 !.
1565process_goal(load_foreign_library(File), _Origin, Src, _) :-
1566 process_foreign(File, Src).
1567process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :-
1568 process_foreign(File, Src).
1569process_goal(use_foreign_library(File), _Origin, Src, _) :-
1570 process_foreign(File, Src).
1571process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :-
1572 process_foreign(File, Src).
1573process_goal(Goal, Origin, Src, P) :-
1574 xref_meta_src(Goal, Metas, Src),
1575 !,
1576 current_source_line(Here),
1577 assert_called(Src, Origin, Goal, Here),
1578 process_called_list(Metas, Origin, Src, P).
1579process_goal(Goal, Origin, Src, _) :-
1580 asserting_goal(Goal, Rule),
1581 !,
1582 current_source_line(Here),
1583 assert_called(Src, Origin, Goal, Here),
1584 process_assert(Rule, Origin, Src).
1585process_goal(Goal, Origin, Src, P) :-
1586 partial_evaluate(Goal, P),
1587 current_source_line(Here),
1588 assert_called(Src, Origin, Goal, Here).
1589
1590disjunction(Var) --> {var(Var), !}, [Var].
1591disjunction((A;B)) --> !, disjunction(A), disjunction(B).
1592disjunction(G) --> [G].
1593
1594conjunction(Var) --> {var(Var), !}, [Var].
1595conjunction((A,B)) --> !, conjunction(A), conjunction(B).
1596conjunction(G) --> [G].
1597
1598shares_vars(RVars, T) :-
1599 term_variables(T, TVars0),
1600 sort(TVars0, TVars),
1601 ord_intersect(RVars, TVars).
1602
1603process_conjunction([], _, _, _).
1604process_conjunction([Disj|Rest], Origin, Src, P) :-
1605 nonvar(Disj),
1606 Disj = (_;_),
1607 Rest \== [],
1608 !,
1609 phrase(disjunction(Disj), Goals),
1610 term_variables(Rest, RVars0),
1611 sort(RVars0, RVars),
1612 partition(shares_vars(RVars), Goals, Sharing, NonSHaring),
1613 forall(member(G, NonSHaring),
1614 process_body(G, Origin, Src)),
1615 ( Sharing == []
1616 -> true
1617 ; maplist(term_variables, Sharing, GVars0),
1618 append(GVars0, GVars1),
1619 sort(GVars1, GVars),
1620 ord_intersection(GVars, RVars, SVars),
1621 VT =.. [v|SVars],
1622 findall(VT,
1623 ( member(G, Sharing),
1624 process_goal(G, Origin, Src, PS),
1625 PS == true
1626 ),
1627 Alts0),
1628 ( Alts0 == []
1629 -> true
1630 ; ( true
1631 ; P = true,
1632 sort(Alts0, Alts1),
1633 variants(Alts1, 10, Alts),
1634 member(VT, Alts)
1635 )
1636 )
1637 ),
1638 process_conjunction(Rest, Origin, Src, P).
1639process_conjunction([H|T], Origin, Src, P) :-
1640 process_goal(H, Origin, Src, P),
1641 process_conjunction(T, Origin, Src, P).
1642
1643
1644process_called_list([], _, _, _).
1645process_called_list([H|T], Origin, Src, P) :-
1646 process_meta(H, Origin, Src, P),
1647 process_called_list(T, Origin, Src, P).
1648
1649process_meta(A+N, Origin, Src, P) :-
1650 !,
1651 ( extend(A, N, AX)
1652 -> process_goal(AX, Origin, Src, P)
1653 ; true
1654 ).
1655process_meta(//(A), Origin, Src, P) :-
1656 !,
1657 process_dcg_goal(A, Origin, Src, P).
1658process_meta(G, Origin, Src, P) :-
1659 process_goal(G, Origin, Src, P).
1660
1665
1666process_dcg_goal(Var, _, _, _) :-
1667 var(Var),
1668 !.
1669process_dcg_goal((A,B), Origin, Src, P) :-
1670 !,
1671 process_dcg_goal(A, Origin, Src, P),
1672 process_dcg_goal(B, Origin, Src, P).
1673process_dcg_goal((A;B), Origin, Src, P) :-
1674 !,
1675 process_dcg_goal(A, Origin, Src, P),
1676 process_dcg_goal(B, Origin, Src, P).
1677process_dcg_goal((A|B), Origin, Src, P) :-
1678 !,
1679 process_dcg_goal(A, Origin, Src, P),
1680 process_dcg_goal(B, Origin, Src, P).
1681process_dcg_goal((A->B), Origin, Src, P) :-
1682 !,
1683 process_dcg_goal(A, Origin, Src, P),
1684 process_dcg_goal(B, Origin, Src, P).
1685process_dcg_goal((A*->B), Origin, Src, P) :-
1686 !,
1687 process_dcg_goal(A, Origin, Src, P),
1688 process_dcg_goal(B, Origin, Src, P).
1689process_dcg_goal({Goal}, Origin, Src, P) :-
1690 !,
1691 process_goal(Goal, Origin, Src, P).
1692process_dcg_goal(List, _Origin, _Src, _) :-
1693 is_list(List),
1694 !. 1695process_dcg_goal(List, _Origin, _Src, _) :-
1696 string(List),
1697 !. 1698process_dcg_goal(Callable, Origin, Src, P) :-
1699 extend(Callable, 2, Goal),
1700 !,
1701 process_goal(Goal, Origin, Src, P).
1702process_dcg_goal(_, _, _, _).
1703
1704
1705extend(Var, _, _) :-
1706 var(Var), !, fail.
1707extend(M:G, N, M:GX) :-
1708 !,
1709 callable(G),
1710 extend(G, N, GX).
1711extend(G, N, GX) :-
1712 ( compound(G)
1713 -> compound_name_arguments(G, Name, Args),
1714 length(Rest, N),
1715 append(Args, Rest, NArgs),
1716 compound_name_arguments(GX, Name, NArgs)
1717 ; atom(G)
1718 -> length(NArgs, N),
1719 compound_name_arguments(GX, G, NArgs)
1720 ).
1721
1722asserting_goal(assert(Rule), Rule).
1723asserting_goal(asserta(Rule), Rule).
1724asserting_goal(assertz(Rule), Rule).
1725asserting_goal(assert(Rule,_), Rule).
1726asserting_goal(asserta(Rule,_), Rule).
1727asserting_goal(assertz(Rule,_), Rule).
1728
1729process_assert(0, _, _) :- !. 1730process_assert((_:-Body), Origin, Src) :-
1731 !,
1732 process_body(Body, Origin, Src).
1733process_assert(_, _, _).
1734
1736
1737variants([], _, []).
1738variants([H|T], Max, List) :-
1739 variants(T, H, Max, List).
1740
1741variants([], H, _, [H]).
1742variants(_, _, 0, []) :- !.
1743variants([H|T], V, Max, List) :-
1744 ( H =@= V
1745 -> variants(T, V, Max, List)
1746 ; List = [V|List2],
1747 Max1 is Max-1,
1748 variants(T, H, Max1, List2)
1749 ).
1750
1762
1763partial_evaluate(Goal, P) :-
1764 eval(Goal),
1765 !,
1766 P = true.
1767partial_evaluate(_, _).
1768
1769eval(X = Y) :-
1770 unify_with_occurs_check(X, Y).
1771
1772 1775
1776enter_test_unit(Unit, _Src) :-
1777 current_source_line(Line),
1778 asserta(current_test_unit(Unit, Line)).
1779
1780leave_test_unit(Unit, _Src) :-
1781 retractall(current_test_unit(Unit, _)).
1782
1783
1784 1787
1788pce_goal(new(_,_), new(-, new)).
1789pce_goal(send(_,_), send(arg, msg)).
1790pce_goal(send_class(_,_,_), send_class(arg, arg, msg)).
1791pce_goal(get(_,_,_), get(arg, msg, -)).
1792pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)).
1793pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)).
1794pce_goal(get_object(_,_,_), get_object(arg, msg, -)).
1795
1796process_xpce_goal(G, Origin, Src) :-
1797 pce_goal(G, Process),
1798 !,
1799 current_source_line(Here),
1800 assert_called(Src, Origin, G, Here),
1801 ( arg(I, Process, How),
1802 arg(I, G, Term),
1803 process_xpce_arg(How, Term, Origin, Src),
1804 fail
1805 ; true
1806 ).
1807
1808process_xpce_arg(new, Term, Origin, Src) :-
1809 callable(Term),
1810 process_new(Term, Origin, Src).
1811process_xpce_arg(arg, Term, Origin, Src) :-
1812 compound(Term),
1813 process_new(Term, Origin, Src).
1814process_xpce_arg(msg, Term, Origin, Src) :-
1815 compound(Term),
1816 ( arg(_, Term, Arg),
1817 process_xpce_arg(arg, Arg, Origin, Src),
1818 fail
1819 ; true
1820 ).
1821
1822process_new(_M:_Term, _, _) :- !. 1823process_new(Term, Origin, Src) :-
1824 assert_new(Src, Origin, Term),
1825 ( compound(Term),
1826 arg(_, Term, Arg),
1827 process_xpce_arg(arg, Arg, Origin, Src),
1828 fail
1829 ; true
1830 ).
1831
1832assert_new(_, _, Term) :-
1833 \+ callable(Term),
1834 !.
1835assert_new(Src, Origin, Control) :-
1836 functor_name(Control, Class),
1837 pce_control_class(Class),
1838 !,
1839 forall(arg(_, Control, Arg),
1840 assert_new(Src, Origin, Arg)).
1841assert_new(Src, Origin, Term) :-
1842 compound(Term),
1843 arg(1, Term, Prolog),
1844 Prolog == @(prolog),
1845 ( Term =.. [message, _, Selector | T],
1846 atom(Selector)
1847 -> Called =.. [Selector|T],
1848 process_body(Called, Origin, Src)
1849 ; Term =.. [?, _, Selector | T],
1850 atom(Selector)
1851 -> append(T, [_R], T2),
1852 Called =.. [Selector|T2],
1853 process_body(Called, Origin, Src)
1854 ),
1855 fail.
1856assert_new(_, _, @(_)) :- !.
1857assert_new(Src, _, Term) :-
1858 functor_name(Term, Name),
1859 assert_used_class(Src, Name).
1860
1861
1862pce_control_class(and).
1863pce_control_class(or).
1864pce_control_class(if).
1865pce_control_class(not).
1866
1867
1868 1871
1873
1874process_use_module(_Module:_Files, _, _) :- !. 1875process_use_module([], _, _) :- !.
1876process_use_module([H|T], Src, Reexport) :-
1877 !,
1878 process_use_module(H, Src, Reexport),
1879 process_use_module(T, Src, Reexport).
1880process_use_module(library(pce), Src, Reexport) :- 1881 !,
1882 xref_public_list(library(pce), Path, Exports, Src),
1883 forall(member(Import, Exports),
1884 process_pce_import(Import, Src, Path, Reexport)).
1885process_use_module(File, Src, Reexport) :-
1886 load_module_if_needed(File),
1887 ( xoption(Src, silent(Silent))
1888 -> Extra = [silent(Silent)]
1889 ; Extra = [silent(true)]
1890 ),
1891 ( xref_public_list(File, Src,
1892 [ path(Path),
1893 module(M),
1894 exports(Exports),
1895 public(Public),
1896 meta(Meta)
1897 | Extra
1898 ])
1899 -> assert(uses_file(File, Src, Path)),
1900 assert_import(Src, Exports, _, Path, Reexport),
1901 assert_xmodule_callable(Exports, M, Src, Path),
1902 assert_xmodule_callable(Public, M, Src, Path),
1903 maplist(process_meta_head(Src), Meta),
1904 ( File = library(chr) 1905 -> assert(mode(chr, Src))
1906 ; true
1907 )
1908 ; assert(uses_file(File, Src, '<not_found>'))
1909 ).
1910
1911process_pce_import(Name/Arity, Src, Path, Reexport) :-
1912 atom(Name),
1913 integer(Arity),
1914 !,
1915 functor(Term, Name, Arity),
1916 ( \+ system_predicate(Term),
1917 \+ Term = pce_error(_) 1918 -> assert_import(Src, [Name/Arity], _, Path, Reexport)
1919 ; true
1920 ).
1921process_pce_import(op(P,T,N), Src, _, _) :-
1922 xref_push_op(Src, P, T, N).
1923
1927
1928process_use_module2(File, Import, Src, Reexport) :-
1929 load_module_if_needed(File),
1930 ( xref_source_file(File, Path, Src)
1931 -> assert(uses_file(File, Src, Path)),
1932 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1933 -> assert_import(Src, Import, Export, Path, Reexport),
1934 forall(( member(Head, Meta),
1935 imported(Head, _, Path)
1936 ),
1937 process_meta_head(Src, Head))
1938 ; true
1939 )
1940 ; assert(uses_file(File, Src, '<not_found>'))
1941 ).
1942
1943
1949
1950load_module_if_needed(File) :-
1951 prolog:no_autoload_module(File),
1952 !,
1953 use_module(File, []).
1954load_module_if_needed(_).
1955
1956prolog:no_autoload_module(library(apply_macros)).
1957prolog:no_autoload_module(library(arithmetic)).
1958prolog:no_autoload_module(library(record)).
1959prolog:no_autoload_module(library(persistency)).
1960prolog:no_autoload_module(library(pldoc)).
1961prolog:no_autoload_module(library(settings)).
1962prolog:no_autoload_module(library(debug)).
1963prolog:no_autoload_module(library(plunit)).
1964prolog:no_autoload_module(library(macros)).
1965prolog:no_autoload_module(library(yall)).
1966
1967
1969
1970process_requires(Import, Src) :-
1971 is_list(Import),
1972 !,
1973 require_list(Import, Src).
1974process_requires(Var, _Src) :-
1975 var(Var),
1976 !.
1977process_requires((A,B), Src) :-
1978 !,
1979 process_requires(A, Src),
1980 process_requires(B, Src).
1981process_requires(PI, Src) :-
1982 requires(PI, Src).
1983
1984require_list([], _).
1985require_list([H|T], Src) :-
1986 requires(H, Src),
1987 require_list(T, Src).
1988
1989requires(PI, _Src) :-
1990 '$pi_head'(PI, Head),
1991 '$get_predicate_attribute'(system:Head, defined, 1),
1992 !.
1993requires(PI, Src) :-
1994 '$pi_head'(PI, Head),
1995 '$pi_head'(Name/Arity, Head),
1996 '$find_library'(_Module, Name, Arity, _LoadModule, Library),
1997 ( imported(Head, Src, Library)
1998 -> true
1999 ; assertz(imported(Head, Src, Library))
2000 ).
2001
2002
2030
2031xref_public_list(File, Src, Options) :-
2032 option(path(Path), Options, _),
2033 option(module(Module), Options, _),
2034 option(exports(Exports), Options, _),
2035 option(public(Public), Options, _),
2036 option(meta(Meta), Options, _),
2037 xref_source_file(File, Path, Src, Options),
2038 public_list(Path, Module, Meta, Exports, Public, Options).
2039
2059
2060xref_public_list(File, Path, Export, Src) :-
2061 xref_source_file(File, Path, Src),
2062 public_list(Path, _, _, Export, _, []).
2063xref_public_list(File, Path, Module, Export, Meta, Src) :-
2064 xref_source_file(File, Path, Src),
2065 public_list(Path, Module, Meta, Export, _, []).
2066xref_public_list(File, Path, Module, Export, Public, Meta, Src) :-
2067 xref_source_file(File, Path, Src),
2068 public_list(Path, Module, Meta, Export, Public, []).
2069
2077
2078:- dynamic public_list_cache/6. 2079:- volatile public_list_cache/6. 2080
2081public_list(Path, Module, Meta, Export, Public, _Options) :-
2082 public_list_cache(Path, Modified,
2083 Module0, Meta0, Export0, Public0),
2084 time_file(Path, ModifiedNow),
2085 ( abs(Modified-ModifiedNow) < 0.0001
2086 -> !,
2087 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0)
2088 ; retractall(public_list_cache(Path, _, _, _, _, _)),
2089 fail
2090 ).
2091public_list(Path, Module, Meta, Export, Public, Options) :-
2092 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options),
2093 ( Error = error(_,_),
2094 catch(time_file(Path, Modified), Error, fail)
2095 -> asserta(public_list_cache(Path, Modified,
2096 Module0, Meta0, Export0, Public0))
2097 ; true
2098 ),
2099 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0).
2100
2101public_list_nc(Path, Module, Meta, Export, Public, Options) :-
2102 in_temporary_module(
2103 TempModule,
2104 true,
2105 public_list_diff(TempModule, Path, Module,
2106 Meta, [], Export, [], Public, [], Options)).
2107
2108
2109public_list_diff(TempModule,
2110 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :-
2111 setup_call_cleanup(
2112 public_list_setup(TempModule, Path, In, State),
2113 phrase(read_directives(In, Options, [true]), Directives),
2114 public_list_cleanup(In, State)),
2115 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT).
2116
2117public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :-
2118 prolog_open_source(Path, In),
2119 '$set_source_module'(OldM, TempModule),
2120 set_xref(OldXref).
2121
2122public_list_cleanup(In, state(OldM, OldXref)) :-
2123 '$set_source_module'(OldM),
2124 set_prolog_flag(xref, OldXref),
2125 prolog_close_source(In).
2126
2127
2128read_directives(In, Options, State) -->
2129 { repeat,
2130 catch(prolog_read_source_term(In, Term, Expanded,
2131 [ process_comment(true),
2132 syntax_errors(error)
2133 ]),
2134 E, report_syntax_error(E, -, Options))
2135 -> nonvar(Term),
2136 Term = (:-_)
2137 },
2138 !,
2139 terms(Expanded, State, State1),
2140 read_directives(In, Options, State1).
2141read_directives(_, _, _) --> [].
2142
2143terms(Var, State, State) --> { var(Var) }, !.
2144terms([H|T], State0, State) -->
2145 !,
2146 terms(H, State0, State1),
2147 terms(T, State1, State).
2148terms((:-if(Cond)), State0, [True|State0]) -->
2149 !,
2150 { eval_cond(Cond, True) }.
2151terms((:-elif(Cond)), [True0|State], [True|State]) -->
2152 !,
2153 { eval_cond(Cond, True1),
2154 elif(True0, True1, True)
2155 }.
2156terms((:-else), [True0|State], [True|State]) -->
2157 !,
2158 { negate(True0, True) }.
2159terms((:-endif), [_|State], State) --> !.
2160terms(H, State, State) -->
2161 ( {State = [true|_]}
2162 -> [H]
2163 ; []
2164 ).
2165
2166eval_cond(Cond, true) :-
2167 catch(Cond, _, fail),
2168 !.
2169eval_cond(_, false).
2170
2171elif(true, _, else_false) :- !.
2172elif(false, true, true) :- !.
2173elif(True, _, True).
2174
2175negate(true, false).
2176negate(false, true).
2177negate(else_false, else_false).
2178
2179public_list([(:- module(Module, Export0))|Decls], Path,
2180 Module, Meta, MT, Export, Rest, Public, PT) :-
2181 !,
2182 ( is_list(Export0)
2183 -> append(Export0, Reexport, Export)
2184 ; Reexport = Export
2185 ),
2186 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT).
2187public_list([(:- encoding(_))|Decls], Path,
2188 Module, Meta, MT, Export, Rest, Public, PT) :-
2189 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT).
2190
2191public_list_([], _, Meta, Meta, Export, Export, Public, Public).
2192public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :-
2193 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0),
2194 !,
2195 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT).
2196public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :-
2197 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT).
2198
2199public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :-
2200 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT).
2201public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :-
2202 public_from_import(Import, Spec, Path, Reexport, Rest).
2203public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :-
2204 phrase(meta_decls(Decl), Meta, MT).
2205public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :-
2206 phrase(public_decls(Decl), Public, PT).
2207
2211
2212reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !.
2213reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :-
2214 !,
2215 xref_source_file(H, Path, Src),
2216 public_list(Path, _Module, Meta0, Export0, Public0, []),
2217 append(Meta0, MT1, Meta),
2218 append(Export0, ET1, Export),
2219 append(Public0, PT1, Public),
2220 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT).
2221reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :-
2222 xref_source_file(Spec, Path, Src),
2223 public_list(Path, _Module, Meta0, Export0, Public0, []),
2224 append(Meta0, MT, Meta),
2225 append(Export0, ET, Export),
2226 append(Public0, PT, Public).
2227
2228public_from_import(except(Map), Path, Src, Export, Rest) :-
2229 !,
2230 xref_public_list(Path, _, AllExports, Src),
2231 except(Map, AllExports, NewExports),
2232 append(NewExports, Rest, Export).
2233public_from_import(Import, _, _, Export, Rest) :-
2234 import_name_map(Import, Export, Rest).
2235
2236
2238
2239except([], Exports, Exports).
2240except([PI0 as NewName|Map], Exports0, Exports) :-
2241 !,
2242 canonical_pi(PI0, PI),
2243 map_as(Exports0, PI, NewName, Exports1),
2244 except(Map, Exports1, Exports).
2245except([PI0|Map], Exports0, Exports) :-
2246 canonical_pi(PI0, PI),
2247 select(PI2, Exports0, Exports1),
2248 same_pi(PI, PI2),
2249 !,
2250 except(Map, Exports1, Exports).
2251
2252
2253map_as([PI|T], Repl, As, [PI2|T]) :-
2254 same_pi(Repl, PI),
2255 !,
2256 pi_as(PI, As, PI2).
2257map_as([H|T0], Repl, As, [H|T]) :-
2258 map_as(T0, Repl, As, T).
2259
2260pi_as(_/Arity, Name, Name/Arity).
2261pi_as(_//Arity, Name, Name//Arity).
2262
2263import_name_map([], L, L).
2264import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :-
2265 !,
2266 import_name_map(T0, T, Tail).
2267import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :-
2268 !,
2269 import_name_map(T0, T, Tail).
2270import_name_map([H|T0], [H|T], Tail) :-
2271 import_name_map(T0, T, Tail).
2272
2273canonical_pi(Name//Arity0, PI) :-
2274 integer(Arity0),
2275 !,
2276 PI = Name/Arity,
2277 Arity is Arity0 + 2.
2278canonical_pi(PI, PI).
2279
2280same_pi(Canonical, PI2) :-
2281 canonical_pi(PI2, Canonical).
2282
2283meta_decls(Var) -->
2284 { var(Var) },
2285 !.
2286meta_decls((A,B)) -->
2287 !,
2288 meta_decls(A),
2289 meta_decls(B).
2290meta_decls(A) -->
2291 [A].
2292
2293public_decls(Var) -->
2294 { var(Var) },
2295 !.
2296public_decls((A,B)) -->
2297 !,
2298 public_decls(A),
2299 public_decls(B).
2300public_decls(A) -->
2301 [A].
2302
2303 2306
2307process_include([], _) :- !.
2308process_include([H|T], Src) :-
2309 !,
2310 process_include(H, Src),
2311 process_include(T, Src).
2312process_include(File, Src) :-
2313 callable(File),
2314 !,
2315 ( once(xref_input(ParentSrc, _)),
2316 xref_source_file(File, Path, ParentSrc)
2317 -> ( ( uses_file(_, Src, Path)
2318 ; Path == Src
2319 )
2320 -> true
2321 ; assert(uses_file(File, Src, Path)),
2322 ( xoption(Src, process_include(true))
2323 -> findall(O, xoption(Src, O), Options),
2324 setup_call_cleanup(
2325 open_include_file(Path, In, Refs),
2326 collect(Src, Path, In, Options),
2327 close_include(In, Refs))
2328 ; true
2329 )
2330 )
2331 ; assert(uses_file(File, Src, '<not_found>'))
2332 ).
2333process_include(_, _).
2334
2340
2341open_include_file(Path, In, [Ref]) :-
2342 once(xref_input(_, Parent)),
2343 stream_property(Parent, encoding(Enc)),
2344 '$push_input_context'(xref_include),
2345 catch(( prolog:xref_open_source(Path, In)
2346 -> catch(set_stream(In, encoding(Enc)),
2347 error(_,_), true) 2348 ; include_encoding(Enc, Options),
2349 open(Path, read, In, Options)
2350 ), E,
2351 ( '$pop_input_context', throw(E))),
2352 catch(( peek_char(In, #) 2353 -> skip(In, 10)
2354 ; true
2355 ), E,
2356 ( close_include(In, []), throw(E))),
2357 asserta(xref_input(Path, In), Ref).
2358
2359include_encoding(wchar_t, []) :- !.
2360include_encoding(Enc, [encoding(Enc)]).
2361
2362
2363close_include(In, Refs) :-
2364 maplist(erase, Refs),
2365 close(In, [force(true)]),
2366 '$pop_input_context'.
2367
2371
2372process_foreign(Spec, Src) :-
2373 ground(Spec),
2374 current_foreign_library(Spec, Defined),
2375 !,
2376 ( xmodule(Module, Src)
2377 -> true
2378 ; Module = user
2379 ),
2380 process_foreign_defined(Defined, Module, Src).
2381process_foreign(_, _).
2382
2383process_foreign_defined([], _, _).
2384process_foreign_defined([H|T], M, Src) :-
2385 ( H = M:Head
2386 -> assert_foreign(Src, Head)
2387 ; assert_foreign(Src, H)
2388 ),
2389 process_foreign_defined(T, M, Src).
2390
2391
2392 2395
2405
2406process_chr(@(_Name, Rule), Src) :-
2407 mode(chr, Src),
2408 process_chr(Rule, Src).
2409process_chr(pragma(Rule, _Pragma), Src) :-
2410 mode(chr, Src),
2411 process_chr(Rule, Src).
2412process_chr(<=>(Head, Body), Src) :-
2413 mode(chr, Src),
2414 chr_head(Head, Src, H),
2415 chr_body(Body, H, Src).
2416process_chr(==>(Head, Body), Src) :-
2417 mode(chr, Src),
2418 chr_head(Head, H, Src),
2419 chr_body(Body, H, Src).
2420process_chr((:- chr_constraint(_)), Src) :-
2421 ( mode(chr, Src)
2422 -> true
2423 ; assert(mode(chr, Src))
2424 ).
2425
2426chr_head(X, _, _) :-
2427 var(X),
2428 !. 2429chr_head(\(A,B), Src, H) :-
2430 chr_head(A, Src, H),
2431 process_body(B, H, Src).
2432chr_head((H0,B), Src, H) :-
2433 chr_defined(H0, Src, H),
2434 process_body(B, H, Src).
2435chr_head(H0, Src, H) :-
2436 chr_defined(H0, Src, H).
2437
2438chr_defined(X, _, _) :-
2439 var(X),
2440 !.
2441chr_defined(#(C,_Id), Src, C) :-
2442 !,
2443 assert_constraint(Src, C).
2444chr_defined(A, Src, A) :-
2445 assert_constraint(Src, A).
2446
2447chr_body(X, From, Src) :-
2448 var(X),
2449 !,
2450 process_body(X, From, Src).
2451chr_body('|'(Guard, Goals), H, Src) :-
2452 !,
2453 chr_body(Guard, H, Src),
2454 chr_body(Goals, H, Src).
2455chr_body(G, From, Src) :-
2456 process_body(G, From, Src).
2457
2458assert_constraint(_, Head) :-
2459 var(Head),
2460 !.
2461assert_constraint(Src, Head) :-
2462 constraint(Head, Src, _),
2463 !.
2464assert_constraint(Src, Head) :-
2465 generalise_term(Head, Term),
2466 current_source_line(Line),
2467 assert(constraint(Term, Src, Line)).
2468
2469
2470 2473
2478
2479assert_called(_, _, Var, _) :-
2480 var(Var),
2481 !.
2482assert_called(Src, From, Goal, Line) :-
2483 var(From),
2484 !,
2485 assert_called(Src, '<unknown>', Goal, Line).
2486assert_called(_, _, Goal, _) :-
2487 expand_hide_called(Goal),
2488 !.
2489assert_called(Src, Origin, M:G, Line) :-
2490 !,
2491 ( atom(M),
2492 callable(G)
2493 -> current_condition(Cond),
2494 ( xmodule(M, Src) 2495 -> assert_called(Src, Origin, G, Line)
2496 ; called(M:G, Src, Origin, Cond, Line) 2497 -> true
2498 ; hide_called(M:G, Src) 2499 -> true
2500 ; generalise(Origin, OTerm),
2501 generalise(G, GTerm)
2502 -> assert(called(M:GTerm, Src, OTerm, Cond, Line))
2503 ; true
2504 )
2505 ; true 2506 ).
2507assert_called(Src, _, Goal, _) :-
2508 ( xmodule(M, Src)
2509 -> M \== system
2510 ; M = user
2511 ),
2512 hide_called(M:Goal, Src),
2513 !.
2514assert_called(Src, Origin, Goal, Line) :-
2515 current_condition(Cond),
2516 ( called(Goal, Src, Origin, Cond, Line)
2517 -> true
2518 ; generalise(Origin, OTerm),
2519 generalise(Goal, Term)
2520 -> assert(called(Term, Src, OTerm, Cond, Line))
2521 ; true
2522 ).
2523
2524
2529
2530expand_hide_called(pce_principal:send_implementation(_, _, _)).
2531expand_hide_called(pce_principal:get_implementation(_, _, _, _)).
2532expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)).
2533expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)).
2534
2535assert_defined(Src, Goal) :-
2536 Goal = test(_Test),
2537 current_test_unit(Unit, Line),
2538 assert_called(Src, '<test_unit>'(Unit), Goal, Line),
2539 fail.
2540assert_defined(Src, Goal) :-
2541 Goal = test(_Test, _Options),
2542 current_test_unit(Unit, Line),
2543 assert_called(Src, '<test_unit>'(Unit), Goal, Line),
2544 fail.
2545assert_defined(Src, Goal) :-
2546 defined(Goal, Src, _),
2547 !.
2548assert_defined(Src, Goal) :-
2549 generalise(Goal, Term),
2550 current_source_line(Line),
2551 assert(defined(Term, Src, Line)).
2552
2553assert_foreign(Src, Goal) :-
2554 foreign(Goal, Src, _),
2555 !.
2556assert_foreign(Src, Goal) :-
2557 generalise(Goal, Term),
2558 current_source_line(Line),
2559 assert(foreign(Term, Src, Line)).
2560
2561assert_grammar_rule(Src, Goal) :-
2562 grammar_rule(Goal, Src),
2563 !.
2564assert_grammar_rule(Src, Goal) :-
2565 generalise(Goal, Term),
2566 assert(grammar_rule(Term, Src)).
2567
2568
2578
2579assert_import(_, [], _, _, _) :- !.
2580assert_import(Src, [H|T], Export, From, Reexport) :-
2581 !,
2582 assert_import(Src, H, Export, From, Reexport),
2583 assert_import(Src, T, Export, From, Reexport).
2584assert_import(Src, except(Except), Export, From, Reexport) :-
2585 !,
2586 is_list(Export),
2587 !,
2588 except(Except, Export, Import),
2589 assert_import(Src, Import, _All, From, Reexport).
2590assert_import(Src, Import as Name, Export, From, Reexport) :-
2591 !,
2592 pi_to_head(Import, Term0),
2593 rename_goal(Term0, Name, Term),
2594 ( in_export_list(Term0, Export)
2595 -> assert(imported(Term, Src, From)),
2596 assert_reexport(Reexport, Src, Term)
2597 ; current_source_line(Line),
2598 assert_called(Src, '<directive>'(Line), Term0, Line)
2599 ).
2600assert_import(Src, Import, Export, From, Reexport) :-
2601 pi_to_head(Import, Term),
2602 !,
2603 ( in_export_list(Term, Export)
2604 -> assert(imported(Term, Src, From)),
2605 assert_reexport(Reexport, Src, Term)
2606 ; current_source_line(Line),
2607 assert_called(Src, '<directive>'(Line), Term, Line)
2608 ).
2609assert_import(Src, op(P,T,N), _, _, _) :-
2610 xref_push_op(Src, P,T,N).
2611
2612in_export_list(_Head, Export) :-
2613 var(Export),
2614 !.
2615in_export_list(Head, Export) :-
2616 member(PI, Export),
2617 pi_to_head(PI, Head).
2618
2619assert_reexport(false, _, _) :- !.
2620assert_reexport(true, Src, Term) :-
2621 assert(exported(Term, Src)).
2622
2626
2627process_import(M:PI, Src) :-
2628 pi_to_head(PI, Head),
2629 !,
2630 ( atom(M),
2631 current_module(M),
2632 module_property(M, file(From))
2633 -> true
2634 ; From = '<unknown>'
2635 ),
2636 assert(imported(Head, Src, From)).
2637process_import(_, _).
2638
2645
2646assert_xmodule_callable([], _, _, _).
2647assert_xmodule_callable([PI|T], M, Src, From) :-
2648 ( pi_to_head(M:PI, Head)
2649 -> assert(imported(Head, Src, From))
2650 ; true
2651 ),
2652 assert_xmodule_callable(T, M, Src, From).
2653
2654
2658
2659assert_op(Src, op(P,T,M:N)) :-
2660 ( '$current_source_module'(M)
2661 -> Name = N
2662 ; Name = M:N
2663 ),
2664 ( xop(Src, op(P,T,Name))
2665 -> true
2666 ; assert(xop(Src, op(P,T,Name)))
2667 ).
2668
2673
2674assert_module(Src, Module) :-
2675 xmodule(Module, Src),
2676 !.
2677assert_module(Src, Module) :-
2678 '$set_source_module'(Module),
2679 assert(xmodule(Module, Src)),
2680 ( module_property(Module, class(system))
2681 -> retractall(xoption(Src, register_called(_))),
2682 assert(xoption(Src, register_called(all)))
2683 ; true
2684 ).
2685
2686assert_module_export(_, []) :- !.
2687assert_module_export(Src, [H|T]) :-
2688 !,
2689 assert_module_export(Src, H),
2690 assert_module_export(Src, T).
2691assert_module_export(Src, PI) :-
2692 pi_to_head(PI, Term),
2693 !,
2694 assert(exported(Term, Src)).
2695assert_module_export(Src, op(P, A, N)) :-
2696 xref_push_op(Src, P, A, N).
2697
2701
2702assert_module3([], _) :- !.
2703assert_module3([H|T], Src) :-
2704 !,
2705 assert_module3(H, Src),
2706 assert_module3(T, Src).
2707assert_module3(Option, Src) :-
2708 process_use_module(library(dialect/Option), Src, false).
2709
2710
2716
2717process_predicates(Closure, Preds, Src) :-
2718 is_list(Preds),
2719 !,
2720 process_predicate_list(Preds, Closure, Src).
2721process_predicates(Closure, as(Preds, _Options), Src) :-
2722 !,
2723 process_predicates(Closure, Preds, Src).
2724process_predicates(Closure, Preds, Src) :-
2725 process_predicate_comma(Preds, Closure, Src).
2726
2727process_predicate_list([], _, _).
2728process_predicate_list([H|T], Closure, Src) :-
2729 ( nonvar(H)
2730 -> call(Closure, H, Src)
2731 ; true
2732 ),
2733 process_predicate_list(T, Closure, Src).
2734
2735process_predicate_comma(Var, _, _) :-
2736 var(Var),
2737 !.
2738process_predicate_comma(M:(A,B), Closure, Src) :-
2739 !,
2740 process_predicate_comma(M:A, Closure, Src),
2741 process_predicate_comma(M:B, Closure, Src).
2742process_predicate_comma((A,B), Closure, Src) :-
2743 !,
2744 process_predicate_comma(A, Closure, Src),
2745 process_predicate_comma(B, Closure, Src).
2746process_predicate_comma(as(Spec, _Options), Closure, Src) :-
2747 !,
2748 process_predicate_comma(Spec, Closure, Src).
2749process_predicate_comma(A, Closure, Src) :-
2750 call(Closure, A, Src).
2751
2752
2753assert_dynamic(PI, Src) :-
2754 pi_to_head(PI, Term),
2755 ( thread_local(Term, Src, _) 2756 -> true 2757 ; current_source_line(Line),
2758 assert(dynamic(Term, Src, Line))
2759 ).
2760
2761assert_thread_local(PI, Src) :-
2762 pi_to_head(PI, Term),
2763 current_source_line(Line),
2764 assert(thread_local(Term, Src, Line)).
2765
2766assert_multifile(PI, Src) :- 2767 pi_to_head(PI, Term),
2768 current_source_line(Line),
2769 assert(multifile(Term, Src, Line)).
2770
2771assert_public(PI, Src) :- 2772 pi_to_head(PI, Term),
2773 current_source_line(Line),
2774 assert_called(Src, '<public>'(Line), Term, Line),
2775 assert(public(Term, Src, Line)).
2776
2777assert_export(PI, Src) :- 2778 pi_to_head(PI, Term),
2779 !,
2780 assert(exported(Term, Src)).
2781
2786
2787pi_to_head(Var, _) :-
2788 var(Var), !, fail.
2789pi_to_head(M:PI, M:Term) :-
2790 !,
2791 pi_to_head(PI, Term).
2792pi_to_head(Name/Arity, Term) :-
2793 functor(Term, Name, Arity).
2794pi_to_head(Name//DCGArity, Term) :-
2795 Arity is DCGArity+2,
2796 functor(Term, Name, Arity).
2797
2798
2799assert_used_class(Src, Name) :-
2800 used_class(Name, Src),
2801 !.
2802assert_used_class(Src, Name) :-
2803 assert(used_class(Name, Src)).
2804
2805assert_defined_class(Src, Name, _Meta, _Super, _) :-
2806 defined_class(Name, _, _, Src, _),
2807 !.
2808assert_defined_class(_, _, _, -, _) :- !. 2809assert_defined_class(Src, Name, Meta, Super, Summary) :-
2810 current_source_line(Line),
2811 ( Summary == @(default)
2812 -> Atom = ''
2813 ; is_list(Summary)
2814 -> atom_codes(Atom, Summary)
2815 ; string(Summary)
2816 -> atom_concat(Summary, '', Atom)
2817 ),
2818 assert(defined_class(Name, Super, Atom, Src, Line)),
2819 ( Meta = @(_)
2820 -> true
2821 ; assert_used_class(Src, Meta)
2822 ),
2823 assert_used_class(Src, Super).
2824
2825assert_defined_class(Src, Name, imported_from(_File)) :-
2826 defined_class(Name, _, _, Src, _),
2827 !.
2828assert_defined_class(Src, Name, imported_from(File)) :-
2829 assert(defined_class(Name, _, '', Src, file(File))).
2830
2831
2832 2835
2839
2840generalise(Var, Var) :-
2841 var(Var),
2842 !. 2843generalise(pce_principal:send_implementation(Id, _, _),
2844 pce_principal:send_implementation(Id, _, _)) :-
2845 atom(Id),
2846 !.
2847generalise(pce_principal:get_implementation(Id, _, _, _),
2848 pce_principal:get_implementation(Id, _, _, _)) :-
2849 atom(Id),
2850 !.
2851generalise('<directive>'(Line), '<directive>'(Line)) :- !.
2852generalise(test(Test), test(Test)) :-
2853 current_test_unit(_,_),
2854 ground(Test),
2855 !.
2856generalise(test(Test, _), test(Test, _)) :-
2857 current_test_unit(_,_),
2858 ground(Test),
2859 !.
2860generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !.
2861generalise(Module:Goal0, Module:Goal) :-
2862 atom(Module),
2863 !,
2864 generalise(Goal0, Goal).
2865generalise(Term0, Term) :-
2866 callable(Term0),
2867 generalise_term(Term0, Term).
2868
2869
2870 2873
2881
2882:- multifile
2883 prolog:xref_source_directory/2, 2884 prolog:xref_source_file/3. 2885
2886
2891
2892xref_source_file(Plain, File, Source) :-
2893 xref_source_file(Plain, File, Source, []).
2894
2895xref_source_file(QSpec, File, Source, Options) :-
2896 nonvar(QSpec), QSpec = _:Spec,
2897 !,
2898 must_be(acyclic, Spec),
2899 xref_source_file(Spec, File, Source, Options).
2900xref_source_file(Spec, File, Source, Options) :-
2901 nonvar(Spec),
2902 prolog:xref_source_file(Spec, File,
2903 [ relative_to(Source)
2904 | Options
2905 ]),
2906 !.
2907xref_source_file(Plain, File, Source, Options) :-
2908 atom(Plain),
2909 \+ is_absolute_file_name(Plain),
2910 ( prolog:xref_source_directory(Source, Dir)
2911 -> true
2912 ; atom(Source),
2913 file_directory_name(Source, Dir)
2914 ),
2915 atomic_list_concat([Dir, /, Plain], Spec0),
2916 absolute_file_name(Spec0, Spec),
2917 do_xref_source_file(Spec, File, Options),
2918 !.
2919xref_source_file(Spec, File, Source, Options) :-
2920 do_xref_source_file(Spec, File,
2921 [ relative_to(Source)
2922 | Options
2923 ]),
2924 !.
2925xref_source_file(_, _, _, Options) :-
2926 option(silent(true), Options),
2927 !,
2928 fail.
2929xref_source_file(Spec, _, Src, _Options) :-
2930 verbose(Src),
2931 print_message(warning, error(existence_error(file, Spec), _)),
2932 fail.
2933
2934do_xref_source_file(Spec, File, Options) :-
2935 nonvar(Spec),
2936 option(file_type(Type), Options, prolog),
2937 absolute_file_name(Spec, File,
2938 [ file_type(Type),
2939 access(read),
2940 file_errors(fail)
2941 ]),
2942 !.
2943
2947
2948canonical_source(Source, Src) :-
2949 ( ground(Source)
2950 -> prolog_canonical_source(Source, Src)
2951 ; Source = Src
2952 ).
2953
2958
2959goal_name_arity(Goal, Name, Arity) :-
2960 ( compound(Goal)
2961 -> compound_name_arity(Goal, Name, Arity)
2962 ; atom(Goal)
2963 -> Name = Goal, Arity = 0
2964 ).
2965
2966generalise_term(Specific, General) :-
2967 ( compound(Specific)
2968 -> compound_name_arity(Specific, Name, Arity),
2969 compound_name_arity(General, Name, Arity)
2970 ; General = Specific
2971 ).
2972
2973functor_name(Term, Name) :-
2974 ( compound(Term)
2975 -> compound_name_arity(Term, Name, _)
2976 ; atom(Term)
2977 -> Name = Term
2978 ).
2979
2980rename_goal(Goal0, Name, Goal) :-
2981 ( compound(Goal0)
2982 -> compound_name_arity(Goal0, _, Arity),
2983 compound_name_arity(Goal, Name, Arity)
2984 ; Goal = Name
2985 )