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 (declared)/4, 116 defined/3, 117 meta_goal/3, 118 foreign/3, 119 constraint/3, 120 imported/3, 121 exported/2, 122 xmodule/2, 123 uses_file/3, 124 xop/2, 125 source/2, 126 used_class/2, 127 defined_class/5, 128 (mode)/2, 129 xoption/2, 130 xflag/4, 131 grammar_rule/2, 132 module_comment/3, 133 pred_comment/4, 134 pred_comment_link/3, 135 pred_mode/3. 136
137:- create_prolog_flag(xref, false, [type(boolean)]). 138
173
174:- predicate_options(xref_source_file/4, 4,
175 [ file_type(oneof([txt,prolog,directory])),
176 silent(boolean)
177 ]). 178:- predicate_options(xref_public_list/3, 3,
179 [ path(-atom),
180 module(-atom),
181 exports(-list(any)),
182 public(-list(any)),
183 meta(-list(any)),
184 silent(boolean)
185 ]). 186
187
188 191
198
206
211
216
217:- multifile
218 prolog:called_by/4, 219 prolog:called_by/2, 220 prolog:meta_goal/2, 221 prolog:hook/1, 222 prolog:generated_predicate/1, 223 prolog:no_autoload_module/1. 224
225:- meta_predicate
226 prolog:generated_predicate(:). 227
228:- dynamic
229 meta_goal/2. 230
231:- meta_predicate
232 process_predicates(2, +, +). 233
234 237
243
244hide_called(Callable, Src) :-
245 xoption(Src, register_called(Which)),
246 !,
247 mode_hide_called(Which, Callable).
248hide_called(Callable, _) :-
249 mode_hide_called(non_built_in, Callable).
250
251mode_hide_called(all, _) :- !, fail.
252mode_hide_called(non_iso, _:Goal) :-
253 goal_name_arity(Goal, Name, Arity),
254 current_predicate(system:Name/Arity),
255 predicate_property(system:Goal, iso).
256mode_hide_called(non_built_in, _:Goal) :-
257 goal_name_arity(Goal, Name, Arity),
258 current_predicate(system:Name/Arity),
259 predicate_property(system:Goal, built_in).
260mode_hide_called(non_built_in, M:Goal) :-
261 goal_name_arity(Goal, Name, Arity),
262 current_predicate(M:Name/Arity),
263 predicate_property(M:Goal, built_in).
264
268
269system_predicate(Goal) :-
270 goal_name_arity(Goal, Name, Arity),
271 current_predicate(system:Name/Arity), 272 predicate_property(system:Goal, built_in),
273 !.
274
275
276 279
280verbose(Src) :-
281 \+ xoption(Src, silent(true)).
282
283:- thread_local
284 xref_input/2. 285
286
311
312xref_source(Source) :-
313 xref_source(Source, []).
314
315xref_source(Source, Options) :-
316 prolog_canonical_source(Source, Src),
317 ( last_modified(Source, Modified)
318 -> ( source(Src, Modified)
319 -> true
320 ; xref_clean(Src),
321 assert(source(Src, Modified)),
322 do_xref(Src, Options)
323 )
324 ; xref_clean(Src),
325 get_time(Now),
326 assert(source(Src, Now)),
327 do_xref(Src, Options)
328 ).
329
330do_xref(Src, Options) :-
331 must_be(list, Options),
332 setup_call_cleanup(
333 xref_setup(Src, In, Options, State),
334 collect(Src, Src, In, Options),
335 xref_cleanup(State)).
336
337last_modified(Source, Modified) :-
338 prolog:xref_source_time(Source, Modified),
339 !.
340last_modified(Source, Modified) :-
341 atom(Source),
342 \+ is_global_url(Source),
343 exists_file(Source),
344 time_file(Source, Modified).
345
346is_global_url(File) :-
347 sub_atom(File, B, _, _, '://'),
348 !,
349 B > 1,
350 sub_atom(File, 0, B, _, Scheme),
351 atom_codes(Scheme, Codes),
352 maplist(between(0'a, 0'z), Codes).
353
354xref_setup(Src, In, Options, state(In, Dialect, Xref, [SRef|HRefs])) :-
355 maplist(assert_option(Src), Options),
356 assert_default_options(Src),
357 current_prolog_flag(emulated_dialect, Dialect),
358 prolog_open_source(Src, In),
359 set_initial_mode(In, Options),
360 asserta(xref_input(Src, In), SRef),
361 set_xref(Xref),
362 ( verbose(Src)
363 -> HRefs = []
364 ; asserta((user:thread_message_hook(_,Level,_) :-
365 hide_message(Level)),
366 Ref),
367 HRefs = [Ref]
368 ).
369
370hide_message(warning).
371hide_message(error).
372hide_message(informational).
373
374assert_option(_, Var) :-
375 var(Var),
376 !,
377 instantiation_error(Var).
378assert_option(Src, silent(Boolean)) :-
379 !,
380 must_be(boolean, Boolean),
381 assert(xoption(Src, silent(Boolean))).
382assert_option(Src, register_called(Which)) :-
383 !,
384 must_be(oneof([all,non_iso,non_built_in]), Which),
385 assert(xoption(Src, register_called(Which))).
386assert_option(Src, comments(CommentHandling)) :-
387 !,
388 must_be(oneof([store,collect,ignore]), CommentHandling),
389 assert(xoption(Src, comments(CommentHandling))).
390assert_option(Src, module(Module)) :-
391 !,
392 must_be(atom, Module),
393 assert(xoption(Src, module(Module))).
394assert_option(Src, process_include(Boolean)) :-
395 !,
396 must_be(boolean, Boolean),
397 assert(xoption(Src, process_include(Boolean))).
398
399assert_default_options(Src) :-
400 ( xref_option_default(Opt),
401 generalise_term(Opt, Gen),
402 ( xoption(Src, Gen)
403 -> true
404 ; assertz(xoption(Src, Opt))
405 ),
406 fail
407 ; true
408 ).
409
410xref_option_default(silent(false)).
411xref_option_default(register_called(non_built_in)).
412xref_option_default(comments(collect)).
413xref_option_default(process_include(true)).
414
418
419xref_cleanup(state(In, Dialect, Xref, Refs)) :-
420 prolog_close_source(In),
421 set_prolog_flag(emulated_dialect, Dialect),
422 set_prolog_flag(xref, Xref),
423 maplist(erase, Refs).
424
425set_xref(Xref) :-
426 current_prolog_flag(xref, Xref),
427 set_prolog_flag(xref, true).
428
429:- meta_predicate
430 with_xref(0). 431
432with_xref(Goal) :-
433 current_prolog_flag(xref, Xref),
434 ( Xref == true
435 -> call(Goal)
436 ; setup_call_cleanup(
437 set_prolog_flag(xref, true),
438 Goal,
439 set_prolog_flag(xref, Xref))
440 ).
441
442
449
450set_initial_mode(_Stream, Options) :-
451 option(module(Module), Options),
452 !,
453 '$set_source_module'(Module).
454set_initial_mode(Stream, _) :-
455 stream_property(Stream, file_name(Path)),
456 source_file_property(Path, load_context(M, _, Opts)),
457 !,
458 '$set_source_module'(M),
459 ( option(dialect(Dialect), Opts)
460 -> expects_dialect(Dialect)
461 ; true
462 ).
463set_initial_mode(_, _) :-
464 '$set_source_module'(user).
465
469
470xref_input_stream(Stream) :-
471 xref_input(_, Var),
472 !,
473 Stream = Var.
474
479
480xref_push_op(Src, P, T, N0) :-
481 '$current_source_module'(M0),
482 strip_module(M0:N0, M, N),
483 ( is_list(N),
484 N \== []
485 -> maplist(push_op(Src, P, T, M), N)
486 ; push_op(Src, P, T, M, N)
487 ).
488
489push_op(Src, P, T, M0, N0) :-
490 strip_module(M0:N0, M, N),
491 Name = M:N,
492 valid_op(op(P,T,Name)),
493 push_op(P, T, Name),
494 assert_op(Src, op(P,T,Name)),
495 debug(xref(op), ':- ~w.', [op(P,T,Name)]).
496
497valid_op(op(P,T,M:N)) :-
498 atom(M),
499 valid_op_name(N),
500 integer(P),
501 between(0, 1200, P),
502 atom(T),
503 op_type(T).
504
505valid_op_name(N) :-
506 atom(N),
507 !.
508valid_op_name(N) :-
509 N == [].
510
511op_type(xf).
512op_type(yf).
513op_type(fx).
514op_type(fy).
515op_type(xfx).
516op_type(xfy).
517op_type(yfx).
518
522
523xref_set_prolog_flag(Flag, Value, Src, Line) :-
524 atom(Flag),
525 !,
526 assertz(xflag(Flag, Value, Src, Line)).
527xref_set_prolog_flag(_, _, _, _).
528
532
533xref_clean(Source) :-
534 prolog_canonical_source(Source, Src),
535 retractall(called(_, Src, _Origin, _Cond, _Line)),
536 retractall(dynamic(_, Src, Line)),
537 retractall(multifile(_, Src, Line)),
538 retractall(public(_, Src, Line)),
539 retractall(declared(_, _, Src, Line)),
540 retractall(defined(_, Src, Line)),
541 retractall(meta_goal(_, _, Src)),
542 retractall(foreign(_, Src, Line)),
543 retractall(constraint(_, Src, Line)),
544 retractall(imported(_, Src, _From)),
545 retractall(exported(_, Src)),
546 retractall(uses_file(_, Src, _)),
547 retractall(xmodule(_, Src)),
548 retractall(xop(Src, _)),
549 retractall(grammar_rule(_, Src)),
550 retractall(xoption(Src, _)),
551 retractall(xflag(_Name, _Value, Src, Line)),
552 retractall(source(Src, _)),
553 retractall(used_class(_, Src)),
554 retractall(defined_class(_, _, _, Src, _)),
555 retractall(mode(_, Src)),
556 retractall(module_comment(Src, _, _)),
557 retractall(pred_comment(_, Src, _, _)),
558 retractall(pred_comment_link(_, Src, _)),
559 retractall(pred_mode(_, Src, _)).
560
561
562 565
569
570xref_current_source(Source) :-
571 source(Source, _Time).
572
573
577
578xref_done(Source, Time) :-
579 prolog_canonical_source(Source, Src),
580 source(Src, Time).
581
582
601
602xref_called(Source, Called, By) :-
603 xref_called(Source, Called, By, _).
604
605xref_called(Source, Called, By, Cond) :-
606 canonical_source(Source, Src),
607 distinct(Called-By, called(Called, Src, By, Cond, _)).
608
609xref_called(Source, Called, By, Cond, Line) :-
610 canonical_source(Source, Src),
611 called(Called, Src, By, Cond, Line).
612
632
633xref_defined(Source, Called, How) :-
634 nonvar(Source),
635 !,
636 canonical_source(Source, Src),
637 xref_defined2(How, Src, Called).
638xref_defined(Source, Called, How) :-
639 xref_defined2(How, Src, Called),
640 canonical_source(Source, Src).
641
642xref_defined2(dynamic(Line), Src, Called) :-
643 dynamic(Called, Src, Line).
644xref_defined2(thread_local(Line), Src, Called) :-
645 thread_local(Called, Src, Line).
646xref_defined2(multifile(Line), Src, Called) :-
647 multifile(Called, Src, Line).
648xref_defined2(public(Line), Src, Called) :-
649 public(Called, Src, Line).
650xref_defined2(local(Line), Src, Called) :-
651 defined(Called, Src, Line).
652xref_defined2(foreign(Line), Src, Called) :-
653 foreign(Called, Src, Line).
654xref_defined2(constraint(Line), Src, Called) :-
655 ( constraint(Called, Src, Line)
656 -> true
657 ; declared(Called, chr_constraint, Src, Line)
658 ).
659xref_defined2(imported(From), Src, Called) :-
660 imported(Called, Src, From).
661xref_defined2(dcg, Src, Called) :-
662 grammar_rule(Called, Src).
663
664
669
670xref_definition_line(local(Line), Line).
671xref_definition_line(dynamic(Line), Line).
672xref_definition_line(thread_local(Line), Line).
673xref_definition_line(multifile(Line), Line).
674xref_definition_line(public(Line), Line).
675xref_definition_line(constraint(Line), Line).
676xref_definition_line(foreign(Line), Line).
677
678
682
683xref_exported(Source, Called) :-
684 prolog_canonical_source(Source, Src),
685 exported(Called, Src).
686
690
691xref_module(Source, Module) :-
692 nonvar(Source),
693 !,
694 prolog_canonical_source(Source, Src),
695 xmodule(Module, Src).
696xref_module(Source, Module) :-
697 xmodule(Module, Src),
698 prolog_canonical_source(Source, Src).
699
707
708xref_uses_file(Source, Spec, Path) :-
709 prolog_canonical_source(Source, Src),
710 uses_file(Spec, Src, Path).
711
719
720xref_op(Source, Op) :-
721 prolog_canonical_source(Source, Src),
722 xop(Src, Op).
723
729
730xref_prolog_flag(Source, Flag, Value, Line) :-
731 prolog_canonical_source(Source, Src),
732 xflag(Flag, Value, Src, Line).
733
734xref_built_in(Head) :-
735 system_predicate(Head).
736
737xref_used_class(Source, Class) :-
738 prolog_canonical_source(Source, Src),
739 used_class(Class, Src).
740
741xref_defined_class(Source, Class, local(Line, Super, Summary)) :-
742 prolog_canonical_source(Source, Src),
743 defined_class(Class, Super, Summary, Src, Line),
744 integer(Line),
745 !.
746xref_defined_class(Source, Class, file(File)) :-
747 prolog_canonical_source(Source, Src),
748 defined_class(Class, _, _, Src, file(File)).
749
750:- thread_local
751 current_cond/1,
752 source_line/1,
753 current_test_unit/2. 754
755current_source_line(Line) :-
756 source_line(Var),
757 !,
758 Line = Var.
759
765
766collect(Src, File, In, Options) :-
767 ( Src == File
768 -> SrcSpec = Line
769 ; SrcSpec = (File:Line)
770 ),
771 ( current_prolog_flag(xref_store_comments, OldStore)
772 -> true
773 ; OldStore = false
774 ),
775 option(comments(CommentHandling), Options, collect),
776 ( CommentHandling == ignore
777 -> CommentOptions = [],
778 Comments = []
779 ; CommentHandling == store
780 -> CommentOptions = [ process_comment(true) ],
781 Comments = [],
782 set_prolog_flag(xref_store_comments, true)
783 ; CommentOptions = [ comments(Comments) ]
784 ),
785 repeat,
786 catch(prolog_read_source_term(
787 In, Term, Expanded,
788 [ term_position(TermPos)
789 | CommentOptions
790 ]),
791 E, report_syntax_error(E, Src, [])),
792 update_condition(Term),
793 stream_position_data(line_count, TermPos, Line),
794 setup_call_cleanup(
795 asserta(source_line(SrcSpec), Ref),
796 catch(process(Expanded, Comments, Term, TermPos, Src, EOF),
797 E, print_message(error, E)),
798 erase(Ref)),
799 EOF == true,
800 !,
801 set_prolog_flag(xref_store_comments, OldStore).
802
803report_syntax_error(E, _, _) :-
804 fatal_error(E),
805 throw(E).
806report_syntax_error(_, _, Options) :-
807 option(silent(true), Options),
808 !,
809 fail.
810report_syntax_error(E, Src, _Options) :-
811 ( verbose(Src)
812 -> print_message(error, E)
813 ; true
814 ),
815 fail.
816
817fatal_error(time_limit_exceeded).
818fatal_error(error(resource_error(_),_)).
819
823
824update_condition((:-Directive)) :-
825 !,
826 update_cond(Directive).
827update_condition(_).
828
829update_cond(if(Cond)) :-
830 !,
831 asserta(current_cond(Cond)).
832update_cond(else) :-
833 retract(current_cond(C0)),
834 !,
835 assert(current_cond(\+C0)).
836update_cond(elif(Cond)) :-
837 retract(current_cond(C0)),
838 !,
839 assert(current_cond((\+C0,Cond))).
840update_cond(endif) :-
841 retract(current_cond(_)),
842 !.
843update_cond(_).
844
849
850current_condition(Condition) :-
851 \+ current_cond(_),
852 !,
853 Condition = true.
854current_condition(Condition) :-
855 findall(C, current_cond(C), List),
856 list_to_conj(List, Condition).
857
858list_to_conj([], true).
859list_to_conj([C], C) :- !.
860list_to_conj([H|T], (H,C)) :-
861 list_to_conj(T, C).
862
863
864 867
877
878process(Expanded, Comments, Term0, TermPos, Src, EOF) :-
879 is_list(Expanded), 880 !,
881 ( member(Term, Expanded),
882 process(Term, Term0, Src),
883 Term == end_of_file
884 -> EOF = true
885 ; EOF = false
886 ),
887 xref_comments(Comments, TermPos, Src).
888process(end_of_file, _, _, _, _, true) :-
889 !.
890process(Term, Comments, Term0, TermPos, Src, false) :-
891 process(Term, Term0, Src),
892 xref_comments(Comments, TermPos, Src).
893
895
896process(_, Term0, _) :-
897 ignore_raw_term(Term0),
898 !.
899process(Head :- Body, Head0 --> _, Src) :-
900 pi_head(F/A, Head),
901 pi_head(F/A0, Head0),
902 A =:= A0 + 2,
903 !,
904 assert_grammar_rule(Src, Head),
905 process((Head :- Body), Src).
906process(Term, _Term0, Src) :-
907 process(Term, Src).
908
909ignore_raw_term((:- predicate_options(_,_,_))).
910
912
913process(Var, _) :-
914 var(Var),
915 !. 916process(end_of_file, _) :- !.
917process((:- Directive), Src) :-
918 !,
919 process_directive(Directive, Src),
920 !.
921process((?- Directive), Src) :-
922 !,
923 process_directive(Directive, Src),
924 !.
925process((Head :- Body), Src) :-
926 !,
927 assert_defined(Src, Head),
928 process_body(Body, Head, Src).
929process((Left => Body), Src) :-
930 !,
931 ( nonvar(Left),
932 Left = (Head, Guard)
933 -> assert_defined(Src, Head),
934 process_body(Guard, Head, Src),
935 process_body(Body, Head, Src)
936 ; assert_defined(Src, Left),
937 process_body(Body, Left, Src)
938 ).
939process(?=>(Head, Body), Src) :-
940 !,
941 assert_defined(Src, Head),
942 process_body(Body, Head, Src).
943process('$source_location'(_File, _Line):Clause, Src) :-
944 !,
945 process(Clause, Src).
946process(Term, Src) :-
947 process_chr(Term, Src),
948 !.
949process(M:(Head :- Body), Src) :-
950 !,
951 process((M:Head :- M:Body), Src).
952process(Head, Src) :-
953 assert_defined(Src, Head).
954
955
956 959
961
([], _Pos, _Src).
963:- if(current_predicate(parse_comment/3)). 964xref_comments([Pos-Comment|T], TermPos, Src) :-
965 ( Pos @> TermPos 966 -> true
967 ; stream_position_data(line_count, Pos, Line),
968 FilePos = Src:Line,
969 ( parse_comment(Comment, FilePos, Parsed)
970 -> assert_comments(Parsed, Src)
971 ; true
972 ),
973 xref_comments(T, TermPos, Src)
974 ).
975
([], _).
977assert_comments([H|T], Src) :-
978 assert_comment(H, Src),
979 assert_comments(T, Src).
980
(section(_Id, Title, Comment), Src) :-
982 assertz(module_comment(Src, Title, Comment)).
983assert_comment(predicate(PI, Summary, Comment), Src) :-
984 pi_to_head(PI, Src, Head),
985 assertz(pred_comment(Head, Src, Summary, Comment)).
986assert_comment(link(PI, PITo), Src) :-
987 pi_to_head(PI, Src, Head),
988 pi_to_head(PITo, Src, HeadTo),
989 assertz(pred_comment_link(Head, Src, HeadTo)).
990assert_comment(mode(Head, Det), Src) :-
991 assertz(pred_mode(Head, Src, Det)).
992
993pi_to_head(PI, Src, Head) :-
994 pi_to_head(PI, Head0),
995 ( Head0 = _:_
996 -> strip_module(Head0, M, Plain),
997 ( xmodule(M, Src)
998 -> Head = Plain
999 ; Head = M:Plain
1000 )
1001 ; Head = Head0
1002 ).
1003:- endif. 1004
1008
(Source, Title, Comment) :-
1010 canonical_source(Source, Src),
1011 module_comment(Src, Title, Comment).
1012
1016
(Source, Head, Summary, Comment) :-
1018 canonical_source(Source, Src),
1019 ( pred_comment(Head, Src, Summary, Comment)
1020 ; pred_comment_link(Head, Src, HeadTo),
1021 pred_comment(HeadTo, Src, Summary, Comment)
1022 ).
1023
1028
1029xref_mode(Source, Mode, Det) :-
1030 canonical_source(Source, Src),
1031 pred_mode(Mode, Src, Det).
1032
1037
1038xref_option(Source, Option) :-
1039 canonical_source(Source, Src),
1040 xoption(Src, Option).
1041
1042
1043 1046
1047process_directive(Var, _) :-
1048 var(Var),
1049 !. 1050process_directive(Dir, _Src) :-
1051 debug(xref(directive), 'Processing :- ~q', [Dir]),
1052 fail.
1053process_directive((A,B), Src) :- 1054 !,
1055 process_directive(A, Src), 1056 process_directive(B, Src).
1057process_directive(List, Src) :-
1058 is_list(List),
1059 !,
1060 process_directive(consult(List), Src).
1061process_directive(use_module(File, Import), Src) :-
1062 process_use_module2(File, Import, Src, false).
1063process_directive(autoload(File, Import), Src) :-
1064 process_use_module2(File, Import, Src, false).
1065process_directive(require(Import), Src) :-
1066 process_requires(Import, Src).
1067process_directive(expects_dialect(Dialect), Src) :-
1068 process_directive(use_module(library(dialect/Dialect)), Src),
1069 expects_dialect(Dialect).
1070process_directive(reexport(File, Import), Src) :-
1071 process_use_module2(File, Import, Src, true).
1072process_directive(reexport(Modules), Src) :-
1073 process_use_module(Modules, Src, true).
1074process_directive(autoload(Modules), Src) :-
1075 process_use_module(Modules, Src, false).
1076process_directive(use_module(Modules), Src) :-
1077 process_use_module(Modules, Src, false).
1078process_directive(consult(Modules), Src) :-
1079 process_use_module(Modules, Src, false).
1080process_directive(ensure_loaded(Modules), Src) :-
1081 process_use_module(Modules, Src, false).
1082process_directive(load_files(Files, _Options), Src) :-
1083 process_use_module(Files, Src, false).
1084process_directive(include(Files), Src) :-
1085 process_include(Files, Src).
1086process_directive(dynamic(Dynamic), Src) :-
1087 process_predicates(assert_dynamic, Dynamic, Src).
1088process_directive(dynamic(Dynamic, _Options), Src) :-
1089 process_predicates(assert_dynamic, Dynamic, Src).
1090process_directive(thread_local(Dynamic), Src) :-
1091 process_predicates(assert_thread_local, Dynamic, Src).
1092process_directive(multifile(Dynamic), Src) :-
1093 process_predicates(assert_multifile, Dynamic, Src).
1094process_directive(public(Public), Src) :-
1095 process_predicates(assert_public, Public, Src).
1096process_directive(export(Export), Src) :-
1097 process_predicates(assert_export, Export, Src).
1098process_directive(import(Import), Src) :-
1099 process_import(Import, Src).
1100process_directive(module(Module, Export), Src) :-
1101 assert_module(Src, Module),
1102 assert_module_export(Src, Export).
1103process_directive(module(Module, Export, Import), Src) :-
1104 assert_module(Src, Module),
1105 assert_module_export(Src, Export),
1106 assert_module3(Import, Src).
1107process_directive(begin_tests(Unit, _Options), Src) :-
1108 enter_test_unit(Unit, Src).
1109process_directive(begin_tests(Unit), Src) :-
1110 enter_test_unit(Unit, Src).
1111process_directive(end_tests(Unit), Src) :-
1112 leave_test_unit(Unit, Src).
1113process_directive('$set_source_module'(system), Src) :-
1114 assert_module(Src, system). 1115process_directive(pce_begin_class_definition(Name, Meta, Super, Doc), Src) :-
1116 assert_defined_class(Src, Name, Meta, Super, Doc).
1117process_directive(pce_autoload(Name, From), Src) :-
1118 assert_defined_class(Src, Name, imported_from(From)).
1119
1120process_directive(op(P, A, N), Src) :-
1121 xref_push_op(Src, P, A, N).
1122process_directive(set_prolog_flag(Flag, Value), Src) :-
1123 ( Flag == character_escapes
1124 -> set_prolog_flag(character_escapes, Value)
1125 ; true
1126 ),
1127 current_source_line(Line),
1128 xref_set_prolog_flag(Flag, Value, Src, Line).
1129process_directive(style_check(X), _) :-
1130 style_check(X).
1131process_directive(encoding(Enc), _) :-
1132 ( xref_input_stream(Stream)
1133 -> catch(set_stream(Stream, encoding(Enc)), _, true)
1134 ; true 1135 ).
1136process_directive(pce_expansion:push_compile_operators, _) :-
1137 '$current_source_module'(SM),
1138 call(pce_expansion:push_compile_operators(SM)). 1139process_directive(pce_expansion:pop_compile_operators, _) :-
1140 call(pce_expansion:pop_compile_operators).
1141process_directive(meta_predicate(Meta), Src) :-
1142 process_meta_predicate(Meta, Src).
1143process_directive(arithmetic_function(FSpec), Src) :-
1144 arith_callable(FSpec, Goal),
1145 !,
1146 current_source_line(Line),
1147 assert_called(Src, '<directive>'(Line), Goal, Line).
1148process_directive(format_predicate(_, Goal), Src) :-
1149 !,
1150 current_source_line(Line),
1151 assert_called(Src, '<directive>'(Line), Goal, Line).
1152process_directive(if(Cond), Src) :-
1153 !,
1154 current_source_line(Line),
1155 assert_called(Src, '<directive>'(Line), Cond, Line).
1156process_directive(elif(Cond), Src) :-
1157 !,
1158 current_source_line(Line),
1159 assert_called(Src, '<directive>'(Line), Cond, Line).
1160process_directive(else, _) :- !.
1161process_directive(endif, _) :- !.
1162process_directive(Goal, Src) :-
1163 current_source_line(Line),
1164 process_body(Goal, '<directive>'(Line), Src).
1165
1169
1170process_meta_predicate((A,B), Src) :-
1171 !,
1172 process_meta_predicate(A, Src),
1173 process_meta_predicate(B, Src).
1174process_meta_predicate(Decl, Src) :-
1175 process_meta_head(Src, Decl).
1176
1177process_meta_head(Src, Decl) :- 1178 compound(Decl),
1179 compound_name_arity(Decl, Name, Arity),
1180 compound_name_arity(Head, Name, Arity),
1181 meta_args(1, Arity, Decl, Head, Meta),
1182 ( ( prolog:meta_goal(Head, _)
1183 ; prolog:called_by(Head, _, _, _)
1184 ; prolog:called_by(Head, _)
1185 ; meta_goal(Head, _)
1186 )
1187 -> true
1188 ; assert(meta_goal(Head, Meta, Src))
1189 ).
1190
1191meta_args(I, Arity, _, _, []) :-
1192 I > Arity,
1193 !.
1194meta_args(I, Arity, Decl, Head, [H|T]) :- 1195 arg(I, Decl, 0),
1196 !,
1197 arg(I, Head, H),
1198 I2 is I + 1,
1199 meta_args(I2, Arity, Decl, Head, T).
1200meta_args(I, Arity, Decl, Head, [H|T]) :- 1201 arg(I, Decl, ^),
1202 !,
1203 arg(I, Head, EH),
1204 setof_goal(EH, H),
1205 I2 is I + 1,
1206 meta_args(I2, Arity, Decl, Head, T).
1207meta_args(I, Arity, Decl, Head, [//(H)|T]) :-
1208 arg(I, Decl, //),
1209 !,
1210 arg(I, Head, H),
1211 I2 is I + 1,
1212 meta_args(I2, Arity, Decl, Head, T).
1213meta_args(I, Arity, Decl, Head, [H+A|T]) :- 1214 arg(I, Decl, A),
1215 integer(A), A > 0,
1216 !,
1217 arg(I, Head, H),
1218 I2 is I + 1,
1219 meta_args(I2, Arity, Decl, Head, T).
1220meta_args(I, Arity, Decl, Head, Meta) :-
1221 I2 is I + 1,
1222 meta_args(I2, Arity, Decl, Head, Meta).
1223
1224
1225 1228
1235
1236xref_meta(Source, Head, Called) :-
1237 canonical_source(Source, Src),
1238 xref_meta_src(Head, Called, Src).
1239
1252
1253xref_meta_src(Head, Called, Src) :-
1254 meta_goal(Head, Called, Src),
1255 !.
1256xref_meta_src(Head, Called, _) :-
1257 xref_meta(Head, Called),
1258 !.
1259xref_meta_src(Head, Called, _) :-
1260 compound(Head),
1261 compound_name_arity(Head, Name, Arity),
1262 apply_pred(Name),
1263 Arity > 5,
1264 !,
1265 Extra is Arity - 1,
1266 arg(1, Head, G),
1267 Called = [G+Extra].
1268xref_meta_src(Head, Called, _) :-
1269 with_xref(predicate_property('$xref_tmp':Head, meta_predicate(Meta))),
1270 !,
1271 Meta =.. [_|Args],
1272 meta_args(Args, 1, Head, Called).
1273
1274meta_args([], _, _, []).
1275meta_args([H0|T0], I, Head, [H|T]) :-
1276 xargs(H0, N),
1277 !,
1278 arg(I, Head, A),
1279 ( N == 0
1280 -> H = A
1281 ; H = (A+N)
1282 ),
1283 I2 is I+1,
1284 meta_args(T0, I2, Head, T).
1285meta_args([_|T0], I, Head, T) :-
1286 I2 is I+1,
1287 meta_args(T0, I2, Head, T).
1288
1289xargs(N, N) :- integer(N), !.
1290xargs(//, 2).
1291xargs(^, 0).
1292
1293apply_pred(call). 1294apply_pred(maplist). 1295
1296xref_meta((A, B), [A, B]).
1297xref_meta((A; B), [A, B]).
1298xref_meta((A| B), [A, B]).
1299xref_meta((A -> B), [A, B]).
1300xref_meta((A *-> B), [A, B]).
1301xref_meta(findall(_V,G,_L), [G]).
1302xref_meta(findall(_V,G,_L,_T), [G]).
1303xref_meta(findnsols(_N,_V,G,_L), [G]).
1304xref_meta(findnsols(_N,_V,G,_L,_T), [G]).
1305xref_meta(setof(_V, EG, _L), [G]) :-
1306 setof_goal(EG, G).
1307xref_meta(bagof(_V, EG, _L), [G]) :-
1308 setof_goal(EG, G).
1309xref_meta(forall(A, B), [A, B]).
1310xref_meta(maplist(G,_), [G+1]).
1311xref_meta(maplist(G,_,_), [G+2]).
1312xref_meta(maplist(G,_,_,_), [G+3]).
1313xref_meta(maplist(G,_,_,_,_), [G+4]).
1314xref_meta(map_list_to_pairs(G,_,_), [G+2]).
1315xref_meta(map_assoc(G, _), [G+1]).
1316xref_meta(map_assoc(G, _, _), [G+2]).
1317xref_meta(checklist(G, _L), [G+1]).
1318xref_meta(sublist(G, _, _), [G+1]).
1319xref_meta(include(G, _, _), [G+1]).
1320xref_meta(exclude(G, _, _), [G+1]).
1321xref_meta(partition(G, _, _, _, _), [G+2]).
1322xref_meta(partition(G, _, _, _),[G+1]).
1323xref_meta(call(G), [G]).
1324xref_meta(call(G, _), [G+1]).
1325xref_meta(call(G, _, _), [G+2]).
1326xref_meta(call(G, _, _, _), [G+3]).
1327xref_meta(call(G, _, _, _, _), [G+4]).
1328xref_meta(not(G), [G]).
1329xref_meta(notrace(G), [G]).
1330xref_meta('$notrace'(G), [G]).
1331xref_meta(\+(G), [G]).
1332xref_meta(ignore(G), [G]).
1333xref_meta(once(G), [G]).
1334xref_meta(initialization(G), [G]).
1335xref_meta(initialization(G,_), [G]).
1336xref_meta(retract(Rule), [G]) :- head_of(Rule, G).
1337xref_meta(clause(G, _), [G]).
1338xref_meta(clause(G, _, _), [G]).
1339xref_meta(phrase(G, _A), [//(G)]).
1340xref_meta(phrase(G, _A, _R), [//(G)]).
1341xref_meta(call_dcg(G, _A, _R), [//(G)]).
1342xref_meta(phrase_from_file(G,_),[//(G)]).
1343xref_meta(catch(A, _, B), [A, B]).
1344xref_meta(catch_with_backtrace(A, _, B), [A, B]).
1345xref_meta(thread_create(A,_,_), [A]).
1346xref_meta(thread_create(A,_), [A]).
1347xref_meta(thread_signal(_,A), [A]).
1348xref_meta(thread_idle(A,_), [A]).
1349xref_meta(thread_at_exit(A), [A]).
1350xref_meta(thread_initialization(A), [A]).
1351xref_meta(engine_create(_,A,_), [A]).
1352xref_meta(engine_create(_,A,_,_), [A]).
1353xref_meta(transaction(A), [A]).
1354xref_meta(transaction(A,B,_), [A,B]).
1355xref_meta(snapshot(A), [A]).
1356xref_meta(predsort(A,_,_), [A+3]).
1357xref_meta(call_cleanup(A, B), [A, B]).
1358xref_meta(call_cleanup(A, _, B),[A, B]).
1359xref_meta(setup_call_cleanup(A, B, C),[A, B, C]).
1360xref_meta(setup_call_catcher_cleanup(A, B, _, C),[A, B, C]).
1361xref_meta(call_residue_vars(A,_), [A]).
1362xref_meta(with_mutex(_,A), [A]).
1363xref_meta(assume(G), [G]). 1364xref_meta(assertion(G), [G]). 1365xref_meta(freeze(_, G), [G]).
1366xref_meta(when(C, A), [C, A]).
1367xref_meta(time(G), [G]). 1368xref_meta(call_time(G, _), [G]). 1369xref_meta(call_time(G, _, _), [G]). 1370xref_meta(profile(G), [G]).
1371xref_meta(at_halt(G), [G]).
1372xref_meta(call_with_time_limit(_, G), [G]).
1373xref_meta(call_with_depth_limit(G, _, _), [G]).
1374xref_meta(call_with_inference_limit(G, _, _), [G]).
1375xref_meta(alarm(_, G, _), [G]).
1376xref_meta(alarm(_, G, _, _), [G]).
1377xref_meta('$add_directive_wic'(G), [G]).
1378xref_meta(with_output_to(_, G), [G]).
1379xref_meta(if(G), [G]).
1380xref_meta(elif(G), [G]).
1381xref_meta(meta_options(G,_,_), [G+1]).
1382xref_meta(on_signal(_,_,H), [H+1]) :- H \== default.
1383xref_meta(distinct(G), [G]). 1384xref_meta(distinct(_, G), [G]).
1385xref_meta(order_by(_, G), [G]).
1386xref_meta(limit(_, G), [G]).
1387xref_meta(offset(_, G), [G]).
1388xref_meta(reset(G,_,_), [G]).
1389xref_meta(prolog_listen(Ev,G), [G+N]) :- event_xargs(Ev, N).
1390xref_meta(prolog_listen(Ev,G,_),[G+N]) :- event_xargs(Ev, N).
1391xref_meta(tnot(G), [G]).
1392xref_meta(not_exists(G), [G]).
1393xref_meta(with_tty_raw(G), [G]).
1394xref_meta(residual_goals(G), [G+2]).
1395
1396 1397xref_meta(pce_global(_, new(_)), _) :- !, fail.
1398xref_meta(pce_global(_, B), [B+1]).
1399xref_meta(ifmaintainer(G), [G]). 1400xref_meta(listen(_, G), [G]). 1401xref_meta(listen(_, _, G), [G]).
1402xref_meta(in_pce_thread(G), [G]).
1403
1404xref_meta(G, Meta) :- 1405 prolog:meta_goal(G, Meta).
1406xref_meta(G, Meta) :- 1407 meta_goal(G, Meta).
1408
1409setof_goal(EG, G) :-
1410 var(EG), !, G = EG.
1411setof_goal(_^EG, G) :-
1412 !,
1413 setof_goal(EG, G).
1414setof_goal(G, G).
1415
1416event_xargs(abort, 0).
1417event_xargs(erase, 1).
1418event_xargs(break, 3).
1419event_xargs(frame_finished, 1).
1420event_xargs(thread_exit, 1).
1421event_xargs(this_thread_exit, 0).
1422event_xargs(PI, 2) :- pi_to_head(PI, _).
1423
1427
1428head_of(Var, _) :-
1429 var(Var), !, fail.
1430head_of((Head :- _), Head).
1431head_of(Head, Head).
1432
1438
1439xref_hook(Hook) :-
1440 prolog:hook(Hook).
1441xref_hook(Hook) :-
1442 hook(Hook).
1443
1444
1445hook(attr_portray_hook(_,_)).
1446hook(attr_unify_hook(_,_)).
1447hook(attribute_goals(_,_,_)).
1448hook(goal_expansion(_,_)).
1449hook(term_expansion(_,_)).
1450hook(resource(_,_,_)).
1451hook('$pred_option'(_,_,_,_)).
1452
1453hook(emacs_prolog_colours:goal_classification(_,_)).
1454hook(emacs_prolog_colours:goal_colours(_,_)).
1455hook(emacs_prolog_colours:identify(_,_)).
1456hook(emacs_prolog_colours:style(_,_)).
1457hook(emacs_prolog_colours:term_colours(_,_)).
1458hook(pce_principal:get_implementation(_,_,_,_)).
1459hook(pce_principal:pce_class(_,_,_,_,_,_)).
1460hook(pce_principal:pce_lazy_get_method(_,_,_)).
1461hook(pce_principal:pce_lazy_send_method(_,_,_)).
1462hook(pce_principal:pce_uses_template(_,_)).
1463hook(pce_principal:send_implementation(_,_,_)).
1464hook(predicate_options:option_decl(_,_,_)).
1465hook(prolog:debug_control_hook(_)).
1466hook(prolog:error_message(_,_,_)).
1467hook(prolog:expand_answer(_,_,_)).
1468hook(prolog:general_exception(_,_)).
1469hook(prolog:help_hook(_)).
1470hook(prolog:locate_clauses(_,_)).
1471hook(prolog:message(_,_,_)).
1472hook(prolog:message_context(_,_,_)).
1473hook(prolog:message_line_element(_,_)).
1474hook(prolog:message_location(_,_,_)).
1475hook(prolog:predicate_summary(_,_)).
1476hook(prolog:prolog_exception_hook(_,_,_,_,_)).
1477hook(prolog:residual_goals(_,_)).
1478hook(prolog:show_profile_hook(_,_)).
1479hook(prolog_edit:load).
1480hook(prolog_edit:locate(_,_,_)).
1481hook(sandbox:safe_directive(_)).
1482hook(sandbox:safe_global_variable(_)).
1483hook(sandbox:safe_meta(_,_)).
1484hook(sandbox:safe_meta_predicate(_)).
1485hook(sandbox:safe_primitive(_)).
1486hook(sandbox:safe_prolog_flag(_,_)).
1487hook(shlib:unload_all_foreign_libraries).
1488hook(system:'$foreign_registered'(_, _)).
1489hook(user:exception(_,_,_)).
1490hook(user:expand_answer(_,_)).
1491hook(user:expand_query(_,_,_,_)).
1492hook(user:file_search_path(_,_)).
1493hook(user:library_directory(_)).
1494hook(user:message_hook(_,_,_)).
1495hook(user:portray(_)).
1496hook(user:prolog_clause_name(_,_)).
1497hook(user:prolog_list_goal(_)).
1498hook(user:prolog_predicate_name(_,_)).
1499hook(user:prolog_trace_interception(_,_,_,_)).
1500
1504
1505arith_callable(Var, _) :-
1506 var(Var), !, fail.
1507arith_callable(Module:Spec, Module:Goal) :-
1508 !,
1509 arith_callable(Spec, Goal).
1510arith_callable(Name/Arity, Goal) :-
1511 PredArity is Arity + 1,
1512 functor(Goal, Name, PredArity).
1513
1522
1523process_body(Body, Origin, Src) :-
1524 forall(limit(100, process_goal(Body, Origin, Src, _Partial)),
1525 true).
1526
1531
1532process_goal(Var, _, _, _) :-
1533 var(Var),
1534 !.
1535process_goal(_:Goal, _, _, _) :-
1536 var(Goal),
1537 !.
1538process_goal(Goal, Origin, Src, P) :-
1539 Goal = (_,_), 1540 !,
1541 phrase(conjunction(Goal), Goals),
1542 process_conjunction(Goals, Origin, Src, P).
1543process_goal(Goal, Origin, Src, _) :- 1544 Goal = (_;_), 1545 !,
1546 phrase(disjunction(Goal), Goals),
1547 forall(member(G, Goals),
1548 process_body(G, Origin, Src)).
1549process_goal(Goal, Origin, Src, P) :-
1550 ( ( xmodule(M, Src)
1551 -> true
1552 ; M = user
1553 ),
1554 pi_head(PI, M:Goal),
1555 ( current_predicate(PI),
1556 predicate_property(M:Goal, imported_from(IM))
1557 -> true
1558 ; PI = M:Name/Arity,
1559 '$find_library'(M, Name, Arity, IM, _Library)
1560 -> true
1561 ; IM = M
1562 ),
1563 prolog:called_by(Goal, IM, M, Called)
1564 ; prolog:called_by(Goal, Called)
1565 ),
1566 !,
1567 must_be(list, Called),
1568 current_source_line(Here),
1569 assert_called(Src, Origin, Goal, Here),
1570 process_called_list(Called, Origin, Src, P).
1571process_goal(Goal, Origin, Src, _) :-
1572 process_xpce_goal(Goal, Origin, Src),
1573 !.
1574process_goal(load_foreign_library(File), _Origin, Src, _) :-
1575 process_foreign(File, Src).
1576process_goal(load_foreign_library(File, _Init), _Origin, Src, _) :-
1577 process_foreign(File, Src).
1578process_goal(use_foreign_library(File), _Origin, Src, _) :-
1579 process_foreign(File, Src).
1580process_goal(use_foreign_library(File, _Init), _Origin, Src, _) :-
1581 process_foreign(File, Src).
1582process_goal(Goal, Origin, Src, P) :-
1583 xref_meta_src(Goal, Metas, Src),
1584 !,
1585 current_source_line(Here),
1586 assert_called(Src, Origin, Goal, Here),
1587 process_called_list(Metas, Origin, Src, P).
1588process_goal(Goal, Origin, Src, _) :-
1589 asserting_goal(Goal, Rule),
1590 !,
1591 current_source_line(Here),
1592 assert_called(Src, Origin, Goal, Here),
1593 process_assert(Rule, Origin, Src).
1594process_goal(Goal, Origin, Src, P) :-
1595 partial_evaluate(Goal, P),
1596 current_source_line(Here),
1597 assert_called(Src, Origin, Goal, Here).
1598
1599disjunction(Var) --> {var(Var), !}, [Var].
1600disjunction((A;B)) --> !, disjunction(A), disjunction(B).
1601disjunction(G) --> [G].
1602
1603conjunction(Var) --> {var(Var), !}, [Var].
1604conjunction((A,B)) --> !, conjunction(A), conjunction(B).
1605conjunction(G) --> [G].
1606
1607shares_vars(RVars, T) :-
1608 term_variables(T, TVars0),
1609 sort(TVars0, TVars),
1610 ord_intersect(RVars, TVars).
1611
1612process_conjunction([], _, _, _).
1613process_conjunction([Disj|Rest], Origin, Src, P) :-
1614 nonvar(Disj),
1615 Disj = (_;_),
1616 Rest \== [],
1617 !,
1618 phrase(disjunction(Disj), Goals),
1619 term_variables(Rest, RVars0),
1620 sort(RVars0, RVars),
1621 partition(shares_vars(RVars), Goals, Sharing, NonSHaring),
1622 forall(member(G, NonSHaring),
1623 process_body(G, Origin, Src)),
1624 ( Sharing == []
1625 -> true
1626 ; maplist(term_variables, Sharing, GVars0),
1627 append(GVars0, GVars1),
1628 sort(GVars1, GVars),
1629 ord_intersection(GVars, RVars, SVars),
1630 VT =.. [v|SVars],
1631 findall(VT,
1632 ( member(G, Sharing),
1633 process_goal(G, Origin, Src, PS),
1634 PS == true
1635 ),
1636 Alts0),
1637 ( Alts0 == []
1638 -> true
1639 ; ( true
1640 ; P = true,
1641 sort(Alts0, Alts1),
1642 variants(Alts1, 10, Alts),
1643 member(VT, Alts)
1644 )
1645 )
1646 ),
1647 process_conjunction(Rest, Origin, Src, P).
1648process_conjunction([H|T], Origin, Src, P) :-
1649 process_goal(H, Origin, Src, P),
1650 process_conjunction(T, Origin, Src, P).
1651
1652
1653process_called_list([], _, _, _).
1654process_called_list([H|T], Origin, Src, P) :-
1655 process_meta(H, Origin, Src, P),
1656 process_called_list(T, Origin, Src, P).
1657
1658process_meta(A+N, Origin, Src, P) :-
1659 !,
1660 ( extend(A, N, AX)
1661 -> process_goal(AX, Origin, Src, P)
1662 ; true
1663 ).
1664process_meta(//(A), Origin, Src, P) :-
1665 !,
1666 process_dcg_goal(A, Origin, Src, P).
1667process_meta(G, Origin, Src, P) :-
1668 process_goal(G, Origin, Src, P).
1669
1674
1675process_dcg_goal(Var, _, _, _) :-
1676 var(Var),
1677 !.
1678process_dcg_goal((A,B), Origin, Src, P) :-
1679 !,
1680 process_dcg_goal(A, Origin, Src, P),
1681 process_dcg_goal(B, Origin, Src, P).
1682process_dcg_goal((A;B), Origin, Src, P) :-
1683 !,
1684 process_dcg_goal(A, Origin, Src, P),
1685 process_dcg_goal(B, Origin, Src, P).
1686process_dcg_goal((A|B), Origin, Src, P) :-
1687 !,
1688 process_dcg_goal(A, Origin, Src, P),
1689 process_dcg_goal(B, Origin, Src, P).
1690process_dcg_goal((A->B), Origin, Src, P) :-
1691 !,
1692 process_dcg_goal(A, Origin, Src, P),
1693 process_dcg_goal(B, Origin, Src, P).
1694process_dcg_goal((A*->B), Origin, Src, P) :-
1695 !,
1696 process_dcg_goal(A, Origin, Src, P),
1697 process_dcg_goal(B, Origin, Src, P).
1698process_dcg_goal({Goal}, Origin, Src, P) :-
1699 !,
1700 process_goal(Goal, Origin, Src, P).
1701process_dcg_goal(List, _Origin, _Src, _) :-
1702 is_list(List),
1703 !. 1704process_dcg_goal(List, _Origin, _Src, _) :-
1705 string(List),
1706 !. 1707process_dcg_goal(Callable, Origin, Src, P) :-
1708 extend(Callable, 2, Goal),
1709 !,
1710 process_goal(Goal, Origin, Src, P).
1711process_dcg_goal(_, _, _, _).
1712
1713
1714extend(Var, _, _) :-
1715 var(Var), !, fail.
1716extend(M:G, N, M:GX) :-
1717 !,
1718 callable(G),
1719 extend(G, N, GX).
1720extend(G, N, GX) :-
1721 ( compound(G)
1722 -> compound_name_arguments(G, Name, Args),
1723 length(Rest, N),
1724 append(Args, Rest, NArgs),
1725 compound_name_arguments(GX, Name, NArgs)
1726 ; atom(G)
1727 -> length(NArgs, N),
1728 compound_name_arguments(GX, G, NArgs)
1729 ).
1730
1731asserting_goal(assert(Rule), Rule).
1732asserting_goal(asserta(Rule), Rule).
1733asserting_goal(assertz(Rule), Rule).
1734asserting_goal(assert(Rule,_), Rule).
1735asserting_goal(asserta(Rule,_), Rule).
1736asserting_goal(assertz(Rule,_), Rule).
1737
1738process_assert(0, _, _) :- !. 1739process_assert((_:-Body), Origin, Src) :-
1740 !,
1741 process_body(Body, Origin, Src).
1742process_assert(_, _, _).
1743
1745
1746variants([], _, []).
1747variants([H|T], Max, List) :-
1748 variants(T, H, Max, List).
1749
1750variants([], H, _, [H]).
1751variants(_, _, 0, []) :- !.
1752variants([H|T], V, Max, List) :-
1753 ( H =@= V
1754 -> variants(T, V, Max, List)
1755 ; List = [V|List2],
1756 Max1 is Max-1,
1757 variants(T, H, Max1, List2)
1758 ).
1759
1771
1772partial_evaluate(Goal, P) :-
1773 eval(Goal),
1774 !,
1775 P = true.
1776partial_evaluate(_, _).
1777
1778eval(X = Y) :-
1779 unify_with_occurs_check(X, Y).
1780
1781 1784
1785enter_test_unit(Unit, _Src) :-
1786 current_source_line(Line),
1787 asserta(current_test_unit(Unit, Line)).
1788
1789leave_test_unit(Unit, _Src) :-
1790 retractall(current_test_unit(Unit, _)).
1791
1792
1793 1796
1797pce_goal(new(_,_), new(-, new)).
1798pce_goal(send(_,_), send(arg, msg)).
1799pce_goal(send_class(_,_,_), send_class(arg, arg, msg)).
1800pce_goal(get(_,_,_), get(arg, msg, -)).
1801pce_goal(get_class(_,_,_,_), get_class(arg, arg, msg, -)).
1802pce_goal(get_chain(_,_,_), get_chain(arg, msg, -)).
1803pce_goal(get_object(_,_,_), get_object(arg, msg, -)).
1804
1805process_xpce_goal(G, Origin, Src) :-
1806 pce_goal(G, Process),
1807 !,
1808 current_source_line(Here),
1809 assert_called(Src, Origin, G, Here),
1810 ( arg(I, Process, How),
1811 arg(I, G, Term),
1812 process_xpce_arg(How, Term, Origin, Src),
1813 fail
1814 ; true
1815 ).
1816
1817process_xpce_arg(new, Term, Origin, Src) :-
1818 callable(Term),
1819 process_new(Term, Origin, Src).
1820process_xpce_arg(arg, Term, Origin, Src) :-
1821 compound(Term),
1822 process_new(Term, Origin, Src).
1823process_xpce_arg(msg, Term, Origin, Src) :-
1824 compound(Term),
1825 ( arg(_, Term, Arg),
1826 process_xpce_arg(arg, Arg, Origin, Src),
1827 fail
1828 ; true
1829 ).
1830
1831process_new(_M:_Term, _, _) :- !. 1832process_new(Term, Origin, Src) :-
1833 assert_new(Src, Origin, Term),
1834 ( compound(Term),
1835 arg(_, Term, Arg),
1836 process_xpce_arg(arg, Arg, Origin, Src),
1837 fail
1838 ; true
1839 ).
1840
1841assert_new(_, _, Term) :-
1842 \+ callable(Term),
1843 !.
1844assert_new(Src, Origin, Control) :-
1845 functor_name(Control, Class),
1846 pce_control_class(Class),
1847 !,
1848 forall(arg(_, Control, Arg),
1849 assert_new(Src, Origin, Arg)).
1850assert_new(Src, Origin, Term) :-
1851 compound(Term),
1852 arg(1, Term, Prolog),
1853 Prolog == @(prolog),
1854 ( Term =.. [message, _, Selector | T],
1855 atom(Selector)
1856 -> Called =.. [Selector|T],
1857 process_body(Called, Origin, Src)
1858 ; Term =.. [?, _, Selector | T],
1859 atom(Selector)
1860 -> append(T, [_R], T2),
1861 Called =.. [Selector|T2],
1862 process_body(Called, Origin, Src)
1863 ),
1864 fail.
1865assert_new(_, _, @(_)) :- !.
1866assert_new(Src, _, Term) :-
1867 functor_name(Term, Name),
1868 assert_used_class(Src, Name).
1869
1870
1871pce_control_class(and).
1872pce_control_class(or).
1873pce_control_class(if).
1874pce_control_class(not).
1875
1876
1877 1880
1882
1883process_use_module(_Module:_Files, _, _) :- !. 1884process_use_module([], _, _) :- !.
1885process_use_module([H|T], Src, Reexport) :-
1886 !,
1887 process_use_module(H, Src, Reexport),
1888 process_use_module(T, Src, Reexport).
1889process_use_module(library(pce), Src, Reexport) :- 1890 !,
1891 xref_public_list(library(pce), Path, Exports, Src),
1892 forall(member(Import, Exports),
1893 process_pce_import(Import, Src, Path, Reexport)).
1894process_use_module(File, Src, Reexport) :-
1895 load_module_if_needed(File),
1896 ( xoption(Src, silent(Silent))
1897 -> Extra = [silent(Silent)]
1898 ; Extra = [silent(true)]
1899 ),
1900 ( xref_public_list(File, Src,
1901 [ path(Path),
1902 module(M),
1903 exports(Exports),
1904 public(Public),
1905 meta(Meta)
1906 | Extra
1907 ])
1908 -> assert(uses_file(File, Src, Path)),
1909 assert_import(Src, Exports, _, Path, Reexport),
1910 assert_xmodule_callable(Exports, M, Src, Path),
1911 assert_xmodule_callable(Public, M, Src, Path),
1912 maplist(process_meta_head(Src), Meta),
1913 ( File = library(chr) 1914 -> assert(mode(chr, Src))
1915 ; true
1916 )
1917 ; assert(uses_file(File, Src, '<not_found>'))
1918 ).
1919
1920process_pce_import(Name/Arity, Src, Path, Reexport) :-
1921 atom(Name),
1922 integer(Arity),
1923 !,
1924 functor(Term, Name, Arity),
1925 ( \+ system_predicate(Term),
1926 \+ Term = pce_error(_) 1927 -> assert_import(Src, [Name/Arity], _, Path, Reexport)
1928 ; true
1929 ).
1930process_pce_import(op(P,T,N), Src, _, _) :-
1931 xref_push_op(Src, P, T, N).
1932
1936
1937process_use_module2(File, Import, Src, Reexport) :-
1938 load_module_if_needed(File),
1939 ( xref_source_file(File, Path, Src)
1940 -> assert(uses_file(File, Src, Path)),
1941 ( catch(public_list(Path, _, Meta, Export, _Public, []), _, fail)
1942 -> assert_import(Src, Import, Export, Path, Reexport),
1943 forall(( member(Head, Meta),
1944 imported(Head, _, Path)
1945 ),
1946 process_meta_head(Src, Head))
1947 ; true
1948 )
1949 ; assert(uses_file(File, Src, '<not_found>'))
1950 ).
1951
1952
1958
1959load_module_if_needed(File) :-
1960 prolog:no_autoload_module(File),
1961 !,
1962 use_module(File, []).
1963load_module_if_needed(_).
1964
1965prolog:no_autoload_module(library(apply_macros)).
1966prolog:no_autoload_module(library(arithmetic)).
1967prolog:no_autoload_module(library(record)).
1968prolog:no_autoload_module(library(persistency)).
1969prolog:no_autoload_module(library(pldoc)).
1970prolog:no_autoload_module(library(settings)).
1971prolog:no_autoload_module(library(debug)).
1972prolog:no_autoload_module(library(plunit)).
1973prolog:no_autoload_module(library(macros)).
1974prolog:no_autoload_module(library(yall)).
1975
1976
1978
1979process_requires(Import, Src) :-
1980 is_list(Import),
1981 !,
1982 require_list(Import, Src).
1983process_requires(Var, _Src) :-
1984 var(Var),
1985 !.
1986process_requires((A,B), Src) :-
1987 !,
1988 process_requires(A, Src),
1989 process_requires(B, Src).
1990process_requires(PI, Src) :-
1991 requires(PI, Src).
1992
1993require_list([], _).
1994require_list([H|T], Src) :-
1995 requires(H, Src),
1996 require_list(T, Src).
1997
1998requires(PI, _Src) :-
1999 '$pi_head'(PI, Head),
2000 '$get_predicate_attribute'(system:Head, defined, 1),
2001 !.
2002requires(PI, Src) :-
2003 '$pi_head'(PI, Head),
2004 '$pi_head'(Name/Arity, Head),
2005 '$find_library'(_Module, Name, Arity, _LoadModule, Library),
2006 ( imported(Head, Src, Library)
2007 -> true
2008 ; assertz(imported(Head, Src, Library))
2009 ).
2010
2011
2039
2040xref_public_list(File, Src, Options) :-
2041 option(path(Path), Options, _),
2042 option(module(Module), Options, _),
2043 option(exports(Exports), Options, _),
2044 option(public(Public), Options, _),
2045 option(meta(Meta), Options, _),
2046 xref_source_file(File, Path, Src, Options),
2047 public_list(Path, Module, Meta, Exports, Public, Options).
2048
2068
2069xref_public_list(File, Path, Export, Src) :-
2070 xref_source_file(File, Path, Src),
2071 public_list(Path, _, _, Export, _, []).
2072xref_public_list(File, Path, Module, Export, Meta, Src) :-
2073 xref_source_file(File, Path, Src),
2074 public_list(Path, Module, Meta, Export, _, []).
2075xref_public_list(File, Path, Module, Export, Public, Meta, Src) :-
2076 xref_source_file(File, Path, Src),
2077 public_list(Path, Module, Meta, Export, Public, []).
2078
2086
2087:- dynamic public_list_cache/6. 2088:- volatile public_list_cache/6. 2089
2090public_list(Path, Module, Meta, Export, Public, _Options) :-
2091 public_list_cache(Path, Modified,
2092 Module0, Meta0, Export0, Public0),
2093 time_file(Path, ModifiedNow),
2094 ( abs(Modified-ModifiedNow) < 0.0001
2095 -> !,
2096 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0)
2097 ; retractall(public_list_cache(Path, _, _, _, _, _)),
2098 fail
2099 ).
2100public_list(Path, Module, Meta, Export, Public, Options) :-
2101 public_list_nc(Path, Module0, Meta0, Export0, Public0, Options),
2102 ( Error = error(_,_),
2103 catch(time_file(Path, Modified), Error, fail)
2104 -> asserta(public_list_cache(Path, Modified,
2105 Module0, Meta0, Export0, Public0))
2106 ; true
2107 ),
2108 t(Module,Meta,Export,Public) = t(Module0,Meta0,Export0,Public0).
2109
2110public_list_nc(Path, Module, Meta, Export, Public, Options) :-
2111 in_temporary_module(
2112 TempModule,
2113 true,
2114 public_list_diff(TempModule, Path, Module,
2115 Meta, [], Export, [], Public, [], Options)).
2116
2117
2118public_list_diff(TempModule,
2119 Path, Module, Meta, MT, Export, Rest, Public, PT, Options) :-
2120 setup_call_cleanup(
2121 public_list_setup(TempModule, Path, In, State),
2122 phrase(read_directives(In, Options, [true]), Directives),
2123 public_list_cleanup(In, State)),
2124 public_list(Directives, Path, Module, Meta, MT, Export, Rest, Public, PT).
2125
2126public_list_setup(TempModule, Path, In, state(OldM, OldXref)) :-
2127 prolog_open_source(Path, In),
2128 '$set_source_module'(OldM, TempModule),
2129 set_xref(OldXref).
2130
2131public_list_cleanup(In, state(OldM, OldXref)) :-
2132 '$set_source_module'(OldM),
2133 set_prolog_flag(xref, OldXref),
2134 prolog_close_source(In).
2135
2136
2137read_directives(In, Options, State) -->
2138 { repeat,
2139 catch(prolog_read_source_term(In, Term, Expanded,
2140 [ process_comment(true),
2141 syntax_errors(error)
2142 ]),
2143 E, report_syntax_error(E, -, Options))
2144 -> nonvar(Term),
2145 Term = (:-_)
2146 },
2147 !,
2148 terms(Expanded, State, State1),
2149 read_directives(In, Options, State1).
2150read_directives(_, _, _) --> [].
2151
2152terms(Var, State, State) --> { var(Var) }, !.
2153terms([H|T], State0, State) -->
2154 !,
2155 terms(H, State0, State1),
2156 terms(T, State1, State).
2157terms((:-if(Cond)), State0, [True|State0]) -->
2158 !,
2159 { eval_cond(Cond, True) }.
2160terms((:-elif(Cond)), [True0|State], [True|State]) -->
2161 !,
2162 { eval_cond(Cond, True1),
2163 elif(True0, True1, True)
2164 }.
2165terms((:-else), [True0|State], [True|State]) -->
2166 !,
2167 { negate(True0, True) }.
2168terms((:-endif), [_|State], State) --> !.
2169terms(H, State, State) -->
2170 ( {State = [true|_]}
2171 -> [H]
2172 ; []
2173 ).
2174
2175eval_cond(Cond, true) :-
2176 catch(Cond, _, fail),
2177 !.
2178eval_cond(_, false).
2179
2180elif(true, _, else_false) :- !.
2181elif(false, true, true) :- !.
2182elif(True, _, True).
2183
2184negate(true, false).
2185negate(false, true).
2186negate(else_false, else_false).
2187
2188public_list([(:- module(Module, Export0))|Decls], Path,
2189 Module, Meta, MT, Export, Rest, Public, PT) :-
2190 !,
2191 ( is_list(Export0)
2192 -> append(Export0, Reexport, Export)
2193 ; Reexport = Export
2194 ),
2195 public_list_(Decls, Path, Meta, MT, Reexport, Rest, Public, PT).
2196public_list([(:- encoding(_))|Decls], Path,
2197 Module, Meta, MT, Export, Rest, Public, PT) :-
2198 public_list(Decls, Path, Module, Meta, MT, Export, Rest, Public, PT).
2199
2200public_list_([], _, Meta, Meta, Export, Export, Public, Public).
2201public_list_([(:-(Dir))|T], Path, Meta, MT, Export, Rest, Public, PT) :-
2202 public_list_1(Dir, Path, Meta, MT0, Export, Rest0, Public, PT0),
2203 !,
2204 public_list_(T, Path, MT0, MT, Rest0, Rest, PT0, PT).
2205public_list_([_|T], Path, Meta, MT, Export, Rest, Public, PT) :-
2206 public_list_(T, Path, Meta, MT, Export, Rest, Public, PT).
2207
2208public_list_1(reexport(Spec), Path, Meta, MT, Reexport, Rest, Public, PT) :-
2209 reexport_files(Spec, Path, Meta, MT, Reexport, Rest, Public, PT).
2210public_list_1(reexport(Spec, Import), Path, Meta, Meta, Reexport, Rest, Public, Public) :-
2211 public_from_import(Import, Spec, Path, Reexport, Rest).
2212public_list_1(meta_predicate(Decl), _Path, Meta, MT, Export, Export, Public, Public) :-
2213 phrase(meta_decls(Decl), Meta, MT).
2214public_list_1(public(Decl), _Path, Meta, Meta, Export, Export, Public, PT) :-
2215 phrase(public_decls(Decl), Public, PT).
2216
2220
2221reexport_files([], _, Meta, Meta, Export, Export, Public, Public) :- !.
2222reexport_files([H|T], Src, Meta, MT, Export, ET, Public, PT) :-
2223 !,
2224 xref_source_file(H, Path, Src),
2225 public_list(Path, _Module, Meta0, Export0, Public0, []),
2226 append(Meta0, MT1, Meta),
2227 append(Export0, ET1, Export),
2228 append(Public0, PT1, Public),
2229 reexport_files(T, Src, MT1, MT, ET1, ET, PT1, PT).
2230reexport_files(Spec, Src, Meta, MT, Export, ET, Public, PT) :-
2231 xref_source_file(Spec, Path, Src),
2232 public_list(Path, _Module, Meta0, Export0, Public0, []),
2233 append(Meta0, MT, Meta),
2234 append(Export0, ET, Export),
2235 append(Public0, PT, Public).
2236
2237public_from_import(except(Map), Path, Src, Export, Rest) :-
2238 !,
2239 xref_public_list(Path, _, AllExports, Src),
2240 except(Map, AllExports, NewExports),
2241 append(NewExports, Rest, Export).
2242public_from_import(Import, _, _, Export, Rest) :-
2243 import_name_map(Import, Export, Rest).
2244
2245
2247
2248except([], Exports, Exports).
2249except([PI0 as NewName|Map], Exports0, Exports) :-
2250 !,
2251 canonical_pi(PI0, PI),
2252 map_as(Exports0, PI, NewName, Exports1),
2253 except(Map, Exports1, Exports).
2254except([PI0|Map], Exports0, Exports) :-
2255 canonical_pi(PI0, PI),
2256 select(PI2, Exports0, Exports1),
2257 same_pi(PI, PI2),
2258 !,
2259 except(Map, Exports1, Exports).
2260
2261
2262map_as([PI|T], Repl, As, [PI2|T]) :-
2263 same_pi(Repl, PI),
2264 !,
2265 pi_as(PI, As, PI2).
2266map_as([H|T0], Repl, As, [H|T]) :-
2267 map_as(T0, Repl, As, T).
2268
2269pi_as(_/Arity, Name, Name/Arity).
2270pi_as(_//Arity, Name, Name//Arity).
2271
2272import_name_map([], L, L).
2273import_name_map([_/Arity as NewName|T0], [NewName/Arity|T], Tail) :-
2274 !,
2275 import_name_map(T0, T, Tail).
2276import_name_map([_//Arity as NewName|T0], [NewName//Arity|T], Tail) :-
2277 !,
2278 import_name_map(T0, T, Tail).
2279import_name_map([H|T0], [H|T], Tail) :-
2280 import_name_map(T0, T, Tail).
2281
2282canonical_pi(Name//Arity0, PI) :-
2283 integer(Arity0),
2284 !,
2285 PI = Name/Arity,
2286 Arity is Arity0 + 2.
2287canonical_pi(PI, PI).
2288
2289same_pi(Canonical, PI2) :-
2290 canonical_pi(PI2, Canonical).
2291
2292meta_decls(Var) -->
2293 { var(Var) },
2294 !.
2295meta_decls((A,B)) -->
2296 !,
2297 meta_decls(A),
2298 meta_decls(B).
2299meta_decls(A) -->
2300 [A].
2301
2302public_decls(Var) -->
2303 { var(Var) },
2304 !.
2305public_decls((A,B)) -->
2306 !,
2307 public_decls(A),
2308 public_decls(B).
2309public_decls(A) -->
2310 [A].
2311
2312 2315
2316process_include([], _) :- !.
2317process_include([H|T], Src) :-
2318 !,
2319 process_include(H, Src),
2320 process_include(T, Src).
2321process_include(File, Src) :-
2322 callable(File),
2323 !,
2324 ( once(xref_input(ParentSrc, _)),
2325 xref_source_file(File, Path, ParentSrc)
2326 -> ( ( uses_file(_, Src, Path)
2327 ; Path == Src
2328 )
2329 -> true
2330 ; assert(uses_file(File, Src, Path)),
2331 ( xoption(Src, process_include(true))
2332 -> findall(O, xoption(Src, O), Options),
2333 setup_call_cleanup(
2334 open_include_file(Path, In, Refs),
2335 collect(Src, Path, In, Options),
2336 close_include(In, Refs))
2337 ; true
2338 )
2339 )
2340 ; assert(uses_file(File, Src, '<not_found>'))
2341 ).
2342process_include(_, _).
2343
2349
2350open_include_file(Path, In, [Ref]) :-
2351 once(xref_input(_, Parent)),
2352 stream_property(Parent, encoding(Enc)),
2353 '$push_input_context'(xref_include),
2354 catch(( prolog:xref_open_source(Path, In)
2355 -> catch(set_stream(In, encoding(Enc)),
2356 error(_,_), true) 2357 ; include_encoding(Enc, Options),
2358 open(Path, read, In, Options)
2359 ), E,
2360 ( '$pop_input_context', throw(E))),
2361 catch(( peek_char(In, #) 2362 -> skip(In, 10)
2363 ; true
2364 ), E,
2365 ( close_include(In, []), throw(E))),
2366 asserta(xref_input(Path, In), Ref).
2367
2368include_encoding(wchar_t, []) :- !.
2369include_encoding(Enc, [encoding(Enc)]).
2370
2371
2372close_include(In, Refs) :-
2373 maplist(erase, Refs),
2374 close(In, [force(true)]),
2375 '$pop_input_context'.
2376
2380
2381process_foreign(Spec, Src) :-
2382 ground(Spec),
2383 current_foreign_library(Spec, Defined),
2384 !,
2385 ( xmodule(Module, Src)
2386 -> true
2387 ; Module = user
2388 ),
2389 process_foreign_defined(Defined, Module, Src).
2390process_foreign(_, _).
2391
2392process_foreign_defined([], _, _).
2393process_foreign_defined([H|T], M, Src) :-
2394 ( H = M:Head
2395 -> assert_foreign(Src, Head)
2396 ; assert_foreign(Src, H)
2397 ),
2398 process_foreign_defined(T, M, Src).
2399
2400
2401 2404
2414
2415process_chr(@(_Name, Rule), Src) :-
2416 mode(chr, Src),
2417 process_chr(Rule, Src).
2418process_chr(pragma(Rule, _Pragma), Src) :-
2419 mode(chr, Src),
2420 process_chr(Rule, Src).
2421process_chr(<=>(Head, Body), Src) :-
2422 mode(chr, Src),
2423 chr_head(Head, Src, H),
2424 chr_body(Body, H, Src).
2425process_chr(==>(Head, Body), Src) :-
2426 mode(chr, Src),
2427 chr_head(Head, H, Src),
2428 chr_body(Body, H, Src).
2429process_chr((:- chr_constraint(Decls)), Src) :-
2430 ( mode(chr, Src)
2431 -> true
2432 ; assert(mode(chr, Src))
2433 ),
2434 chr_decls(Decls, Src).
2435
2436chr_decls((A,B), Src) =>
2437 chr_decls(A, Src),
2438 chr_decls(B, Src).
2439chr_decls(Head, Src) =>
2440 generalise_term(Head, Gen),
2441 ( declared(Gen, chr_constraint, Src, _)
2442 -> true
2443 ; current_source_line(Line),
2444 assertz(declared(Gen, chr_constraint, Src, Line))
2445 ).
2446
2447chr_head(X, _, _) :-
2448 var(X),
2449 !. 2450chr_head(\(A,B), Src, H) :-
2451 chr_head(A, Src, H),
2452 process_body(B, H, Src).
2453chr_head((H0,B), Src, H) :-
2454 chr_defined(H0, Src, H),
2455 process_body(B, H, Src).
2456chr_head(H0, Src, H) :-
2457 chr_defined(H0, Src, H).
2458
2459chr_defined(X, _, _) :-
2460 var(X),
2461 !.
2462chr_defined(#(C,_Id), Src, C) :-
2463 !,
2464 assert_constraint(Src, C).
2465chr_defined(A, Src, A) :-
2466 assert_constraint(Src, A).
2467
2468chr_body(X, From, Src) :-
2469 var(X),
2470 !,
2471 process_body(X, From, Src).
2472chr_body('|'(Guard, Goals), H, Src) :-
2473 !,
2474 chr_body(Guard, H, Src),
2475 chr_body(Goals, H, Src).
2476chr_body(G, From, Src) :-
2477 process_body(G, From, Src).
2478
2479assert_constraint(_, Head) :-
2480 var(Head),
2481 !.
2482assert_constraint(Src, Head) :-
2483 constraint(Head, Src, _),
2484 !.
2485assert_constraint(Src, Head) :-
2486 generalise_term(Head, Term),
2487 current_source_line(Line),
2488 assert(constraint(Term, Src, Line)).
2489
2490
2491 2494
2499
2500assert_called(_, _, Var, _) :-
2501 var(Var),
2502 !.
2503assert_called(Src, From, Goal, Line) :-
2504 var(From),
2505 !,
2506 assert_called(Src, '<unknown>', Goal, Line).
2507assert_called(_, _, Goal, _) :-
2508 expand_hide_called(Goal),
2509 !.
2510assert_called(Src, Origin, M:G, Line) :-
2511 !,
2512 ( atom(M),
2513 callable(G)
2514 -> current_condition(Cond),
2515 ( xmodule(M, Src) 2516 -> assert_called(Src, Origin, G, Line)
2517 ; called(M:G, Src, Origin, Cond, Line) 2518 -> true
2519 ; hide_called(M:G, Src) 2520 -> true
2521 ; generalise(Origin, OTerm),
2522 generalise(G, GTerm)
2523 -> assert(called(M:GTerm, Src, OTerm, Cond, Line))
2524 ; true
2525 )
2526 ; true 2527 ).
2528assert_called(Src, _, Goal, _) :-
2529 ( xmodule(M, Src)
2530 -> M \== system
2531 ; M = user
2532 ),
2533 hide_called(M:Goal, Src),
2534 !.
2535assert_called(Src, Origin, Goal, Line) :-
2536 current_condition(Cond),
2537 ( called(Goal, Src, Origin, Cond, Line)
2538 -> true
2539 ; generalise(Origin, OTerm),
2540 generalise(Goal, Term)
2541 -> assert(called(Term, Src, OTerm, Cond, Line))
2542 ; true
2543 ).
2544
2545
2550
2551expand_hide_called(pce_principal:send_implementation(_, _, _)).
2552expand_hide_called(pce_principal:get_implementation(_, _, _, _)).
2553expand_hide_called(pce_principal:pce_lazy_get_method(_,_,_)).
2554expand_hide_called(pce_principal:pce_lazy_send_method(_,_,_)).
2555
2556assert_defined(Src, Goal) :-
2557 Goal = test(_Test),
2558 current_test_unit(Unit, Line),
2559 assert_called(Src, '<test_unit>'(Unit), Goal, Line),
2560 fail.
2561assert_defined(Src, Goal) :-
2562 Goal = test(_Test, _Options),
2563 current_test_unit(Unit, Line),
2564 assert_called(Src, '<test_unit>'(Unit), Goal, Line),
2565 fail.
2566assert_defined(Src, Goal) :-
2567 defined(Goal, Src, _),
2568 !.
2569assert_defined(Src, Goal) :-
2570 generalise(Goal, Term),
2571 current_source_line(Line),
2572 assert(defined(Term, Src, Line)).
2573
2574assert_foreign(Src, Goal) :-
2575 foreign(Goal, Src, _),
2576 !.
2577assert_foreign(Src, Goal) :-
2578 generalise(Goal, Term),
2579 current_source_line(Line),
2580 assert(foreign(Term, Src, Line)).
2581
2582assert_grammar_rule(Src, Goal) :-
2583 grammar_rule(Goal, Src),
2584 !.
2585assert_grammar_rule(Src, Goal) :-
2586 generalise(Goal, Term),
2587 assert(grammar_rule(Term, Src)).
2588
2589
2599
2600assert_import(_, [], _, _, _) :- !.
2601assert_import(Src, [H|T], Export, From, Reexport) :-
2602 !,
2603 assert_import(Src, H, Export, From, Reexport),
2604 assert_import(Src, T, Export, From, Reexport).
2605assert_import(Src, except(Except), Export, From, Reexport) :-
2606 !,
2607 is_list(Export),
2608 !,
2609 except(Except, Export, Import),
2610 assert_import(Src, Import, _All, From, Reexport).
2611assert_import(Src, Import as Name, Export, From, Reexport) :-
2612 !,
2613 pi_to_head(Import, Term0),
2614 rename_goal(Term0, Name, Term),
2615 ( in_export_list(Term0, Export)
2616 -> assert(imported(Term, Src, From)),
2617 assert_reexport(Reexport, Src, Term)
2618 ; current_source_line(Line),
2619 assert_called(Src, '<directive>'(Line), Term0, Line)
2620 ).
2621assert_import(Src, Import, Export, From, Reexport) :-
2622 pi_to_head(Import, Term),
2623 !,
2624 ( in_export_list(Term, Export)
2625 -> assert(imported(Term, Src, From)),
2626 assert_reexport(Reexport, Src, Term)
2627 ; current_source_line(Line),
2628 assert_called(Src, '<directive>'(Line), Term, Line)
2629 ).
2630assert_import(Src, op(P,T,N), _, _, _) :-
2631 xref_push_op(Src, P,T,N).
2632
2633in_export_list(_Head, Export) :-
2634 var(Export),
2635 !.
2636in_export_list(Head, Export) :-
2637 member(PI, Export),
2638 pi_to_head(PI, Head).
2639
2640assert_reexport(false, _, _) :- !.
2641assert_reexport(true, Src, Term) :-
2642 assert(exported(Term, Src)).
2643
2647
2648process_import(M:PI, Src) :-
2649 pi_to_head(PI, Head),
2650 !,
2651 ( atom(M),
2652 current_module(M),
2653 module_property(M, file(From))
2654 -> true
2655 ; From = '<unknown>'
2656 ),
2657 assert(imported(Head, Src, From)).
2658process_import(_, _).
2659
2666
2667assert_xmodule_callable([], _, _, _).
2668assert_xmodule_callable([PI|T], M, Src, From) :-
2669 ( pi_to_head(M:PI, Head)
2670 -> assert(imported(Head, Src, From))
2671 ; true
2672 ),
2673 assert_xmodule_callable(T, M, Src, From).
2674
2675
2679
2680assert_op(Src, op(P,T,M:N)) :-
2681 ( '$current_source_module'(M)
2682 -> Name = N
2683 ; Name = M:N
2684 ),
2685 ( xop(Src, op(P,T,Name))
2686 -> true
2687 ; assert(xop(Src, op(P,T,Name)))
2688 ).
2689
2694
2695assert_module(Src, Module) :-
2696 xmodule(Module, Src),
2697 !.
2698assert_module(Src, Module) :-
2699 '$set_source_module'(Module),
2700 assert(xmodule(Module, Src)),
2701 ( module_property(Module, class(system))
2702 -> retractall(xoption(Src, register_called(_))),
2703 assert(xoption(Src, register_called(all)))
2704 ; true
2705 ).
2706
2707assert_module_export(_, []) :- !.
2708assert_module_export(Src, [H|T]) :-
2709 !,
2710 assert_module_export(Src, H),
2711 assert_module_export(Src, T).
2712assert_module_export(Src, PI) :-
2713 pi_to_head(PI, Term),
2714 !,
2715 assert(exported(Term, Src)).
2716assert_module_export(Src, op(P, A, N)) :-
2717 xref_push_op(Src, P, A, N).
2718
2722
2723assert_module3([], _) :- !.
2724assert_module3([H|T], Src) :-
2725 !,
2726 assert_module3(H, Src),
2727 assert_module3(T, Src).
2728assert_module3(Option, Src) :-
2729 process_use_module(library(dialect/Option), Src, false).
2730
2731
2737
2738process_predicates(Closure, Preds, Src) :-
2739 is_list(Preds),
2740 !,
2741 process_predicate_list(Preds, Closure, Src).
2742process_predicates(Closure, as(Preds, _Options), Src) :-
2743 !,
2744 process_predicates(Closure, Preds, Src).
2745process_predicates(Closure, Preds, Src) :-
2746 process_predicate_comma(Preds, Closure, Src).
2747
2748process_predicate_list([], _, _).
2749process_predicate_list([H|T], Closure, Src) :-
2750 ( nonvar(H)
2751 -> call(Closure, H, Src)
2752 ; true
2753 ),
2754 process_predicate_list(T, Closure, Src).
2755
2756process_predicate_comma(Var, _, _) :-
2757 var(Var),
2758 !.
2759process_predicate_comma(M:(A,B), Closure, Src) :-
2760 !,
2761 process_predicate_comma(M:A, Closure, Src),
2762 process_predicate_comma(M:B, Closure, Src).
2763process_predicate_comma((A,B), Closure, Src) :-
2764 !,
2765 process_predicate_comma(A, Closure, Src),
2766 process_predicate_comma(B, Closure, Src).
2767process_predicate_comma(as(Spec, _Options), Closure, Src) :-
2768 !,
2769 process_predicate_comma(Spec, Closure, Src).
2770process_predicate_comma(A, Closure, Src) :-
2771 call(Closure, A, Src).
2772
2773
2774assert_dynamic(PI, Src) :-
2775 pi_to_head(PI, Term),
2776 ( thread_local(Term, Src, _) 2777 -> true 2778 ; current_source_line(Line),
2779 assert(dynamic(Term, Src, Line))
2780 ).
2781
2782assert_thread_local(PI, Src) :-
2783 pi_to_head(PI, Term),
2784 current_source_line(Line),
2785 assert(thread_local(Term, Src, Line)).
2786
2787assert_multifile(PI, Src) :- 2788 pi_to_head(PI, Term),
2789 current_source_line(Line),
2790 assert(multifile(Term, Src, Line)).
2791
2792assert_public(PI, Src) :- 2793 pi_to_head(PI, Term),
2794 current_source_line(Line),
2795 assert_called(Src, '<public>'(Line), Term, Line),
2796 assert(public(Term, Src, Line)).
2797
2798assert_export(PI, Src) :- 2799 pi_to_head(PI, Term),
2800 !,
2801 assert(exported(Term, Src)).
2802
2807
2808pi_to_head(Var, _) :-
2809 var(Var), !, fail.
2810pi_to_head(M:PI, M:Term) :-
2811 !,
2812 pi_to_head(PI, Term).
2813pi_to_head(Name/Arity, Term) :-
2814 functor(Term, Name, Arity).
2815pi_to_head(Name//DCGArity, Term) :-
2816 Arity is DCGArity+2,
2817 functor(Term, Name, Arity).
2818
2819
2820assert_used_class(Src, Name) :-
2821 used_class(Name, Src),
2822 !.
2823assert_used_class(Src, Name) :-
2824 assert(used_class(Name, Src)).
2825
2826assert_defined_class(Src, Name, _Meta, _Super, _) :-
2827 defined_class(Name, _, _, Src, _),
2828 !.
2829assert_defined_class(_, _, _, -, _) :- !. 2830assert_defined_class(Src, Name, Meta, Super, Summary) :-
2831 current_source_line(Line),
2832 ( Summary == @(default)
2833 -> Atom = ''
2834 ; is_list(Summary)
2835 -> atom_codes(Atom, Summary)
2836 ; string(Summary)
2837 -> atom_concat(Summary, '', Atom)
2838 ),
2839 assert(defined_class(Name, Super, Atom, Src, Line)),
2840 ( Meta = @(_)
2841 -> true
2842 ; assert_used_class(Src, Meta)
2843 ),
2844 assert_used_class(Src, Super).
2845
2846assert_defined_class(Src, Name, imported_from(_File)) :-
2847 defined_class(Name, _, _, Src, _),
2848 !.
2849assert_defined_class(Src, Name, imported_from(File)) :-
2850 assert(defined_class(Name, _, '', Src, file(File))).
2851
2852
2853 2856
2860
2861generalise(Var, Var) :-
2862 var(Var),
2863 !. 2864generalise(pce_principal:send_implementation(Id, _, _),
2865 pce_principal:send_implementation(Id, _, _)) :-
2866 atom(Id),
2867 !.
2868generalise(pce_principal:get_implementation(Id, _, _, _),
2869 pce_principal:get_implementation(Id, _, _, _)) :-
2870 atom(Id),
2871 !.
2872generalise('<directive>'(Line), '<directive>'(Line)) :- !.
2873generalise(test(Test), test(Test)) :-
2874 current_test_unit(_,_),
2875 ground(Test),
2876 !.
2877generalise(test(Test, _), test(Test, _)) :-
2878 current_test_unit(_,_),
2879 ground(Test),
2880 !.
2881generalise('<test_unit>'(Line), '<test_unit>'(Line)) :- !.
2882generalise(Module:Goal0, Module:Goal) :-
2883 atom(Module),
2884 !,
2885 generalise(Goal0, Goal).
2886generalise(Term0, Term) :-
2887 callable(Term0),
2888 generalise_term(Term0, Term).
2889
2890
2891 2894
2902
2903:- multifile
2904 prolog:xref_source_directory/2, 2905 prolog:xref_source_file/3. 2906
2907
2912
2913xref_source_file(Plain, File, Source) :-
2914 xref_source_file(Plain, File, Source, []).
2915
2916xref_source_file(QSpec, File, Source, Options) :-
2917 nonvar(QSpec), QSpec = _:Spec,
2918 !,
2919 must_be(acyclic, Spec),
2920 xref_source_file(Spec, File, Source, Options).
2921xref_source_file(Spec, File, Source, Options) :-
2922 nonvar(Spec),
2923 prolog:xref_source_file(Spec, File,
2924 [ relative_to(Source)
2925 | Options
2926 ]),
2927 !.
2928xref_source_file(Plain, File, Source, Options) :-
2929 atom(Plain),
2930 \+ is_absolute_file_name(Plain),
2931 ( prolog:xref_source_directory(Source, Dir)
2932 -> true
2933 ; atom(Source),
2934 file_directory_name(Source, Dir)
2935 ),
2936 atomic_list_concat([Dir, /, Plain], Spec0),
2937 absolute_file_name(Spec0, Spec),
2938 do_xref_source_file(Spec, File, Options),
2939 !.
2940xref_source_file(Spec, File, Source, Options) :-
2941 do_xref_source_file(Spec, File,
2942 [ relative_to(Source)
2943 | Options
2944 ]),
2945 !.
2946xref_source_file(_, _, _, Options) :-
2947 option(silent(true), Options),
2948 !,
2949 fail.
2950xref_source_file(Spec, _, Src, _Options) :-
2951 verbose(Src),
2952 print_message(warning, error(existence_error(file, Spec), _)),
2953 fail.
2954
2955do_xref_source_file(Spec, File, Options) :-
2956 nonvar(Spec),
2957 option(file_type(Type), Options, prolog),
2958 absolute_file_name(Spec, File,
2959 [ file_type(Type),
2960 access(read),
2961 file_errors(fail)
2962 ]),
2963 !.
2964
2968
2969canonical_source(Source, Src) :-
2970 ( ground(Source)
2971 -> prolog_canonical_source(Source, Src)
2972 ; Source = Src
2973 ).
2974
2979
2980goal_name_arity(Goal, Name, Arity) :-
2981 ( compound(Goal)
2982 -> compound_name_arity(Goal, Name, Arity)
2983 ; atom(Goal)
2984 -> Name = Goal, Arity = 0
2985 ).
2986
2987generalise_term(Specific, General) :-
2988 ( compound(Specific)
2989 -> compound_name_arity(Specific, Name, Arity),
2990 compound_name_arity(General, Name, Arity)
2991 ; General = Specific
2992 ).
2993
2994functor_name(Term, Name) :-
2995 ( compound(Term)
2996 -> compound_name_arity(Term, Name, _)
2997 ; atom(Term)
2998 -> Name = Term
2999 ).
3000
3001rename_goal(Goal0, Name, Goal) :-
3002 ( compound(Goal0)
3003 -> compound_name_arity(Goal0, _, Arity),
3004 compound_name_arity(Goal, Name, Arity)
3005 ; Goal = Name
3006 )