36
37:- module(prolog_xref,
38 [ xref_source/1, 39 xref_source/2, 40 xref_called/3, 41 xref_called/4, 42 xref_called/5, 43 xref_defined/3, 44 xref_definition_line/2, 45 xref_exported/2, 46 xref_module/2, 47 xref_uses_file/3, 48 xref_op/2, 49 xref_prolog_flag/4, 50 xref_comment/3, 51 xref_comment/4, 52 xref_mode/3, 53 xref_option/2, 54 xref_clean/1, 55 xref_current_source/1, 56 xref_done/2, 57 xref_built_in/1, 58 xref_source_file/3, 59 xref_source_file/4, 60 xref_public_list/3, 61 xref_public_list/4, 62 xref_public_list/6, 63 xref_public_list/7, 64 xref_meta/3, 65 xref_meta/2, 66 xref_hook/1, 67 68 xref_used_class/2, 69 xref_defined_class/3 70 ]). 71:- autoload(library(apply),[maplist/2,partition/4,maplist/3]). 72:- autoload(library(debug),[debug/3]). 73:- autoload(library(dialect),[expects_dialect/1]). 74:- autoload(library(error),[must_be/2,instantiation_error/1]). 75:- autoload(library(lists),[member/2,append/2,append/3,select/3]). 76:- autoload(library(modules),[in_temporary_module/3]). 77:- autoload(library(operators),[push_op/3]). 78:- autoload(library(option),[option/2,option/3]). 79:- autoload(library(ordsets),[ord_intersect/2,ord_intersection/3]). 80:- autoload(library(prolog_source),
81 [ prolog_canonical_source/2,
82 prolog_open_source/2,
83 prolog_close_source/1,
84 prolog_read_source_term/4
85 ]). 86:- autoload(library(shlib),[current_foreign_library/2]). 87:- autoload(library(solution_sequences),[distinct/2,limit/2]). 88
89:- if(exists_source(library(pldoc))). 90:- use_module(library(pldoc), []). 91:- use_module(library(pldoc/doc_process)). 92:- endif. 93
94:- predicate_options(xref_source/2, 2,
95 [ silent(boolean),
96 module(atom),
97 register_called(oneof([all,non_iso,non_built_in])),
98 comments(oneof([store,collect,ignore])),
99 process_include(boolean)
100 ]). 101
102
103:- dynamic
104 called/5, 105 (dynamic)/3, 106 (thread_local)/3, 107 (multifile)/3, 108 (public)/3, 109 defined/3, 110 meta_goal/3, 111 foreign/3, 112 constraint/3, 113 imported/3, 114 exported/2, 115 xmodule/2, 116 uses_file/3, 117 xop/2, 118 source/2, 119 used_class/2, 120 defined_class/5, 121 (mode)/2, 122 xoption/2, 123 xflag/4, 124
125 module_comment/3, 126 pred_comment/4, 127 pred_comment_link/3, 128 pred_mode/3. 129
130:- create_prolog_flag(xref, false, [type(boolean)]). 131
166
167:- predicate_options(xref_source_file/4, 4,
168 [ file_type(oneof([txt,prolog,directory])),
169 silent(boolean)
170 ]). 171:- predicate_options(xref_public_list/3, 3,
172 [ path(-atom),
173 module(-atom),
174 exports(-list(any)),
175 public(-list(any)),
176 meta(-list(any)),
177 silent(boolean)
178 ]). 179
180
181 184
191
199
204
209
210:- multifile
211 prolog:called_by/4, 212 prolog:called_by/2, 213 prolog:meta_goal/2, 214 prolog:hook/1, 215 prolog:generated_predicate/1, 216 prolog:no_autoload_module/1. 217
218:- meta_predicate
219 prolog:generated_predicate(:). 220
221:- dynamic
222 meta_goal/2. 223
224:- meta_predicate
225 process_predicates(2, +, +). 226
227 230
236
237hide_called(Callable, Src) :-
238 xoption(Src, register_called(Which)),
239 !,
240 mode_hide_called(Which, Callable).
241hide_called(Callable, _) :-
242 mode_hide_called(non_built_in, Callable).
243
244mode_hide_called(all, _) :- !, fail.
245mode_hide_called(non_iso, _:Goal) :-
246 goal_name_arity(Goal, Name, Arity),
247 current_predicate(system:Name/Arity),
248 predicate_property(system:Goal, iso).
249mode_hide_called(non_built_in, _:Goal) :-
250 goal_name_arity(Goal, Name, Arity),
251 current_predicate(system:Name/Arity),
252 predicate_property(system:Goal, built_in).
253mode_hide_called(non_built_in, M:Goal) :-
254 goal_name_arity(Goal, Name, Arity),
255 current_predicate(M:Name/Arity),
256 predicate_property(M:Goal, built_in).
257
261
262system_predicate(Goal) :-
263 goal_name_arity(Goal, Name, Arity),
264 current_predicate(system:Name/Arity), 265 predicate_property(system:Goal, built_in),
266 !.
267
268
269 272
273verbose(Src) :-
274 \+ xoption(Src, silent(true)).
275
276:- thread_local
277 xref_input/2. 278
279
304
305xref_source(Source) :-
306 xref_source(Source, []).
307
308xref_source(Source, Options) :-
309 prolog_canonical_source(Source, Src),
310 ( last_modified(Source, Modified)
311 -> ( source(Src, Modified)
312 -> true
313 ; xref_clean(Src),
314 assert(source(Src, Modified)),
315 do_xref(Src, Options)
316 )
317 ; xref_clean(Src),
318 get_time(Now),
319 assert(source(Src, Now)),
320 do_xref(Src, Options)
321 ).
322
323do_xref(Src, Options) :-
324 must_be(list, Options),
325 setup_call_cleanup(
326 xref_setup(Src, In, Options, State),
327 collect(Src, Src, In, Options),
328 xref_cleanup(State)).
329
330last_modified(Source, Modified) :-
331 prolog:xref_source_time(Source, Modified),
332 !.
333last_modified(Source, Modified) :-
334 atom(Source),
335 \+ is_global_url(Source),
336 exists_file(Source),
337 time_file(Source, Modified).
338
339is_global_url(File) :-
340 sub_atom(File, B, _, _, '://'),
341 !,
342 B > 1,
343 sub_atom(File, 0, B, _, Scheme),
344 atom_codes(Scheme, Codes),
345 maplist(between(0'a, 0'z), Codes).
346
347xref_setup(Src, In, Options, state(In, Dialect, Xref, [SRef|HRefs])) :-
348 maplist(assert_option(Src), Options),
349 assert_default_options(Src),
350 current_prolog_flag(emulated_dialect, Dialect),
351 prolog_open_source(Src, In),
352 set_initial_mode(In, Options),
353 asserta(xref_input(Src, In), SRef),
354 set_xref(Xref),
355 ( verbose(Src)
356 -> HRefs = []
357 ; asserta(user:thread_message_hook(_,_,_), Ref),
358 HRefs = [Ref]
359 ).
360
361assert_option(_, Var) :-
362 var(Var),
363 !,
364 instantiation_error(Var).
365assert_option(Src, silent(Boolean)) :-
366 !,
367 must_be(boolean, Boolean),
368 assert(xoption(Src, silent(Boolean))).
369assert_option(Src, register_called(Which)) :-
370 !,
371 must_be(oneof([all,non_iso,non_built_in]), Which),
372 assert(xoption(Src, register_called(Which))).
373assert_option(Src, comments(CommentHandling)) :-
374 !,
375 must_be(oneof([store,collect,ignore]), CommentHandling),
376 assert(xoption(Src, comments(CommentHandling))).
377assert_option(Src, module(Module)) :-
378 !,
379 must_be(atom, Module),
380 assert(xoption(Src, module(Module))).
381assert_option(Src, process_include(Boolean)) :-
382 !,
383 must_be(boolean, Boolean),
384 assert(xoption(Src, process_include(Boolean))).
385
386assert_default_options(Src) :-
387 ( xref_option_default(Opt),
388 generalise_term(Opt, Gen),
389 ( xoption(Src, Gen)
390 -> true
391 ; assertz(xoption(Src, Opt))
392 ),
393 fail
394 ; true
395 ).
396
397xref_option_default(silent(false)).
398xref_option_default(register_called(non_built_in)).
399xref_option_default(comments(collect)).
400xref_option_default(process_include(true)).
401
405
406xref_cleanup(state(In, Dialect, Xref, Refs)) :-
407 prolog_close_source(In),
408 set_prolog_flag(emulated_dialect, Dialect),
409 set_prolog_flag(xref, Xref),
410 maplist(erase, Refs).
411
412set_xref(Xref) :-
413 current_prolog_flag(xref, Xref),
414 set_prolog_flag(xref, true).
415
422
423set_initial_mode(_Stream, Options) :-
424 option(module(Module), Options),
425 !,
426 '$set_source_module'(Module).
427set_initial_mode(Stream, _) :-
428 stream_property(Stream, file_name(Path)),
429 source_file_property(Path, load_context(M, _, Opts)),
430 !,
431 '$set_source_module'(M),
432 ( option(dialect(Dialect), Opts)
433 -> expects_dialect(Dialect)
434 ; true
435 ).
436set_initial_mode(_, _) :-
437 '$set_source_module'(user).
438
442
443xref_input_stream(Stream) :-
444 xref_input(_, Var),
445 !,
446 Stream = Var.
447
452
453xref_push_op(Src, P, T, N0) :-
454 '$current_source_module'(M0),
455 strip_module(M0:N0, M, N),
456 ( is_list(N),
457 N \== []
458 -> maplist(push_op(Src, P, T, M), N)
459 ; push_op(Src, P, T, M, N)
460 ).
461
462push_op(Src, P, T, M0, N0) :-
463 strip_module(M0:N0, M, N),
464 Name = M:N,
465 valid_op(op(P,T,Name)),
466 push_op(P, T, Name),
467 assert_op(Src, op(P,T,Name)),
468 debug(xref(op), ':- ~w.', [op(P,T,Name)]).
469
470valid_op(op(P,T,M:N)) :-
471 atom(M),
472 valid_op_name(N),
473 integer(P),
474 between(0, 1200, P),
475 atom(T),
476 op_type(T).
477
478valid_op_name(N) :-
479 atom(N),
480 !.
481valid_op_name(N) :-
482 N == [].
483
484op_type(xf).
485op_type(yf).
486op_type(fx).
487op_type(fy).
488op_type(xfx).
489op_type(xfy).
490op_type(yfx).
491
495
496xref_set_prolog_flag(Flag, Value, Src, Line) :-
497 atom(Flag),
498 !,
499 assertz(xflag(Flag, Value, Src, Line)).
500xref_set_prolog_flag(_, _, _, _).
501
505
506xref_clean(Source) :-
507 prolog_canonical_source(Source, Src),
508 retractall(called(_, Src, _Origin, _Cond, _Line)),
509 retractall(dynamic(_, Src, Line)),
510 retractall(multifile(_, Src, Line)),
511 retractall(public(_, Src, Line)),
512 retractall(defined(_, Src, Line)),
513 retractall(meta_goal(_, _, Src)),
514 retractall(foreign(_, Src, Line)),
515 retractall(constraint(_, Src, Line)),
516 retractall(imported(_, Src, _From)),
517 retractall(exported(_, Src)),
518 retractall(uses_file(_, Src, _)),
519 retractall(xmodule(_, Src)),
520 retractall(xop(Src, _)),
521 retractall(xoption(Src, _)),
522 retractall(xflag(_Name, _Value, Src, Line)),
523 retractall(source(Src, _)),
524 retractall(used_class(_, Src)),
525 retractall(defined_class(_, _, _, Src, _)),
526 retractall(mode(_, Src)),
527 retractall(module_comment(Src, _, _)),
528 retractall(pred_comment(_, Src, _, _)),
529 retractall(pred_comment_link(_, Src, _)),
530 retractall(pred_mode(_, Src, _)).
531
532
533 536
540
541xref_current_source(Source) :-
542 source(Source, _Time).
543
544
548
549xref_done(Source, Time) :-
550 prolog_canonical_source(Source, Src),
551 source(Src, Time).
552
553
572
573xref_called(Source, Called, By) :-
574 xref_called(Source, Called, By, _).
575
576xref_called(Source, Called, By, Cond) :-
577 canonical_source(Source, Src),
578 distinct(Called-By, called(Called, Src, By, Cond, _)).
579
580xref_called(Source, Called, By, Cond, Line) :-
581 canonical_source(Source, Src),
582 called(Called, Src, By, Cond, Line).
583
602
603xref_defined(Source, Called, How) :-
604 nonvar(Source),
605 !,
606 canonical_source(Source, Src),
607 xref_defined2(How, Src, Called).
608xref_defined(Source, Called, How) :-
609 xref_defined2(How, Src, Called),
610 canonical_source(Source, Src).
611
612xref_defined2(dynamic(Line), Src, Called) :-
613 dynamic(Called, Src, Line).
614xref_defined2(thread_local(Line), Src, Called) :-
615 thread_local(Called, Src, Line).
616xref_defined2(multifile(Line), Src, Called) :-
617 multifile(Called, Src, Line).
618xref_defined2(public(Line), Src, Called) :-
619 public(Called, Src, Line).
620xref_defined2(local(Line), Src, Called) :-
621 defined(Called, Src, Line).
622xref_defined2(foreign(Line), Src, Called) :-
623 foreign(Called, Src, Line).
624xref_defined2(constraint(Line), Src, Called) :-
625 constraint(Called, Src, Line).
626xref_defined2(imported(From), Src, Called) :-
627 imported(Called, Src, From).
628
629
634
635xref_definition_line(local(Line), Line).
636xref_definition_line(dynamic(Line), Line).
637xref_definition_line(thread_local(Line), Line).
638xref_definition_line(multifile(Line), Line).
639xref_definition_line(public(Line), Line).
640xref_definition_line(constraint(Line), Line).
641xref_definition_line(foreign(Line), Line).
642
643
647
648xref_exported(Source, Called) :-
649 prolog_canonical_source(Source, Src),
650 exported(Called, Src).
651
655
656xref_module(Source, Module) :-
657 nonvar(Source),
658 !,
659 prolog_canonical_source(Source, Src),
660 xmodule(Module, Src).
661xref_module(Source, Module) :-
662 xmodule(Module, Src),
663 prolog_canonical_source(Source, Src).
664
672
673xref_uses_file(Source, Spec, Path) :-
674 prolog_canonical_source(Source, Src),
675 uses_file(Spec, Src, Path).
676
684
685xref_op(Source, Op) :-
686 prolog_canonical_source(Source, Src),
687 xop(Src, Op).
688
694
695xref_prolog_flag(Source, Flag, Value, Line) :-
696 prolog_canonical_source(Source, Src),
697 xflag(Flag, Value, Src, Line).
698
699xref_built_in(Head) :-
700 system_predicate(Head).
701
702xref_used_class(Source, Class) :-
703 prolog_canonical_source(Source, Src),
704 used_class(Class, Src).
705
706xref_defined_class(Source, Class, local(Line, Super, Summary)) :-
707 prolog_canonical_source(Source, Src),
708 defined_class(Class, Super, Summary, Src, Line),
709 integer(Line),
710 !.
711xref_defined_class(Source, Class, file(File)) :-
712 prolog_canonical_source(Source, Src),
713 defined_class(Class, _, _, Src, file(File)).
714
715:- thread_local
716 current_cond/1,
717 source_line/1. 718
719current_source_line(Line) :-
720 source_line(Var),
721 !,
722 Line = Var.
723
729
730collect(Src, File, In, Options) :-
731 ( Src == File
732 -> SrcSpec = Line
733 ; SrcSpec = (File:Line)
734 ),
735 option(comments(CommentHandling), Options, collect),
736 ( CommentHandling == ignore
737 -> CommentOptions = [],
738 Comments = []
739 ; CommentHandling == store
740 -> CommentOptions = [ process_comment(true) ],
741 Comments = []
742 ; CommentOptions = [ comments(Comments) ]
743 ),
744 repeat,
745 catch(prolog_read_source_term(
746 In, Term, Expanded,
747 [ term_position(TermPos)
748 | CommentOptions
749 ]),
750 E, report_syntax_error(E, Src, [])),
751 update_condition(Term),
752 stream_position_data(line_count, TermPos, Line),
753 setup_call_cleanup(
754 asserta(source_line(SrcSpec), Ref),
755 catch(process(Expanded, Comments, Term, TermPos, Src, EOF),
756 E, print_message(error, E)),
757 erase(Ref)),
758 EOF == true,
759 !.
760
761report_syntax_error(E, _, _) :-
762 fatal_error(E),
763 throw(E).
764report_syntax_error(_, _, Options) :-
765 option(silent(true), Options),
766 !,
767 fail.
768report_syntax_error(E, Src, _Options) :-
769 ( verbose(Src)
770 -> print_message(error, E)
771 ; true
772 ),
773 fail.
774
775fatal_error(time_limit_exceeded).
776fatal_error(error(resource_error(_),_)).
777
781
782update_condition((:-Directive)) :-
783 !,
784 update_cond(Directive).
785update_condition(_).
786
787update_cond(if(Cond)) :-
788 !,
789 asserta(current_cond(Cond)).
790update_cond(else) :-
791 retract(current_cond(C0)),
792 !,
793 assert(current_cond(\+C0)).
794update_cond(elif(Cond)) :-
795 retract(current_cond(C0)),
796 !,
797 assert(current_cond((\+C0,Cond))).
798update_cond(endif) :-
799 retract(current_cond(_)),
800 !.
801update_cond(_).
802
807
808current_condition(Condition) :-
809 \+ current_cond(_),
810 !,
811 Condition = true.
812current_condition(Condition) :-
813 findall(C, current_cond(C), List),
814 list_to_conj(List, Condition).
815
816list_to_conj([], true).
817list_to_conj([C], C) :- !.
818list_to_conj([H|T], (H,C)) :-
819 list_to_conj(T, C).
820
821
822 825
835
836process(Expanded, Comments, Term0, TermPos, Src, EOF) :-
837 is_list(Expanded), 838 !,
839 ( member(Term, Expanded),
840 process(Term, Term0, Src),
841 Term == end_of_file
842 -> EOF = true
843 ; EOF = false
844 ),
845 xref_comments(Comments, TermPos, Src).
846process(end_of_file, _, _, _, _, true) :-
847 !.
848process(Term, Comments, Term0, TermPos, Src, false) :-
849 process(Term, Term0, Src),
850 xref_comments(Comments, TermPos, Src).
851
853
854process(_, Term0, _) :-
855 ignore_raw_term(Term0),
856 !.
857process(Term, _Term0, Src) :-
858 process(Term, Src).
859
860ignore_raw_term((:- predicate_options(_,_,_))).
861
863
864process(Var, _) :-
865 var(Var),
866 !. 867process(end_of_file, _) :- !.
868process((:- Directive), Src) :-
869 !,
870 process_directive(Directive, Src),
871 !.
872process((?- Directive), Src) :-
873 !,
874 process_directive(Directive, Src),
875 !.
876process((Head :- Body), Src) :-
877 !,
878 assert_defined(Src, Head),
879 process_body(Body, Head, Src).
880process('$source_location'(_File, _Line):Clause, Src) :-
881 !,
882 process(Clause, Src).
883process(Term, Src) :-
884 process_chr(Term, Src),
885 !.
886process(M:(Head :- Body), Src) :-
887 !,
888 process((M:Head :- M:Body), Src).
889process(Head, Src) :-
890 assert_defined(Src, Head).
891
892
893 896
898
([], _Pos, _Src).
900:- if(current_predicate(parse_comment/3)). 901xref_comments([Pos-Comment|T], TermPos, Src) :-
902 ( Pos @> TermPos 903 -> true
904 ; stream_position_data(line_count, Pos, Line),
905 FilePos = Src:Line,
906 ( parse_comment(Comment, FilePos, Parsed)
907 -> assert_comments(Parsed, Src)
908 ; true
909 ),
910 xref_comments(T, TermPos, Src)
911 ).
912
([], _).
914assert_comments([H|T], Src) :-
915 assert_comment(H, Src),
916 assert_comments(T, Src).
917
(section(_Id, Title, Comment), Src) :-
919 assertz(module_comment(Src, Title, Comment)).
920assert_comment(predicate(PI, Summary, Comment), Src) :-
921 pi_to_head(PI, Src, Head),
922 assertz(pred_comment(Head, Src, Summary, Comment)).
923assert_comment(link(PI, PITo), Src) :-
924 pi_to_head(PI, Src, Head),
925 pi_to_head(PITo, Src, HeadTo),
926 assertz(pred_comment_link(Head, Src, HeadTo)).
927assert_comment(mode(Head, Det), Src) :-
928 assertz(pred_mode(Head, Src, Det)).
929
930pi_to_head(PI, Src, Head) :-
931 pi_to_head(PI, Head0),
932 ( Head0 = _:_
933 -> strip_module(Head0, M, Plain),
934 ( xmodule(M, Src)
935 -> Head = Plain
936 ; Head = M:Plain
937 )
938 ; Head = Head0
939 ).
940:- endif. 941
945
(Source, Title, Comment) :-
947 canonical_source(Source, Src),
948 module_comment(Src, Title, Comment).
949
953
(Source, Head, Summary, Comment) :-
955 canonical_source(Source, Src),
956 ( pred_comment(Head, Src, Summary, Comment)
957 ; pred_comment_link(Head, Src, HeadTo),
958 pred_comment(HeadTo, Src, Summary, Comment)
959 ).
960
965
966xref_mode(Source, Mode, Det) :-
967 canonical_source(Source, Src),
968 pred_mode(Mode, Src, Det).
969
974
975xref_option(Source, Option) :-
976 canonical_source(Source, Src),
977 xoption(Src, Option).
978
979
980 983
984process_directive(Var, _) :-
985 var(Var),
986 !. 987process_directive(Dir, _Src) :-
988 debug(xref(directive), 'Processing :- ~q', [Dir]),
989 fail.
990process_directive((A,B), Src) :- 991 !,
992 process_directive(A, Src), 993 process_directive(B, Src).
994process_directive(List, Src) :-
995 is_list(List),
996 !,
997 process_directive(consult(List), Src).
998process_directive(use_module(File, Import), Src) :-
999 process_use_module2(File, Import, Src, false).
1000process_directive(autoload(File, Import), Src) :-
1001 process_use_module2(File, Import, Src, false).
1002process_directive(require(Import), Src) :-
1003 process_requires(Import, Src).
1004process_directive(expects_dialect(Dialect), Src) :-
1005 process_directive(use_module(library(dialect/Dialect)), Src),
1006 expects_dialect(Dialect).
1007process_directive(reexport(File, Import), Src) :-
1008 process_use_module2(File, Import, Src, true).
1009process_directive(reexport(Modules), Src) :-
1010 process_use_module(Modules, Src, true).
1011process_directive(autoload(Modules), Src) :-
1012 process_use_module(Modules, Src, false).
1013process_directive(use_module(Modules), Src) :-
1014 process_use_module(Modules, Src, false).
1015process_directive(consult(Modules), Src) :-
1016 process_use_module(Modules, Src, false).
1017process_directive(ensure_loaded(Modules), Src) :-
1018 process_use_module(Modules, Src, false).
1019process_directive(load_files(Files, _Options), Src) :-
1020 process_use_module(Files, Src, false).
1021process_directive(include(Files), Src) :-
1022 process_include(Files, Src).
1023process_directive(dynamic(Dynamic), Src) :-
1024 process_predicates(assert_dynamic, Dynamic, Src).
1025process_directive(dynamic(Dynamic, _Options), Src) :-
1026 process_predicates(assert_dynamic, Dynamic, Src).
1027process_directive(thread_local(Dynamic), Src) :-
1028 process_predicates(assert_thread_local, Dynamic, Src).
1029process_directive(multifile(Dynamic), Src) :-
1030 process_predicates(assert_multifile, Dynamic, Src).
1031process_directive(public(Public), Src) :-
1032 process_predicates(assert_public, Public, Src).
1033process_directive(export(Export), Src) :-
1034 process_predicates(assert_export, Export, Src).
1035process_directive(import(Import), Src) :-
1036 process_import(Import, Src).
1037process_directive(module(Module, Export), Src) :-
1038 assert_module(Src, Module),
1039 assert_module_export(Src, Export).
1040process_directive(module(Module, Export, Import), Src) :-
1041 assert_module(Src, Module),
1042 assert_module_export(Src, Export),
1043 assert_module3(Import, Src).
1044process_directive('$set_source_module'(system), Src) :-
1045 assert_module(Src, system). 1046process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :-
1047 assert_defined_class(Src, Name, Meta, Super, Doc).
1048process_directive(pce_autoload(Name, From), Src) :-
1049 assert_defined_class(Src, Name, imported_from(From)).
1050
1051process_directive(op(P, A, N), Src) :-
1052 xref_push_op(Src, P, A, N).
1053process_directive(set_prolog_flag(Flag, Value), Src) :-
1054 ( Flag == character_escapes
1055 -> set_prolog_flag(character_escapes, Value)
1056 ; true
1057 ),
1058 current_source_line(Line),
1059 xref_set_prolog_flag(Flag, Value, Src, Line).
1060process_directive(style_check(X), _) :-
1061 style_check(X).
1062process_directive(encoding(Enc), _) :-
1063 ( xref_input_stream(Stream)
1064 -> catch(set_stream(Stream, encoding(Enc)), _, true)
1065 ; true 1066 ).
1067process_directive(pce_expansion:push_compile_operators, _) :-
1068 '$current_source_module'(SM),
1069 call(pce_expansion:push_compile_operators(SM)). 1070process_directive(pce_expansion:pop_compile_operators, _) :-
1071 call(pce_expansion:pop_compile_operators).
1072process_directive(meta_predicate(Meta), Src) :-
1073 process_meta_predicate(Meta, Src).
1074process_directive(arithmetic_function(FSpec), Src) :-
1075 arith_callable(FSpec, Goal),
1076 !,
1077 current_source_line(Line),
1078 assert_called(Src, '<directive>'(Line), Goal, Line).
1079process_directive(format_predicate(_, Goal), Src) :-
1080 !,
1081 current_source_line(Line),
1082 assert_called(Src, '<directive>'(Line), Goal, Line).
1083process_directive(if(Cond), Src) :-
1084 !,
1085 current_source_line(Line),
1086 assert_called(Src, '<directive>'(Line), Cond, Line).
1087process_directive(elif(Cond), Src) :-
1088 !,
1089 current_source_line(Line),
1090 assert_called(Src, '<directive>'(Line), Cond, Line).
1091process_directive(else, _) :- !.
1092process_directive(endif, _) :- !.
1093process_directive(Goal, Src) :-
1094 current_source_line(Line),
1095 process_body(Goal, '<directive>'(Line), Src).
1096
1100
1101process_meta_predicate((A,B), Src) :-
1102 !,
1103 process_meta_predicate(A, Src),
1104 process_meta_predicate(B, Src).
1105process_meta_predicate(Decl, Src) :-
1106 process_meta_head(Src, Decl).
1107
1108process_meta_head(Src, Decl) :- 1109 compound(Decl),
1110 compound_name_arity(Decl, Name, Arity),
1111 compound_name_arity(Head, Name, Arity),
1112 meta_args(1, Arity, Decl, Head, Meta),
1113 ( ( prolog:meta_goal(Head, _)
1114 ; prolog:called_by(Head, _, _, _)
1115 ; prolog:called_by(Head, _)
1116 ; meta_goal(Head, _)
1117 )
1118 -> true
1119 ; assert(meta_goal(Head, Meta, Src))
1120 ).
1121
1122meta_args(I, Arity, _, _, []) :-
1123 I > Arity,
1124 !.
1125meta_args(I, Arity, Decl, Head, [H|T]) :- 1126 arg(I, Decl, 0),
1127 !,
1128 arg(I, Head, H),
1129 I2 is I + 1,
1130 meta_args(I2, Arity, Decl, Head, T).
1131meta_args(I, Arity, Decl, Head, [H|T]) :- 1132 arg(I, Decl, ^),
1133 !,
1134 arg(I, Head, EH),
1135 setof_goal(EH, H),
1136 I2 is I + 1,
1137 meta_args(I2, Arity, Decl, Head, T).
1138meta_args(I, Arity, Decl, Head, [//(H)|T]) :-
1139 arg(I, Decl, //),
1140 !,
1141 arg(I, Head, H),
1142 I2 is I + 1,
1143 meta_args(I2, Arity, Decl, Head, T).
1144meta_args(I, Arity, Decl, Head, [H+A|T]) :- 1145 arg(I, Decl, A),
1146 integer(A), A > 0,
1147 !,
1148 arg(I, Head, H),
1149 I2 is I + 1,
1150 meta_args(I2, Arity, Decl, Head, T).
1151meta_args(I, Arity, Decl, Head, Meta) :-
1152 I2 is I + 1,
1153 meta_args(I2, Arity, Decl, Head, Meta).
1154
1155
1156 1159
1166
1167xref_meta(Source, Head, Called) :-
1168 canonical_source(Source, Src),
1169 xref_meta_src(Head, Called, Src).
1170
1183
1184xref_meta_src(Head, Called, Src) :-
1185 meta_goal(Head, Called, Src),
1186 !.
1187xref_meta_src(Head, Called, _) :-
1188 xref_meta(Head, Called),
1189 !.
1190xref_meta_src(Head, Called, _) :-
1191 compound(Head),
1192 compound_name_arity(Head, Name, Arity),
1193 apply_pred(Name),
1194 Arity > 5,
1195 !,
1196 Extra is Arity - 1,
1197 arg(1, Head, G),
1198 Called = [G+Extra].
1199xref_meta_src(Head, Called, _) :-
1200 predicate_property(user:Head, meta_predicate(Meta)),
1201 !,
1202 Meta =.. [_|Args],
1203 meta_args(Args, 1, Head, Called).
1204
1205meta_args([], _, _, []).
1206meta_args([H0|T0], I, Head, [H|T]) :-
1207 xargs(H0, N),
1208 !,
1209 arg(I, Head, A),
1210 ( N == 0
1211 -> H = A
1212 ; H = (A+N)
1213 ),
1214 I2 is I+1,
1215 meta_args(T0, I2, Head, T).
1216meta_args([_|T0], I, Head, T) :-
1217 I2 is I+1,
1218 meta_args(T0, I2, Head, T).
1219
1220xargs(N, N) :- integer(N), !.
1221xargs(//, 2).
1222xargs(^, 0).
1223
1224apply_pred(call). 1225apply_pred(maplist). 1226
1227xref_meta((A, B), [A, B]).
1228xref_meta((A; B), [A, B]).
1229xref_meta((A| B), [A, B]).
1230xref_meta((A -> B), [A, B]).
1231xref_meta((A *-> B), [A, B]).
1232xref_meta(findall(_V,G,_L), [G]).
1233xref_meta(findall(_V,G,_L,_T), [G]).
1234xref_meta(findnsols(_N,_V,G,_L), [G]).
1235xref_meta(findnsols(_N,_V,G,_L,_T), [G]).
1236xref_meta(setof(_V, EG, _L), [G]) :-
1237 setof_goal(EG, G).
1238xref_meta(bagof(_V, EG, _L), [G]) :-
1239 setof_goal(EG, G).
1240xref_meta(forall(A, B), [A, B]).
1241xref_meta(maplist(G,_), [G+1]).
1242xref_meta(maplist(G,_,_), [G+2]).
1243xref_meta(maplist(G,_,_,_), [G+3]).
1244xref_meta(maplist(G,_,_,_,_), [G+4]).
1245xref_meta(map_list_to_pairs(G,_,_), [G+2]).
1246xref_meta(map_assoc(G, _), [G+1]).
1247xref_meta(map_assoc(G, _, _), [G+2]).
1248xref_meta(checklist(G, _L), [G+1]).
1249xref_meta(sublist(G, _, _), [G+1]).
1250xref_meta(include(G, _, _), [G+1]).
1251xref_meta(exclude(G, _, _), [G+1]).
1252xref_meta(partition(G, _, _, _, _), [G+2]).
1253xref_meta(partition(G, _, _, _),[G+1]).
1254xref_meta(call(G), [G]).
1255xref_meta(call(G, _), [G+1]).
1256xref_meta(call(G, _, _), [G+2]).
1257xref_meta(call(G, _, _, _), [G+3]).
1258xref_meta(call(G, _, _, _, _), [G+4]).
1259xref_meta(not(G), [G]).
1260xref_meta(notrace(G), [G]).
1261xref_meta(\+(G), [G]).
1262xref_meta(ignore(G), [G]).
1263xref_meta(once(G), [G]).
1264xref_meta(initialization(G), [G]).
1265xref_meta(initialization(G,_), [G]).
1266xref_meta(retract(Rule), [G]) :- head_of(Rule, G).
1267xref_meta(clause(G, _), [G]).
1268xref_meta(clause(G, _, _), [G]).
1269xref_meta(phrase(G, _A), [//(G)]).
1270xref_meta(phrase(G, _A, _R), [//(G)]).
1271xref_meta(call_dcg(G, _A, _R), [//(G)]).
1272xref_meta(phrase_from_file(G,_),[//(G)]).
1273xref_meta(catch(A, _, B), [A, B]).
1274xref_meta(catch_with_backtrace(A, _, B), [A, B]).
1275xref_meta(thread_create(A,_,_), [A]).
1276xref_meta(thread_create(A,_), [A]).
1277xref_meta(thread_signal(_,A), [A]).
1278xref_meta(thread_idle(A,_), [A]).
1279xref_meta(thread_at_exit(A), [A]).
1280xref_meta(thread_initialization(A), [A]).
1281xref_meta(engine_create(_,A,_), [A]).
1282xref_meta(engine_create(_,A,_,_), [A]).
1283xref_meta(transaction(A), [A]).
1284xref_meta(transaction(A,B,_), [A,B]).
1285xref_meta(snapshot(A), [A]).
1286xref_meta(predsort(A,_,_), [A+3]).
1287xref_meta(call_cleanup(A, B), [A, B]).
1288xref_meta(call_cleanup(A, _, B),[A, B]).
1289xref_meta(setup_call_cleanup(A, B, C),[A, B, C]).
1290xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]).
1291xref_meta(call_residue_vars(A,_), [A]).
1292xref_meta(with_mutex(_,A), [A]).
1293xref_meta(assume(G), [G]). 1294xref_meta(assertion(G), [G]). 1295xref_meta(freeze(_, G), [G]).
1296xref_meta(when(C, A), [C, A]).
1297xref_meta(time(G), [G]). 1298xref_meta(call_time(G, _), [G]). 1299xref_meta(call_time(G, _, _), [G]). 1300xref_meta(profile(G), [G]).
1301xref_meta(at_halt(G), [G]).
1302xref_meta(call_with_time_limit(_, G), [G]).
1303xref_meta(call_with_depth_limit(G, _, _), [G]).
1304xref_meta(call_with_inference_limit(G, _, _), [G]).
1305xref_meta(alarm(_, G, _), [G]).
1306xref_meta(alarm(_, G, _, _), [G]).
1307xref_meta('$add_directive_wic'(G), [G]).
1308xref_meta(with_output_to(_, G), [G]).
1309xref_meta(if(G), [G]).
1310xref_meta(elif(G), [G]).
1311xref_meta(meta_options(G,_,_), [G+1]).
1312xref_meta(on_signal(_,_,H), [H+1]) :- H \== default.
1313xref_meta(distinct(G), [G]). 1314xref_meta(distinct(_, G), [G]).
1315xref_meta(order_by(_, G), [G]).
1316xref_meta(limit(_, G), [G]).
1317xref_meta(offset(_, G), [G]).
1318xref_meta(reset(G,_,_), [G]).
1319xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N).
1320xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N).
1321xref_meta(tnot(G), [G]).
1322xref_meta(not_exists(G), [G]).
1323xref_meta(with_tty_raw(G), [G]).
1324
1325 1326xref_meta(pce_global(_, new(_)), _) :- !, fail.
1327xref_meta(pce_global(_, B), [B+1]).
1328xref_meta(ifmaintainer(G), [G]). 1329xref_meta(listen(_, G), [G]). 1330xref_meta(listen(_, _, G), [G]).
1331xref_meta(in_pce_thread(G), [G]).
1332
1333xref_meta(G, Meta) :- 1334 prolog:meta_goal(G, Meta).
1335xref_meta(G, Meta) :- 1336 meta_goal(G, Meta).
1337
1338setof_goal(EG, G) :-
1339 var(EG), !, G = EG.
1340setof_goal(_^EG, G) :-
1341 !,
1342 setof_goal(EG, G).
1343setof_goal(G, G).
1344
1345event_xargs(abort, 0).
1346event_xargs(erase, 1).
1347event_xargs(break, 3).
1348event_xargs(frame_finished, 1).
1349event_xargs(thread_exit, 1).
1350event_xargs(this_thread_exit, 0).
1351event_xargs(PI, 2) :- pi_to_head(PI, _).
1352
1356
1357head_of(Var, _) :-
1358 var(Var), !, fail.
1359head_of((Head :- _), Head).
1360head_of(Head, Head).
1361
1367
1368xref_hook(Hook) :-
1369 prolog:hook(Hook).
1370xref_hook(Hook) :-
1371 hook(Hook).
1372
1373
1374hook(attr_portray_hook(_,_)).
1375hook(attr_unify_hook(_,_)).
1376hook(attribute_goals(_,_,_)).
1377hook(goal_expansion(_,_)).
1378hook(term_expansion(_,_)).
1379hook(resource(_,_,_)).
1380hook('$pred_option'(_,_,_,_)).
1381
1382hook(emacs_prolog_colours:goal_classification(_,_)).
1383hook(emacs_prolog_colours:term_colours(_,_)).
1384hook(emacs_prolog_colours:goal_colours(_,_)).
1385hook(emacs_prolog_colours:style(_,_)).
1386hook(emacs_prolog_colours:identify(_,_)).
1387hook(pce_principal:pce_class(_,_,_,_,_,_)).
1388hook(pce_principal:send_implementation(_,_,_)).
1389hook(pce_principal:get_implementation(_,_,_,_)).
1390hook(pce_principal:pce_lazy_get_method(_,_,_)).
1391hook(pce_principal:pce_lazy_send_method(_,_,_)).
1392hook(pce_principal:pce_uses_template(_,_)).
1393hook(prolog:locate_clauses(_,_)).
1394hook(prolog:message(_,_,_)).
1395hook(prolog:error_message(_,_,_)).
1396hook(prolog:message_location(_,_,_)).
1397hook(prolog:message_context(_,_,_)).
1398hook(prolog:message_line_element(_,_)).
1399hook(prolog:debug_control_hook(_)).
1400hook(prolog:help_hook(_)).
1401hook(prolog:show_profile_hook(_,_)).
1402hook(prolog:general_exception(_,_)).
1403hook(prolog:predicate_summary(_,_)).
1404hook(prolog:residual_goals(_,_)).
1405hook(prolog_edit:load).
1406hook(prolog_edit:locate(_,_,_)).
1407hook(shlib:unload_all_foreign_libraries).
1408hook(system:'$foreign_registered'(_, _)).
1409hook(predicate_options:option_decl(_,_,_)).
1410hook(user:exception(_,_,_)).
1411hook(user:file_search_path(_,_)).
1412hook(user:library_directory(_)).
1413hook(user:message_hook(_,_,_)).
1414hook(user:portray(_)).
1415hook(user:prolog_clause_name(_,_)).
1416hook(user:prolog_list_goal(_)).
1417hook(user:prolog_predicate_name(_,_)).
1418hook(user:prolog_trace_interception(_,_,_,_)).
1419hook(user:prolog_exception_hook(_,_,_,_)).
1420hook(sandbox:safe_primitive(_)).
1421hook(sandbox:safe_meta_predicate(_)).
1422hook(sandbox:safe_meta(_,_)).
1423hook(sandbox:safe_global_variable(_)).
1424hook(sandbox:safe_directive(_)).
1425
1426
1430
1431arith_callable(Var, _) :-
1432 var(Var), !, fail.
1433arith_callable(Module:Spec, Module:Goal) :-
1434 !,
1435 arith_callable(Spec, Goal).
1436arith_callable(Name/Arity, Goal) :-
1437 PredArity is Arity + 1,
1438 functor(Goal, Name, PredArity).
1439
1448
1449process_body(Body, Origin, Src) :-
1450 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1451 true).
1452
1457
1458process_goal(Var, _, _, _) :-
1459 var(Var),
1460 !.
1461process_goal(Goal, Origin, Src, P) :-
1462 Goal = (_,_), 1463 !,
1464 phrase(conjunction(Goal), Goals),
1465 process_conjunction(Goals, Origin, Src, P).
1466process_goal(Goal, Origin, Src, _) :- 1467 Goal = (_;_), 1468 !,
1469 phrase(disjunction(Goal), Goals),
1470 forall(member(G, Goals),
1471 process_body(G, Origin, Src)).
1472process_goal(Goal, Origin, Src, P) :-
1473 ( ( xmodule(M, Src)
1474 -> true
1475 ; M = user
1476 ),
1477 ( predicate_property(M:Goal, imported_from(IM))
1478 -> true
1479 ; IM = M
1480 ),
1481 prolog:called_by(Goal, IM, M, Called)
1482 ; prolog:called_by(Goal, Called)
1483 ),
1484 !,
1485 must_be(list, Called),
1486 current_source_line(Here),
1487 assert_called(Src, Origin, Goal, Here),
1488 process_called_list(Called, Origin, Src, P).
1489process_goal(Goal, Origin, Src, _) :-
1490 process_xpce_goal(Goal, Origin, Src),
1491 !.
1492process_goal(load_foreign_library(File), _Origin, Src, _) :-
1493 process_foreign(File, Src).
1494process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :-
1495 process_foreign(File, Src).
1496process_goal(use_foreign_library(File), _Origin, Src, _) :-
1497 process_foreign(File, Src).
1498process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :-
1499 process_foreign(File, Src).
1500process_goal(Goal, Origin, Src, P) :-
1501 xref_meta_src(Goal, Metas, Src),
1502 !,
1503 current_source_line(Here),
1504 assert_called(Src, Origin, Goal, Here),
1505 process_called_list(Metas, Origin, Src, P).
1506process_goal(Goal, Origin, Src, _) :-
1507 asserting_goal(Goal, Rule),
1508 !,
1509 current_source_line(Here),
1510 assert_called(Src, Origin, Goal, Here),
1511 process_assert(Rule, Origin, Src).
1512process_goal(Goal, Origin, Src, P) :-
1513 partial_evaluate(Goal, P),
1514 current_source_line(Here),
1515 assert_called(Src, Origin, Goal, Here).
1516
1517disjunction(Var) --> {var(Var), !}, [Var].
1518disjunction((A;B)) --> !, disjunction(A), disjunction(B).
1519disjunction(G) --> [G].
1520
1521conjunction(Var) --> {var(Var), !}, [Var].
1522conjunction((A,B)) --> !, conjunction(A), conjunction(B).
1523conjunction(G) --> [G].
1524
1525shares_vars(RVars, T) :-
1526 term_variables(T, TVars0),
1527 sort(TVars0, TVars),
1528 ord_intersect(RVars, TVars).
1529
1530process_conjunction([], _, _, _).
1531process_conjunction([Disj|Rest], Origin, Src, P) :-
1532 nonvar(Disj),
1533 Disj = (_;_),
1534 Rest \== [],
1535 !,
1536 phrase(disjunction(Disj), Goals),
1537 term_variables(Rest, RVars0),
1538 sort(RVars0, RVars),
1539 partition(shares_vars(RVars), Goals, Sharing, NonSHaring),
1540 forall(member(G, NonSHaring),
1541 process_body(G, Origin, Src)),
1542 ( Sharing == []
1543 -> true
1544 ; maplist(term_variables, Sharing, GVars0),
1545 append(GVars0, GVars1),
1546 sort(GVars1, GVars),
1547 ord_intersection(GVars, RVars, SVars),
1548 VT =.. [v|SVars],
1549 findall(VT,
1550 ( member(G, Sharing),
1551 process_goal(G, Origin, Src, PS),
1552 PS == true
1553 ),
1554 Alts0),
1555 ( Alts0 == []
1556 -> true
1557 ; ( true
1558 ; P = true,
1559 sort(Alts0, Alts1),
1560 variants(Alts1, 10, Alts),
1561 member(VT, Alts)
1562 )
1563 )
1564 ),
1565 process_conjunction(Rest, Origin, Src, P).
1566process_conjunction([H|T], Origin, Src, P) :-
1567 process_goal(H, Origin, Src, P),
1568 process_conjunction(T, Origin, Src, P).
1569
1570
1571process_called_list([], _, _, _).
1572process_called_list([H|T], Origin, Src, P) :-
1573 process_meta(H, Origin, Src, P),
1574 process_called_list(T, Origin, Src, P).
1575
1576process_meta(A+N, Origin, Src, P) :-
1577 !,
1578 ( extend(A, N, AX)
1579 -> process_goal(AX, Origin, Src, P)
1580 ; true
1581 ).
1582process_meta(//(A), Origin, Src, P) :-
1583 !,
1584 process_dcg_goal(A, Origin, Src, P).
1585process_meta(G, Origin, Src, P) :-
1586 process_goal(G, Origin, Src, P).
1587
1592
1593process_dcg_goal(Var, _, _, _) :-
1594 var(Var),
1595 !.
1596process_dcg_goal((A,B), Origin, Src, P) :-
1597 !,
1598 process_dcg_goal(A, Origin, Src, P),
1599 process_dcg_goal(B, Origin, Src, P).
1600process_dcg_goal((A;B), Origin, Src, P) :-
1601 !,
1602 process_dcg_goal(A, Origin, Src, P),
1603 process_dcg_goal(B, Origin, Src, P).
1604process_dcg_goal((A|B), Origin, Src, P) :-
1605 !,
1606 process_dcg_goal(A, Origin, Src, P),
1607 process_dcg_goal(B, Origin, Src, P).
1608process_dcg_goal((A->B), Origin, Src, P) :-
1609 !,
1610 process_dcg_goal(A, Origin, Src, P),
1611 process_dcg_goal(B, Origin, Src, P).
1612process_dcg_goal((A*->B), Origin, Src, P) :-
1613 !,
1614 process_dcg_goal(A, Origin, Src, P),
1615 process_dcg_goal(B, Origin, Src, P).
1616process_dcg_goal({Goal}, Origin, Src, P) :-
1617 !,
1618 process_goal(Goal, Origin, Src, P).
1619process_dcg_goal(List, _Origin, _Src, _) :-
1620 is_list(List),
1621 !. 1622process_dcg_goal(List, _Origin, _Src, _) :-
1623 string(List),
1624 !. 1625process_dcg_goal(Callable, Origin, Src, P) :-
1626 extend(Callable, 2, Goal),
1627 !,
1628 process_goal(Goal, Origin, Src, P).
1629process_dcg_goal(_, _, _, _).
1630
1631
1632extend(Var, _, _) :-
1633 var(Var), !, fail.
1634extend(M:G, N, M:GX) :-
1635 !,
1636 callable(G),
1637 extend(G, N, GX).
1638extend(G, N, GX) :-
1639 ( compound(G)
1640 -> compound_name_arguments(G, Name, Args),
1641 length(Rest, N),
1642 append(Args, Rest, NArgs),
1643 compound_name_arguments(GX, Name, NArgs)
1644 ; atom(G)
1645 -> length(NArgs, N),
1646 compound_name_arguments(GX, G, NArgs)
1647 ).
1648
1649asserting_goal(assert(Rule), Rule).
1650asserting_goal(asserta(Rule), Rule).
1651asserting_goal(assertz(Rule), Rule).
1652asserting_goal(assert(Rule,_), Rule).
1653asserting_goal(asserta(Rule,_), Rule).
1654asserting_goal(assertz(Rule,_), Rule).
1655
1656process_assert(0, _, _) :- !. 1657process_assert((_:-Body), Origin, Src) :-
1658 !,
1659 process_body(Body, Origin, Src).
1660process_assert(_, _, _).
1661
1663
1664variants([], _, []).
1665variants([H|T], Max, List) :-
1666 variants(T, H, Max, List).
1667
1668variants([], H, _, [H]).
1669variants(_, _, 0, []) :- !.
1670variants([H|T], V, Max, List) :-
1671 ( H =@= V
1672 -> variants(T, V, Max, List)
1673 ; List = [V|List2],
1674 Max1 is Max-1,
1675 variants(T, H, Max1, List2)
1676 ).
1677
1689
1690partial_evaluate(Goal, P) :-
1691 eval(Goal),
1692 !,
1693 P = true.
1694partial_evaluate(_, _).
1695
1696eval(X = Y) :-
1697 unify_with_occurs_check(X, Y).
1698
1699
1700 1703
1704pce_goal(new(_,_), new(-, new)).
1705pce_goal(send(_,_), send(arg, msg)).
1706pce_goal(send_class(_,_,_), send_class(arg, arg, msg)).
1707pce_goal(get(_,_,_), get(arg, msg, -)).
1708pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)).
1709pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)).
1710pce_goal(get_object(_,_,_), get_object(arg, msg, -)).
1711
1712process_xpce_goal(G, Origin, Src) :-
1713 pce_goal(G, Process),
1714 !,
1715 current_source_line(Here),
1716 assert_called(Src, Origin, G, Here),
1717 ( arg(I, Process, How),
1718 arg(I, G, Term),
1719 process_xpce_arg(How, Term, Origin, Src),
1720 fail
1721 ; true
1722 ).
1723
1724process_xpce_arg(new, Term, Origin, Src) :-
1725 callable(Term),
1726 process_new(Term, Origin, Src).
1727process_xpce_arg(arg, Term, Origin, Src) :-
1728 compound(Term),
1729 process_new(Term, Origin, Src).
1730process_xpce_arg(msg, Term, Origin, Src) :-
1731 compound(Term),
1732 ( arg(_, Term, Arg),
1733 process_xpce_arg(arg, Arg, Origin, Src),
1734 fail
1735 ; true
1736 ).
1737
1738process_new(_M:_Term, _, _) :- !. 1739process_new(Term, Origin, Src) :-
1740 assert_new(Src, Origin, Term),
1741 ( compound(Term),
1742 arg(_, Term, Arg),
1743 process_xpce_arg(arg, Arg, Origin, Src),
1744 fail
1745 ; true
1746 ).
1747
1748assert_new(_, _, Term) :-
1749 \+ callable(Term),
1750 !.
1751assert_new(Src, Origin, Control) :-
1752 functor_name(Control, Class),
1753 pce_control_class(Class),
1754 !,
1755 forall(arg(_, Control, Arg),
1756 assert_new(Src, Origin, Arg)).
1757assert_new(Src, Origin, Term) :-
1758 compound(Term),
1759 arg(1, Term, Prolog),
1760 Prolog == @(prolog),
1761 ( Term =.. [message, _, Selector | T],
1762 atom(Selector)
1763 -> Called =.. [Selector|T],
1764 process_body(Called, Origin, Src)
1765 ; Term =.. [?, _, Selector | T],
1766 atom(Selector)
1767 -> append(T, [_R], T2),
1768 Called =.. [Selector|T2],
1769 process_body(Called, Origin, Src)
1770 ),
1771 fail.
1772assert_new(_, _, @(_)) :- !.
1773assert_new(Src, _, Term) :-
1774 functor_name(Term, Name),
1775 assert_used_class(Src, Name).
1776
1777
1778pce_control_class(and).
1779pce_control_class(or).
1780pce_control_class(if).
1781pce_control_class(not).
1782
1783
1784 1787
1789
1790process_use_module(_Module:_Files, _, _) :- !. 1791process_use_module([], _, _) :- !.
1792process_use_module([H|T], Src, Reexport) :-
1793 !,
1794 process_use_module(H, Src, Reexport),
1795 process_use_module(T, Src, Reexport).
1796process_use_module(library(pce), Src, Reexport) :- 1797 !,
1798 xref_public_list(library(pce), Path, Exports, Src),
1799 forall(member(Import, Exports),
1800 process_pce_import(Import, Src, Path, Reexport)).
1801process_use_module(File, Src, Reexport) :-
1802 load_module_if_needed(File),
1803 ( xoption(Src, silent(Silent))
1804 -> Extra = [silent(Silent)]
1805 ; Extra = [silent(true)]
1806 ),
1807 ( xref_public_list(File, Src,
1808 [ path(Path),
1809 module(M),
1810 exports(Exports),
1811 public(Public),
1812 meta(Meta)
1813 | Extra
1814 ])
1815 -> assert(uses_file(File, Src, Path)),
1816 assert_import(Src, Exports, _, Path, Reexport),
1817 assert_xmodule_callable(Exports, M, Src, Path),
1818 assert_xmodule_callable(Public, M, Src, Path),
1819 maplist(process_meta_head(Src), Meta),
1820 ( File = library(chr) 1821 -> assert(mode(chr, Src))
1822 ; true
1823 )
1824 ; assert(uses_file(File, Src, '<not_found>'))
1825 ).
1826
1827process_pce_import(Name/Arity, Src, Path, Reexport) :-
1828 atom(Name),
1829 integer(Arity),
1830 !,
1831 functor(Term, Name, Arity),
1832 ( \+ system_predicate(Term),
1833 \+ Term = pce_error(_) 1834 -> assert_import(Src, [Name/Arity], _, Path, Reexport)
1835 ; true
1836 ).
1837process_pce_import(op(P,T,N), Src, _, _) :-
1838 xref_push_op(Src, P, T, N).
1839
1843
1844process_use_module2(File, Import, Src, Reexport) :-
1845 load_module_if_needed(File),
1846 ( xref_source_file(File, Path, Src)
1847 -> assert(uses_file(File, Src, Path)),
1848 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1849 -> assert_import(Src, Import, Export, Path, Reexport),
1850 forall(( member(Head, Meta),
1851 imported(Head, _, Path)
1852 ),
1853 process_meta_head(Src, Head))
1854 ; true
1855 )
1856 ; assert(uses_file(File, Src, '<not_found>'))
1857 ).
1858
1859
1865
1866load_module_if_needed(File) :-
1867 prolog:no_autoload_module(File),
1868 !,
1869 use_module(File, []).
1870load_module_if_needed(_).
1871
1872prolog:no_autoload_module(library(apply_macros)).
1873prolog:no_autoload_module(library(arithmetic)).
1874prolog:no_autoload_module(library(record)).
1875prolog:no_autoload_module(library(persistency)).
1876prolog:no_autoload_module(library(pldoc)).
1877prolog:no_autoload_module(library(settings)).
1878prolog:no_autoload_module(library(debug)).
1879prolog:no_autoload_module(library(plunit)).
1880
1881
1883
1884process_requires(Import, Src) :-
1885 is_list(Import),
1886 !,
1887 require_list(Import, Src).
1888process_requires(Var, _Src) :-
1889 var(Var),
1890 !.
1891process_requires((A,B), Src) :-
1892 !,
1893 process_requires(A, Src),
1894 process_requires(B, Src).
1895process_requires(PI, Src) :-
1896 requires(PI, Src).
1897
1898require_list([], _).
1899require_list([H|T], Src) :-
1900 requires(H, Src),
1901 require_list(T, Src).
1902
1903requires(PI, _Src) :-
1904 '$pi_head'(PI, Head),
1905 '$get_predicate_attribute'(system:Head, defined, 1),
1906 !.
1907requires(PI, Src) :-
1908 '$pi_head'(PI, Head),
1909 '$pi_head'(Name/Arity, Head),
1910 '$find_library'(_Module, Name, Arity, _LoadModule, Library),
1911 ( imported(Head, Src, Library)
1912 -> true
1913 ; assertz(imported(Head, Src, Library))
1914 ).
1915
1916
1944
1945xref_public_list(File, Src, Options) :-
1946 option(path(Path), Options, _),
1947 option(module(Module), Options, _),
1948 option(exports(Exports), Options, _),
1949 option(public(Public), Options, _),
1950 option(meta(Meta), Options, _),
1951 xref_source_file(File, Path, Src, Options),
1952 public_list(Path, Module, Meta, Exports, Public, Options).
1953
1973
1974xref_public_list(File, Path, Export, Src) :-
1975 xref_source_file(File, Path, Src),
1976 public_list(Path, _, _, Export, _, []).
1977xref_public_list(File, Path, Module, Export, Meta, Src) :-
1978 xref_source_file(File, Path, Src),
1979 public_list(Path, Module, Meta, Export, _, []).
1980xref_public_list(File, Path, Module, Export, Public, Meta, Src) :-
1981 xref_source_file(File, Path, Src),
1982 public_list(Path, Module, Meta, Export, Public, []).
1983
1991
1992:- dynamic public_list_cache/6. 1993:- volatile public_list_cache/6. 1994
1995public_list(Path, Module, Meta, Export, Public, _Options) :-
1996 public_list_cache(Path, Modified,
1997 Module0, Meta0, Export0, Public0),
1998 time_file(Path, ModifiedNow),
1999 ( abs(Modified-ModifiedNow) < 0.0001
2000 -> !,
2001 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0)
2002 ; retractall(public_list_cache(Path, _, _, _, _, _)),
2003 fail
2004 ).
2005public_list(Path, Module, Meta, Export, Public, Options) :-
2006 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options),
2007 ( Error = error(_,_),
2008 catch(time_file(Path, Modified), Error, fail)
2009 -> asserta(public_list_cache(Path, Modified,
2010 Module0, Meta0, Export0, Public0))
2011 ; true
2012 ),
2013 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0).
2014
2015public_list_nc(Path, Module, Meta, Export, Public, Options) :-
2016 in_temporary_module(
2017 TempModule,
2018 true,
2019 public_list_diff(TempModule, Path, Module,
2020 Meta, [], Export, [], Public, [], Options)).
2021
2022
2023public_list_diff(TempModule,
2024 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :-
2025 setup_call_cleanup(
2026 public_list_setup(TempModule, Path, In, State),
2027 phrase(read_directives(In, Options, [true]), Directives),
2028 public_list_cleanup(In, State)),
2029 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT).
2030
2031public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :-
2032 prolog_open_source(Path, In),
2033 '$set_source_module'(OldM, TempModule),
2034 set_xref(OldXref).
2035
2036public_list_cleanup(In, state(OldM, OldXref)) :-
2037 '$set_source_module'(OldM),
2038 set_prolog_flag(xref, OldXref),
2039 prolog_close_source(In).
2040
2041
2042read_directives(In, Options, State) -->
2043 { repeat,
2044 catch(prolog_read_source_term(In, Term, Expanded,
2045 [ process_comment(true),
2046 syntax_errors(error)
2047 ]),
2048 E, report_syntax_error(E, -, Options))
2049 -> nonvar(Term),
2050 Term = (:-_)
2051 },
2052 !,
2053 terms(Expanded, State, State1),
2054 read_directives(In, Options, State1).
2055read_directives(_, _, _) --> [].
2056
2057terms(Var, State, State) --> { var(Var) }, !.
2058terms([H|T], State0, State) -->
2059 !,
2060 terms(H, State0, State1),
2061 terms(T, State1, State).
2062terms((:-if(Cond)), State0, [True|State0]) -->
2063 !,
2064 { eval_cond(Cond, True) }.
2065terms((:-elif(Cond)), [True0|State], [True|State]) -->
2066 !,
2067 { eval_cond(Cond, True1),
2068 elif(True0, True1, True)
2069 }.
2070terms((:-else), [True0|State], [True|State]) -->
2071 !,
2072 { negate(True0, True) }.
2073terms((:-endif), [_|State], State) --> !.
2074terms(H, State, State) -->
2075 ( {State = [true|_]}
2076 -> [H]
2077 ; []
2078 ).
2079
2080eval_cond(Cond, true) :-
2081 catch(Cond, _, fail),
2082 !.
2083eval_cond(_, false).
2084
2085elif(true, _, else_false) :- !.
2086elif(false, true, true) :- !.
2087elif(True, _, True).
2088
2089negate(true, false).
2090negate(false, true).
2091negate(else_false, else_false).
2092
2093public_list([(:- module(Module, Export0))|Decls], Path,
2094 Module, Meta, MT, Export, Rest, Public, PT) :-
2095 !,
2096 append(Export0, Reexport, Export),
2097 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT).
2098public_list([(:- encoding(_))|Decls], Path,
2099 Module, Meta, MT, Export, Rest, Public, PT) :-
2100 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT).
2101
2102public_list_([], _, Meta, Meta, Export, Export, Public, Public).
2103public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :-
2104 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0),
2105 !,
2106 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT).
2107public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :-
2108 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT).
2109
2110public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :-
2111 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT).
2112public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :-
2113 public_from_import(Import, Spec, Path, Reexport, Rest).
2114public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :-
2115 phrase(meta_decls(Decl), Meta, MT).
2116public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :-
2117 phrase(public_decls(Decl), Public, PT).
2118
2122
2123reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !.
2124reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :-
2125 !,
2126 xref_source_file(H, Path, Src),
2127 public_list(Path, _Module, Meta0, Export0, Public0, []),
2128 append(Meta0, MT1, Meta),
2129 append(Export0, ET1, Export),
2130 append(Public0, PT1, Public),
2131 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT).
2132reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :-
2133 xref_source_file(Spec, Path, Src),
2134 public_list(Path, _Module, Meta0, Export0, Public0, []),
2135 append(Meta0, MT, Meta),
2136 append(Export0, ET, Export),
2137 append(Public0, PT, Public).
2138
2139public_from_import(except(Map), Path, Src, Export, Rest) :-
2140 !,
2141 xref_public_list(Path, _, AllExports, Src),
2142 except(Map, AllExports, NewExports),
2143 append(NewExports, Rest, Export).
2144public_from_import(Import, _, _, Export, Rest) :-
2145 import_name_map(Import, Export, Rest).
2146
2147
2149
2150except([], Exports, Exports).
2151except([PI0 as NewName|Map], Exports0, Exports) :-
2152 !,
2153 canonical_pi(PI0, PI),
2154 map_as(Exports0, PI, NewName, Exports1),
2155 except(Map, Exports1, Exports).
2156except([PI0|Map], Exports0, Exports) :-
2157 canonical_pi(PI0, PI),
2158 select(PI2, Exports0, Exports1),
2159 same_pi(PI, PI2),
2160 !,
2161 except(Map, Exports1, Exports).
2162
2163
2164map_as([PI|T], Repl, As, [PI2|T]) :-
2165 same_pi(Repl, PI),
2166 !,
2167 pi_as(PI, As, PI2).
2168map_as([H|T0], Repl, As, [H|T]) :-
2169 map_as(T0, Repl, As, T).
2170
2171pi_as(_/Arity, Name, Name/Arity).
2172pi_as(_//Arity, Name, Name//Arity).
2173
2174import_name_map([], L, L).
2175import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :-
2176 !,
2177 import_name_map(T0, T, Tail).
2178import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :-
2179 !,
2180 import_name_map(T0, T, Tail).
2181import_name_map([H|T0], [H|T], Tail) :-
2182 import_name_map(T0, T, Tail).
2183
2184canonical_pi(Name//Arity0, PI) :-
2185 integer(Arity0),
2186 !,
2187 PI = Name/Arity,
2188 Arity is Arity0 + 2.
2189canonical_pi(PI, PI).
2190
2191same_pi(Canonical, PI2) :-
2192 canonical_pi(PI2, Canonical).
2193
2194meta_decls(Var) -->
2195 { var(Var) },
2196 !.
2197meta_decls((A,B)) -->
2198 !,
2199 meta_decls(A),
2200 meta_decls(B).
2201meta_decls(A) -->
2202 [A].
2203
2204public_decls(Var) -->
2205 { var(Var) },
2206 !.
2207public_decls((A,B)) -->
2208 !,
2209 public_decls(A),
2210 public_decls(B).
2211public_decls(A) -->
2212 [A].
2213
2214 2217
2218process_include([], _) :- !.
2219process_include([H|T], Src) :-
2220 !,
2221 process_include(H, Src),
2222 process_include(T, Src).
2223process_include(File, Src) :-
2224 callable(File),
2225 !,
2226 ( once(xref_input(ParentSrc, _)),
2227 xref_source_file(File, Path, ParentSrc)
2228 -> ( ( uses_file(_, Src, Path)
2229 ; Path == Src
2230 )
2231 -> true
2232 ; assert(uses_file(File, Src, Path)),
2233 ( xoption(Src, process_include(true))
2234 -> findall(O, xoption(Src, O), Options),
2235 setup_call_cleanup(
2236 open_include_file(Path, In, Refs),
2237 collect(Src, Path, In, Options),
2238 close_include(In, Refs))
2239 ; true
2240 )
2241 )
2242 ; assert(uses_file(File, Src, '<not_found>'))
2243 ).
2244process_include(_, _).
2245
2251
2252open_include_file(Path, In, [Ref]) :-
2253 once(xref_input(_, Parent)),
2254 stream_property(Parent, encoding(Enc)),
2255 '$push_input_context'(xref_include),
2256 catch(( prolog:xref_open_source(Path, In)
2257 -> catch(set_stream(In, encoding(Enc)),
2258 error(_,_), true) 2259 ; include_encoding(Enc, Options),
2260 open(Path, read, In, Options)
2261 ), E,
2262 ( '$pop_input_context', throw(E))),
2263 catch(( peek_char(In, #) 2264 -> skip(In, 10)
2265 ; true
2266 ), E,
2267 ( close_include(In, []), throw(E))),
2268 asserta(xref_input(Path, In), Ref).
2269
2270include_encoding(wchar_t, []) :- !.
2271include_encoding(Enc, [encoding(Enc)]).
2272
2273
2274close_include(In, Refs) :-
2275 maplist(erase, Refs),
2276 close(In, [force(true)]),
2277 '$pop_input_context'.
2278
2282
2283process_foreign(Spec, Src) :-
2284 ground(Spec),
2285 current_foreign_library(Spec, Defined),
2286 !,
2287 ( xmodule(Module, Src)
2288 -> true
2289 ; Module = user
2290 ),
2291 process_foreign_defined(Defined, Module, Src).
2292process_foreign(_, _).
2293
2294process_foreign_defined([], _, _).
2295process_foreign_defined([H|T], M, Src) :-
2296 ( H = M:Head
2297 -> assert_foreign(Src, Head)
2298 ; assert_foreign(Src, H)
2299 ),
2300 process_foreign_defined(T, M, Src).
2301
2302
2303 2306
2316
2317process_chr(@(_Name, Rule), Src) :-
2318 mode(chr, Src),
2319 process_chr(Rule, Src).
2320process_chr(pragma(Rule, _Pragma), Src) :-
2321 mode(chr, Src),
2322 process_chr(Rule, Src).
2323process_chr(<=>(Head, Body), Src) :-
2324 mode(chr, Src),
2325 chr_head(Head, Src, H),
2326 chr_body(Body, H, Src).
2327process_chr(==>(Head, Body), Src) :-
2328 mode(chr, Src),
2329 chr_head(Head, H, Src),
2330 chr_body(Body, H, Src).
2331process_chr((:- chr_constraint(_)), Src) :-
2332 ( mode(chr, Src)
2333 -> true
2334 ; assert(mode(chr, Src))
2335 ).
2336
2337chr_head(X, _, _) :-
2338 var(X),
2339 !. 2340chr_head(\(A,B), Src, H) :-
2341 chr_head(A, Src, H),
2342 process_body(B, H, Src).
2343chr_head((H0,B), Src, H) :-
2344 chr_defined(H0, Src, H),
2345 process_body(B, H, Src).
2346chr_head(H0, Src, H) :-
2347 chr_defined(H0, Src, H).
2348
2349chr_defined(X, _, _) :-
2350 var(X),
2351 !.
2352chr_defined(#(C,_Id), Src, C) :-
2353 !,
2354 assert_constraint(Src, C).
2355chr_defined(A, Src, A) :-
2356 assert_constraint(Src, A).
2357
2358chr_body(X, From, Src) :-
2359 var(X),
2360 !,
2361 process_body(X, From, Src).
2362chr_body('|'(Guard, Goals), H, Src) :-
2363 !,
2364 chr_body(Guard, H, Src),
2365 chr_body(Goals, H, Src).
2366chr_body(G, From, Src) :-
2367 process_body(G, From, Src).
2368
2369assert_constraint(_, Head) :-
2370 var(Head),
2371 !.
2372assert_constraint(Src, Head) :-
2373 constraint(Head, Src, _),
2374 !.
2375assert_constraint(Src, Head) :-
2376 generalise_term(Head, Term),
2377 current_source_line(Line),
2378 assert(constraint(Term, Src, Line)).
2379
2380
2381 2384
2389
2390assert_called(_, _, Var, _) :-
2391 var(Var),
2392 !.
2393assert_called(Src, From, Goal, Line) :-
2394 var(From),
2395 !,
2396 assert_called(Src, '<unknown>', Goal, Line).
2397assert_called(_, _, Goal, _) :-
2398 expand_hide_called(Goal),
2399 !.
2400assert_called(Src, Origin, M:G, Line) :-
2401 !,
2402 ( atom(M),
2403 callable(G)
2404 -> current_condition(Cond),
2405 ( xmodule(M, Src) 2406 -> assert_called(Src, Origin, G, Line)
2407 ; called(M:G, Src, Origin, Cond, Line) 2408 -> true
2409 ; hide_called(M:G, Src) 2410 -> true
2411 ; generalise(Origin, OTerm),
2412 generalise(G, GTerm)
2413 -> assert(called(M:GTerm, Src, OTerm, Cond, Line))
2414 ; true
2415 )
2416 ; true 2417 ).
2418assert_called(Src, _, Goal, _) :-
2419 ( xmodule(M, Src)
2420 -> M \== system
2421 ; M = user
2422 ),
2423 hide_called(M:Goal, Src),
2424 !.
2425assert_called(Src, Origin, Goal, Line) :-
2426 current_condition(Cond),
2427 ( called(Goal, Src, Origin, Cond, Line)
2428 -> true
2429 ; generalise(Origin, OTerm),
2430 generalise(Goal, Term)
2431 -> assert(called(Term, Src, OTerm, Cond, Line))
2432 ; true
2433 ).
2434
2435
2440
2441expand_hide_called(pce_principal:send_implementation(_, _, _)).
2442expand_hide_called(pce_principal:get_implementation(_, _, _, _)).
2443expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)).
2444expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)).
2445
2446assert_defined(Src, Goal) :-
2447 defined(Goal, Src, _),
2448 !.
2449assert_defined(Src, Goal) :-
2450 generalise(Goal, Term),
2451 current_source_line(Line),
2452 assert(defined(Term, Src, Line)).
2453
2454assert_foreign(Src, Goal) :-
2455 foreign(Goal, Src, _),
2456 !.
2457assert_foreign(Src, Goal) :-
2458 generalise(Goal, Term),
2459 current_source_line(Line),
2460 assert(foreign(Term, Src, Line)).
2461
2471
2472assert_import(_, [], _, _, _) :- !.
2473assert_import(Src, [H|T], Export, From, Reexport) :-
2474 !,
2475 assert_import(Src, H, Export, From, Reexport),
2476 assert_import(Src, T, Export, From, Reexport).
2477assert_import(Src, except(Except), Export, From, Reexport) :-
2478 !,
2479 is_list(Export),
2480 !,
2481 except(Except, Export, Import),
2482 assert_import(Src, Import, _All, From, Reexport).
2483assert_import(Src, Import as Name, Export, From, Reexport) :-
2484 !,
2485 pi_to_head(Import, Term0),
2486 rename_goal(Term0, Name, Term),
2487 ( in_export_list(Term0, Export)
2488 -> assert(imported(Term, Src, From)),
2489 assert_reexport(Reexport, Src, Term)
2490 ; current_source_line(Line),
2491 assert_called(Src, '<directive>'(Line), Term0, Line)
2492 ).
2493assert_import(Src, Import, Export, From, Reexport) :-
2494 pi_to_head(Import, Term),
2495 !,
2496 ( in_export_list(Term, Export)
2497 -> assert(imported(Term, Src, From)),
2498 assert_reexport(Reexport, Src, Term)
2499 ; current_source_line(Line),
2500 assert_called(Src, '<directive>'(Line), Term, Line)
2501 ).
2502assert_import(Src, op(P,T,N), _, _, _) :-
2503 xref_push_op(Src, P,T,N).
2504
2505in_export_list(_Head, Export) :-
2506 var(Export),
2507 !.
2508in_export_list(Head, Export) :-
2509 member(PI, Export),
2510 pi_to_head(PI, Head).
2511
2512assert_reexport(false, _, _) :- !.
2513assert_reexport(true, Src, Term) :-
2514 assert(exported(Term, Src)).
2515
2519
2520process_import(M:PI, Src) :-
2521 pi_to_head(PI, Head),
2522 !,
2523 ( atom(M),
2524 current_module(M),
2525 module_property(M, file(From))
2526 -> true
2527 ; From = '<unknown>'
2528 ),
2529 assert(imported(Head, Src, From)).
2530process_import(_, _).
2531
2538
2539assert_xmodule_callable([], _, _, _).
2540assert_xmodule_callable([PI|T], M, Src, From) :-
2541 ( pi_to_head(M:PI, Head)
2542 -> assert(imported(Head, Src, From))
2543 ; true
2544 ),
2545 assert_xmodule_callable(T, M, Src, From).
2546
2547
2551
2552assert_op(Src, op(P,T,M:N)) :-
2553 ( '$current_source_module'(M)
2554 -> Name = N
2555 ; Name = M:N
2556 ),
2557 ( xop(Src, op(P,T,Name))
2558 -> true
2559 ; assert(xop(Src, op(P,T,Name)))
2560 ).
2561
2566
2567assert_module(Src, Module) :-
2568 xmodule(Module, Src),
2569 !.
2570assert_module(Src, Module) :-
2571 '$set_source_module'(Module),
2572 assert(xmodule(Module, Src)),
2573 ( module_property(Module, class(system))
2574 -> retractall(xoption(Src, register_called(_))),
2575 assert(xoption(Src, register_called(all)))
2576 ; true
2577 ).
2578
2579assert_module_export(_, []) :- !.
2580assert_module_export(Src, [H|T]) :-
2581 !,
2582 assert_module_export(Src, H),
2583 assert_module_export(Src, T).
2584assert_module_export(Src, PI) :-
2585 pi_to_head(PI, Term),
2586 !,
2587 assert(exported(Term, Src)).
2588assert_module_export(Src, op(P, A, N)) :-
2589 xref_push_op(Src, P, A, N).
2590
2594
2595assert_module3([], _) :- !.
2596assert_module3([H|T], Src) :-
2597 !,
2598 assert_module3(H, Src),
2599 assert_module3(T, Src).
2600assert_module3(Option, Src) :-
2601 process_use_module(library(dialect/Option), Src, false).
2602
2603
2609
2610process_predicates(Closure, Preds, Src) :-
2611 is_list(Preds),
2612 !,
2613 process_predicate_list(Preds, Closure, Src).
2614process_predicates(Closure, as(Preds, _Options), Src) :-
2615 !,
2616 process_predicates(Closure, Preds, Src).
2617process_predicates(Closure, Preds, Src) :-
2618 process_predicate_comma(Preds, Closure, Src).
2619
2620process_predicate_list([], _, _).
2621process_predicate_list([H|T], Closure, Src) :-
2622 ( nonvar(H)
2623 -> call(Closure, H, Src)
2624 ; true
2625 ),
2626 process_predicate_list(T, Closure, Src).
2627
2628process_predicate_comma(Var, _, _) :-
2629 var(Var),
2630 !.
2631process_predicate_comma(M:(A,B), Closure, Src) :-
2632 !,
2633 process_predicate_comma(M:A, Closure, Src),
2634 process_predicate_comma(M:B, Closure, Src).
2635process_predicate_comma((A,B), Closure, Src) :-
2636 !,
2637 process_predicate_comma(A, Closure, Src),
2638 process_predicate_comma(B, Closure, Src).
2639process_predicate_comma(as(Spec, _Options), Closure, Src) :-
2640 !,
2641 process_predicate_comma(Spec, Closure, Src).
2642process_predicate_comma(A, Closure, Src) :-
2643 call(Closure, A, Src).
2644
2645
2646assert_dynamic(PI, Src) :-
2647 pi_to_head(PI, Term),
2648 ( thread_local(Term, Src, _) 2649 -> true 2650 ; current_source_line(Line),
2651 assert(dynamic(Term, Src, Line))
2652 ).
2653
2654assert_thread_local(PI, Src) :-
2655 pi_to_head(PI, Term),
2656 current_source_line(Line),
2657 assert(thread_local(Term, Src, Line)).
2658
2659assert_multifile(PI, Src) :- 2660 pi_to_head(PI, Term),
2661 current_source_line(Line),
2662 assert(multifile(Term, Src, Line)).
2663
2664assert_public(PI, Src) :- 2665 pi_to_head(PI, Term),
2666 current_source_line(Line),
2667 assert_called(Src, '<public>'(Line), Term, Line),
2668 assert(public(Term, Src, Line)).
2669
2670assert_export(PI, Src) :- 2671 pi_to_head(PI, Term),
2672 !,
2673 assert(exported(Term, Src)).
2674
2679
2680pi_to_head(Var, _) :-
2681 var(Var), !, fail.
2682pi_to_head(M:PI, M:Term) :-
2683 !,
2684 pi_to_head(PI, Term).
2685pi_to_head(Name/Arity, Term) :-
2686 functor(Term, Name, Arity).
2687pi_to_head(Name//DCGArity, Term) :-
2688 Arity is DCGArity+2,
2689 functor(Term, Name, Arity).
2690
2691
2692assert_used_class(Src, Name) :-
2693 used_class(Name, Src),
2694 !.
2695assert_used_class(Src, Name) :-
2696 assert(used_class(Name, Src)).
2697
2698assert_defined_class(Src, Name, _Meta, _Super, _) :-
2699 defined_class(Name, _, _, Src, _),
2700 !.
2701assert_defined_class(_, _, _, -, _) :- !. 2702assert_defined_class(Src, Name, Meta, Super, Summary) :-
2703 current_source_line(Line),
2704 ( Summary == @(default)
2705 -> Atom = ''
2706 ; is_list(Summary)
2707 -> atom_codes(Atom, Summary)
2708 ; string(Summary)
2709 -> atom_concat(Summary, '', Atom)
2710 ),
2711 assert(defined_class(Name, Super, Atom, Src, Line)),
2712 ( Meta = @(_)
2713 -> true
2714 ; assert_used_class(Src, Meta)
2715 ),
2716 assert_used_class(Src, Super).
2717
2718assert_defined_class(Src, Name, imported_from(_File)) :-
2719 defined_class(Name, _, _, Src, _),
2720 !.
2721assert_defined_class(Src, Name, imported_from(File)) :-
2722 assert(defined_class(Name, _, '', Src, file(File))).
2723
2724
2725 2728
2732
2733generalise(Var, Var) :-
2734 var(Var),
2735 !. 2736generalise(pce_principal:send_implementation(Id, _, _),
2737 pce_principal:send_implementation(Id, _, _)) :-
2738 atom(Id),
2739 !.
2740generalise(pce_principal:get_implementation(Id, _, _, _),
2741 pce_principal:get_implementation(Id, _, _, _)) :-
2742 atom(Id),
2743 !.
2744generalise('<directive>'(Line), '<directive>'(Line)) :- !.
2745generalise(Module:Goal0, Module:Goal) :-
2746 atom(Module),
2747 !,
2748 generalise(Goal0, Goal).
2749generalise(Term0, Term) :-
2750 callable(Term0),
2751 generalise_term(Term0, Term).
2752
2753
2754 2757
2765
2766:- multifile
2767 prolog:xref_source_directory/2, 2768 prolog:xref_source_file/3. 2769
2770
2775
2776xref_source_file(Plain, File, Source) :-
2777 xref_source_file(Plain, File, Source, []).
2778
2779xref_source_file(QSpec, File, Source, Options) :-
2780 nonvar(QSpec), QSpec = _:Spec,
2781 !,
2782 must_be(acyclic, Spec),
2783 xref_source_file(Spec, File, Source, Options).
2784xref_source_file(Spec, File, Source, Options) :-
2785 nonvar(Spec),
2786 prolog:xref_source_file(Spec, File,
2787 [ relative_to(Source)
2788 | Options
2789 ]),
2790 !.
2791xref_source_file(Plain, File, Source, Options) :-
2792 atom(Plain),
2793 \+ is_absolute_file_name(Plain),
2794 ( prolog:xref_source_directory(Source, Dir)
2795 -> true
2796 ; atom(Source),
2797 file_directory_name(Source, Dir)
2798 ),
2799 atomic_list_concat([Dir, /, Plain], Spec0),
2800 absolute_file_name(Spec0, Spec),
2801 do_xref_source_file(Spec, File, Options),
2802 !.
2803xref_source_file(Spec, File, Source, Options) :-
2804 do_xref_source_file(Spec, File,
2805 [ relative_to(Source)
2806 | Options
2807 ]),
2808 !.
2809xref_source_file(_, _, _, Options) :-
2810 option(silent(true), Options),
2811 !,
2812 fail.
2813xref_source_file(Spec, _, Src, _Options) :-
2814 verbose(Src),
2815 print_message(warning, error(existence_error(file, Spec), _)),
2816 fail.
2817
2818do_xref_source_file(Spec, File, Options) :-
2819 nonvar(Spec),
2820 option(file_type(Type), Options, prolog),
2821 absolute_file_name(Spec, File,
2822 [ file_type(Type),
2823 access(read),
2824 file_errors(fail)
2825 ]),
2826 !.
2827
2831
2832canonical_source(Source, Src) :-
2833 ( ground(Source)
2834 -> prolog_canonical_source(Source, Src)
2835 ; Source = Src
2836 ).
2837
2842
2843goal_name_arity(Goal, Name, Arity) :-
2844 ( compound(Goal)
2845 -> compound_name_arity(Goal, Name, Arity)
2846 ; atom(Goal)
2847 -> Name = Goal, Arity = 0
2848 ).
2849
2850generalise_term(Specific, General) :-
2851 ( compound(Specific)
2852 -> compound_name_arity(Specific, Name, Arity),
2853 compound_name_arity(General, Name, Arity)
2854 ; General = Specific
2855 ).
2856
2857functor_name(Term, Name) :-
2858 ( compound(Term)
2859 -> compound_name_arity(Term, Name, _)
2860 ; atom(Term)
2861 -> Name = Term
2862 ).
2863
2864rename_goal(Goal0, Name, Goal) :-
2865 ( compound(Goal0)
2866 -> compound_name_arity(Goal0, _, Arity),
2867 compound_name_arity(Goal, Name, Arity)
2868 ; Goal = Name
2869 )