35
36:- module(prolog_codewalk,
37 [ prolog_walk_code/1, 38 prolog_program_clause/2 39 ]). 40:- use_module(library(record),[(record)/1, op(_,_,record)]). 41
42:- autoload(library(apply),[maplist/2]). 43:- autoload(library(debug),[debug/3,debugging/1,assertion/1]). 44:- autoload(library(error),[must_be/2]). 45:- autoload(library(listing),[portray_clause/1]). 46:- autoload(library(lists),[member/2,nth1/3,append/3]). 47:- autoload(library(option),[meta_options/3]). 48:- autoload(library(prolog_clause),
49 [clause_info/4,initialization_layout/4,clause_name/2]). 50:- autoload(library(prolog_metainference),
51 [inferred_meta_predicate/2,infer_meta_predicate/2]). 52
53
85
86:- meta_predicate
87 prolog_walk_code(:). 88
89:- multifile
90 prolog:called_by/4,
91 prolog:called_by/2. 92
93:- predicate_options(prolog_walk_code/1, 1,
94 [ undefined(oneof([ignore,error,trace])),
95 autoload(boolean),
96 clauses(list),
97 module(atom),
98 module_class(list(oneof([user,system,library,
99 test,development]))),
100 source(boolean),
101 trace_reference(any),
102 trace_condition(callable),
103 on_trace(callable),
104 infer_meta_predicates(oneof([false,true,all])),
105 evaluate(boolean),
106 verbose(boolean)
107 ]). 108
109:- record
110 walk_option(undefined:oneof([ignore,error,trace])=ignore,
111 autoload:boolean=true,
112 source:boolean=true,
113 module:atom, 114 module_class:list(oneof([user,system,library,
115 test,development]))=[user,library],
116 infer_meta_predicates:oneof([false,true,all])=true,
117 clauses:list, 118 trace_reference:any=(-),
119 trace_condition:callable, 120 on_trace:callable, 121 122 clause, 123 caller, 124 initialization, 125 undecided, 126 evaluate:boolean, 127 verbose:boolean=false). 128
129:- thread_local
130 multifile_predicate/3. 131
222
223prolog_walk_code(Options) :-
224 meta_options(is_meta, Options, QOptions),
225 prolog_walk_code(1, QOptions).
226
227prolog_walk_code(Iteration, Options) :-
228 statistics(cputime, CPU0),
229 make_walk_option(Options, OTerm, _),
230 ( walk_option_clauses(OTerm, Clauses),
231 nonvar(Clauses)
232 -> walk_clauses(Clauses, OTerm)
233 ; forall(( walk_option_module(OTerm, M0),
234 copy_term(M0, M),
235 current_module(M),
236 scan_module(M, OTerm)
237 ),
238 find_walk_from_module(M, OTerm)),
239 walk_from_multifile(OTerm),
240 walk_from_initialization(OTerm)
241 ),
242 infer_new_meta_predicates(New, OTerm),
243 statistics(cputime, CPU1),
244 ( New \== []
245 -> CPU is CPU1-CPU0,
246 ( walk_option_verbose(OTerm, true)
247 -> Level = informational
248 ; Level = silent
249 ),
250 print_message(Level,
251 codewalk(reiterate(New, Iteration, CPU))),
252 succ(Iteration, Iteration2),
253 prolog_walk_code(Iteration2, Options)
254 ; true
255 ).
256
257is_meta(on_trace).
258is_meta(trace_condition).
259
263
264walk_clauses(Clauses, OTerm) :-
265 must_be(list, Clauses),
266 forall(member(ClauseRef, Clauses),
267 ( user:clause(CHead, Body, ClauseRef),
268 ( CHead = Module:Head
269 -> true
270 ; Module = user,
271 Head = CHead
272 ),
273 walk_option_clause(OTerm, ClauseRef),
274 walk_option_caller(OTerm, Module:Head),
275 walk_called_by_body(Body, Module, OTerm)
276 )).
277
281
282scan_module(M, OTerm) :-
283 walk_option_module(OTerm, M1),
284 nonvar(M1),
285 !,
286 \+ M \= M1.
287scan_module(M, OTerm) :-
288 walk_option_module_class(OTerm, Classes),
289 module_property(M, class(Class)),
290 memberchk(Class, Classes),
291 !.
292
299
300walk_from_initialization(OTerm) :-
301 walk_option_caller(OTerm, '<initialization>'),
302 forall(init_goal_in_scope(Goal, SourceLocation, OTerm),
303 ( walk_option_initialization(OTerm, SourceLocation),
304 walk_from_initialization(Goal, OTerm))).
305
306init_goal_in_scope(Goal, SourceLocation, OTerm) :-
307 '$init_goal'(_When, Goal, SourceLocation),
308 SourceLocation = File:_Line,
309 ( walk_option_module(OTerm, M),
310 nonvar(M)
311 -> module_property(M, file(File))
312 ; walk_option_module_class(OTerm, Classes),
313 source_file_property(File, module(MF))
314 -> module_property(MF, class(Class)),
315 memberchk(Class, Classes),
316 walk_option_module(OTerm, MF)
317 ; true
318 ).
319
320walk_from_initialization(M:Goal, OTerm) :-
321 scan_module(M, OTerm),
322 !,
323 walk_called_by_body(Goal, M, OTerm).
324walk_from_initialization(_, _).
325
326
331
332find_walk_from_module(M, OTerm) :-
333 debug(autoload, 'Analysing module ~q', [M]),
334 walk_option_module(OTerm, M),
335 forall(predicate_in_module(M, PI),
336 walk_called_by_pred(M:PI, OTerm)).
337
338walk_called_by_pred(Module:Name/Arity, _) :-
339 multifile_predicate(Name, Arity, Module),
340 !.
341walk_called_by_pred(Module:Name/Arity, _) :-
342 functor(Head, Name, Arity),
343 predicate_property(Module:Head, multifile),
344 !,
345 assertz(multifile_predicate(Name, Arity, Module)).
346walk_called_by_pred(Module:Name/Arity, OTerm) :-
347 functor(Head, Name, Arity),
348 ( no_walk_property(Property),
349 predicate_property(Module:Head, Property)
350 -> true
351 ; walk_option_caller(OTerm, Module:Head),
352 walk_option_clause(OTerm, ClauseRef),
353 forall(catch(clause(Module:Head, Body, ClauseRef), _, fail),
354 walk_called_by_body(Body, Module, OTerm))
355 ).
356
357no_walk_property(number_of_rules(0)). 358no_walk_property(foreign). 359
363
364walk_from_multifile(OTerm) :-
365 forall(retract(multifile_predicate(Name, Arity, Module)),
366 walk_called_by_multifile(Module:Name/Arity, OTerm)).
367
368walk_called_by_multifile(Module:Name/Arity, OTerm) :-
369 functor(Head, Name, Arity),
370 forall(catch(clause_not_from_development(
371 Module:Head, Body, ClauseRef, OTerm),
372 _, fail),
373 ( walk_option_clause(OTerm, ClauseRef),
374 walk_option_caller(OTerm, Module:Head),
375 walk_called_by_body(Body, Module, OTerm)
376 )).
377
378
383
384clause_not_from_development(Module:Head, Body, Ref, OTerm) :-
385 clause(Module:Head, Body, Ref),
386 \+ ( clause_property(Ref, file(File)),
387 module_property(LoadModule, file(File)),
388 \+ scan_module(LoadModule, OTerm)
389 ).
390
398
399walk_called_by_body(True, _, _) :-
400 True == true,
401 !. 402walk_called_by_body(Body, Module, OTerm) :-
403 set_undecided_of_walk_option(error, OTerm, OTerm1),
404 set_evaluate_of_walk_option(false, OTerm1, OTerm2),
405 catch(walk_called(Body, Module, _TermPos, OTerm2),
406 missing(Missing),
407 walk_called_by_body(Missing, Body, Module, OTerm)),
408 !.
409walk_called_by_body(Body, Module, OTerm) :-
410 format(user_error, 'Failed to analyse:~n', []),
411 portray_clause(('<head>' :- Body)),
412 debug_walk(Body, Module, OTerm).
413
416:- if(debugging(codewalk(trace))). 417debug_walk(Body, Module, OTerm) :-
418 gtrace,
419 walk_called_by_body(Body, Module, OTerm).
420:- else. 421debug_walk(_,_,_).
422:- endif. 423
428
429walk_called_by_body(Missing, Body, _, OTerm) :-
430 debugging(codewalk),
431 format(user_error, 'Retrying due to ~w (~p)~n', [Missing, OTerm]),
432 portray_clause(('<head>' :- Body)), fail.
433walk_called_by_body(undecided_call, Body, Module, OTerm) :-
434 catch(forall(walk_called(Body, Module, _TermPos, OTerm),
435 true),
436 missing(Missing),
437 walk_called_by_body(Missing, Body, Module, OTerm)).
438walk_called_by_body(subterm_positions, Body, Module, OTerm) :-
439 ( ( walk_option_clause(OTerm, ClauseRef), nonvar(ClauseRef),
440 clause_info(ClauseRef, _, TermPos, _NameOffset),
441 TermPos = term_position(_,_,_,_,[_,BodyPos])
442 -> WBody = Body
443 ; walk_option_initialization(OTerm, SrcLoc),
444 ground(SrcLoc), SrcLoc = _File:_Line,
445 initialization_layout(SrcLoc, Module:Body, WBody, BodyPos)
446 )
447 -> catch(forall(walk_called(WBody, Module, BodyPos, OTerm),
448 true),
449 missing(subterm_positions),
450 walk_called_by_body(no_positions, Body, Module, OTerm))
451 ; set_source_of_walk_option(false, OTerm, OTerm2),
452 forall(walk_called(Body, Module, _BodyPos, OTerm2),
453 true)
454 ).
455walk_called_by_body(no_positions, Body, Module, OTerm) :-
456 set_source_of_walk_option(false, OTerm, OTerm2),
457 forall(walk_called(Body, Module, _NoPos, OTerm2),
458 true).
459
460
487
488walk_called(Term, Module, parentheses_term_position(_,_,Pos), OTerm) :-
489 nonvar(Pos),
490 !,
491 walk_called(Term, Module, Pos, OTerm).
492walk_called(Var, _, TermPos, OTerm) :-
493 var(Var), 494 !,
495 undecided(Var, TermPos, OTerm).
496walk_called(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :-
497 !,
498 ( nonvar(M)
499 -> walk_called(G, M, Pos, OTerm)
500 ; undecided(M, MPos, OTerm)
501 ).
502walk_called((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
503 !,
504 walk_called(A, M, PA, OTerm),
505 walk_called(B, M, PB, OTerm).
506walk_called((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
507 !,
508 walk_called(A, M, PA, OTerm),
509 walk_called(B, M, PB, OTerm).
510walk_called((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
511 !,
512 walk_called(A, M, PA, OTerm),
513 walk_called(B, M, PB, OTerm).
514walk_called(\+(A), M, term_position(_,_,_,_,[PA]), OTerm) :-
515 !,
516 \+ \+ walk_called(A, M, PA, OTerm).
517walk_called((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
518 !,
519 ( walk_option_evaluate(OTerm, Eval), Eval == true
520 -> Goal = (A;B),
521 setof(Goal,
522 ( walk_called(A, M, PA, OTerm)
523 ; walk_called(B, M, PB, OTerm)
524 ),
525 Alts0),
526 variants(Alts0, Alts),
527 member(Goal, Alts)
528 ; \+ \+ walk_called(A, M, PA, OTerm), 529 \+ \+ walk_called(B, M, PB, OTerm)
530 ).
531walk_called(Goal, Module, TermPos, OTerm) :-
532 walk_option_trace_reference(OTerm, To), To \== (-),
533 ( subsumes_term(To, Module:Goal)
534 -> M2 = Module
535 ; predicate_property(Module:Goal, imported_from(M2)),
536 subsumes_term(To, M2:Goal)
537 ),
538 trace_condition(M2:Goal, TermPos, OTerm),
539 print_reference(M2:Goal, TermPos, trace, OTerm),
540 fail. 541walk_called(Goal, Module, _, OTerm) :-
542 evaluate(Goal, Module, OTerm),
543 !.
544walk_called(Goal, M, TermPos, OTerm) :-
545 ( ( predicate_property(M:Goal, imported_from(IM))
546 -> true
547 ; IM = M
548 ),
549 prolog:called_by(Goal, IM, M, Called)
550 ; prolog:called_by(Goal, Called)
551 ),
552 Called \== [],
553 !,
554 walk_called_by(Called, M, Goal, TermPos, OTerm).
555walk_called(Meta, M, term_position(_,E,_,_,ArgPosList), OTerm) :-
556 ( walk_option_autoload(OTerm, false)
557 -> nonvar(M),
558 '$get_predicate_attribute'(M:Meta, defined, 1)
559 ; true
560 ),
561 ( predicate_property(M:Meta, meta_predicate(Head))
562 ; inferred_meta_predicate(M:Meta, Head)
563 ),
564 !,
565 walk_option_clause(OTerm, ClauseRef),
566 register_possible_meta_clause(ClauseRef),
567 walk_meta_call(1, Head, Meta, M, ArgPosList, E-E, OTerm).
568walk_called(Closure, _, _, _) :-
569 blob(Closure, closure),
570 !,
571 '$closure_predicate'(Closure, Module:Name/Arity),
572 functor(Head, Name, Arity),
573 '$get_predicate_attribute'(Module:Head, defined, 1).
574walk_called(ClosureCall, _, _, _) :-
575 compound(ClosureCall),
576 compound_name_arity(ClosureCall, Closure, _),
577 blob(Closure, closure),
578 !,
579 '$closure_predicate'(Closure, Module:Name/Arity),
580 functor(Head, Name, Arity),
581 '$get_predicate_attribute'(Module:Head, defined, 1).
582walk_called(Goal, Module, _, _) :-
583 nonvar(Module),
584 '$get_predicate_attribute'(Module:Goal, defined, 1),
585 !.
586walk_called(Goal, Module, TermPos, OTerm) :-
587 callable(Goal),
588 !,
589 undefined(Module:Goal, TermPos, OTerm).
590walk_called(Goal, _Module, TermPos, OTerm) :-
591 not_callable(Goal, TermPos, OTerm).
592
596
597trace_condition(Callee, TermPos, OTerm) :-
598 walk_option_trace_condition(OTerm, Cond), nonvar(Cond),
599 !,
600 cond_location_context(OTerm, TermPos, Context0),
601 walk_option_caller(OTerm, Caller),
602 walk_option_module(OTerm, Module),
603 put_dict(#{caller:Caller, module:Module}, Context0, Context),
604 call(Cond, Callee, Context).
605trace_condition(_, _, _).
606
607cond_location_context(OTerm, _TermPos, Context) :-
608 walk_option_clause(OTerm, Clause), nonvar(Clause),
609 !,
610 Context = #{clause:Clause}.
611cond_location_context(OTerm, _TermPos, Context) :-
612 walk_option_initialization(OTerm, Init), nonvar(Init),
613 !,
614 Context = #{initialization:Init}.
615
617
618undecided(Var, TermPos, OTerm) :-
619 walk_option_undecided(OTerm, Undecided),
620 ( var(Undecided)
621 -> Action = ignore
622 ; Action = Undecided
623 ),
624 undecided(Action, Var, TermPos, OTerm).
625
626undecided(ignore, _, _, _) :- !.
627undecided(error, _, _, _) :-
628 throw(missing(undecided_call)).
629
631
632evaluate(Goal, Module, OTerm) :-
633 walk_option_evaluate(OTerm, Evaluate),
634 Evaluate \== false,
635 evaluate(Goal, Module).
636
637evaluate(A=B, _) :-
638 unify_with_occurs_check(A, B).
639
643
644undefined(_, _, OTerm) :-
645 walk_option_undefined(OTerm, ignore),
646 !.
647undefined(Goal, _, _) :-
648 predicate_property(Goal, autoload(_)),
649 !.
650undefined(Goal, TermPos, OTerm) :-
651 ( walk_option_undefined(OTerm, trace)
652 -> Why = trace
653 ; Why = undefined
654 ),
655 print_reference(Goal, TermPos, Why, OTerm).
656
660
661not_callable(Goal, TermPos, OTerm) :-
662 print_reference(Goal, TermPos, not_callable, OTerm).
663
664
670
671print_reference(Goal, TermPos, Why, OTerm) :-
672 walk_option_clause(OTerm, Clause), nonvar(Clause),
673 !,
674 ( compound(TermPos),
675 arg(1, TermPos, CharCount),
676 integer(CharCount) 677 -> From = clause_term_position(Clause, TermPos)
678 ; walk_option_source(OTerm, false)
679 -> From = clause(Clause)
680 ; From = _,
681 throw(missing(subterm_positions))
682 ),
683 print_reference2(Goal, From, Why, OTerm).
684print_reference(Goal, TermPos, Why, OTerm) :-
685 walk_option_initialization(OTerm, Init), nonvar(Init),
686 Init = File:Line,
687 !,
688 ( compound(TermPos),
689 arg(1, TermPos, CharCount),
690 integer(CharCount) 691 -> From = file_term_position(File, TermPos)
692 ; walk_option_source(OTerm, false)
693 -> From = file(File, Line, -1, _)
694 ; From = _,
695 throw(missing(subterm_positions))
696 ),
697 print_reference2(Goal, From, Why, OTerm).
698print_reference(Goal, _, Why, OTerm) :-
699 print_reference2(Goal, _, Why, OTerm).
700
701print_reference2(Goal, From, trace, OTerm) :-
702 walk_option_on_trace(OTerm, Closure),
703 walk_option_caller(OTerm, Caller),
704 nonvar(Closure),
705 call(Closure, Goal, Caller, From),
706 !.
707print_reference2(Goal, From, Why, _OTerm) :-
708 make_message(Why, Goal, From, Message, Level),
709 print_message(Level, Message).
710
711
712make_message(undefined, Goal, Context,
713 error(existence_error(procedure, PI), Context), error) :-
714 goal_pi(Goal, PI).
715make_message(not_callable, Goal, Context,
716 error(type_error(callable, Goal), Context), error).
717make_message(trace, Goal, Context,
718 trace_call_to(PI, Context), informational) :-
719 goal_pi(Goal, PI).
720
721
722goal_pi(Goal, M:Name/Arity) :-
723 strip_module(Goal, M, Head),
724 callable(Head),
725 !,
726 functor(Head, Name, Arity).
727goal_pi(Goal, Goal).
728
729:- dynamic
730 possible_meta_predicate/2. 731
738
739register_possible_meta_clause(ClausesRef) :-
740 nonvar(ClausesRef),
741 clause_property(ClausesRef, predicate(PI)),
742 pi_head(PI, Head, Module),
743 module_property(Module, class(user)),
744 \+ predicate_property(Module:Head, meta_predicate(_)),
745 \+ inferred_meta_predicate(Module:Head, _),
746 \+ possible_meta_predicate(Head, Module),
747 !,
748 assertz(possible_meta_predicate(Head, Module)).
749register_possible_meta_clause(_).
750
751pi_head(Module:Name/Arity, Head, Module) :-
752 !,
753 functor(Head, Name, Arity).
754pi_head(_, _, _) :-
755 assertion(fail).
756
758
759infer_new_meta_predicates([], OTerm) :-
760 walk_option_infer_meta_predicates(OTerm, false),
761 !.
762infer_new_meta_predicates(MetaSpecs, OTerm) :-
763 findall(Module:MetaSpec,
764 ( retract(possible_meta_predicate(Head, Module)),
765 infer_meta_predicate(Module:Head, MetaSpec),
766 ( walk_option_infer_meta_predicates(OTerm, all)
767 -> true
768 ; calling_metaspec(MetaSpec)
769 )
770 ),
771 MetaSpecs).
772
777
778calling_metaspec(Head) :-
779 arg(_, Head, Arg),
780 calling_metaarg(Arg),
781 !.
782
783calling_metaarg(I) :- integer(I), !.
784calling_metaarg(^).
785calling_metaarg(//).
786
787
797
798walk_meta_call(I, Head, Meta, M, ArgPosList, EPos, OTerm) :-
799 arg(I, Head, AS),
800 !,
801 ( ArgPosList = [ArgPos|ArgPosTail]
802 -> true
803 ; ArgPos = EPos,
804 ArgPosTail = []
805 ),
806 ( integer(AS)
807 -> arg(I, Meta, MA),
808 extend(MA, AS, Goal, ArgPos, ArgPosEx, OTerm),
809 walk_called(Goal, M, ArgPosEx, OTerm)
810 ; AS == (^)
811 -> arg(I, Meta, MA),
812 remove_quantifier(MA, Goal, ArgPos, ArgPosEx, M, MG, OTerm),
813 walk_called(Goal, MG, ArgPosEx, OTerm)
814 ; AS == (//)
815 -> arg(I, Meta, DCG),
816 walk_dcg_body(DCG, M, ArgPos, OTerm)
817 ; true
818 ),
819 succ(I, I2),
820 walk_meta_call(I2, Head, Meta, M, ArgPosTail, EPos, OTerm).
821walk_meta_call(_, _, _, _, _, _, _).
822
823remove_quantifier(Goal, _, TermPos, TermPos, M, M, OTerm) :-
824 var(Goal),
825 !,
826 undecided(Goal, TermPos, OTerm).
827remove_quantifier(_^Goal0, Goal,
828 term_position(_,_,_,_,[_,GPos]),
829 TermPos, M0, M, OTerm) :-
830 !,
831 remove_quantifier(Goal0, Goal, GPos, TermPos, M0, M, OTerm).
832remove_quantifier(M1:Goal0, Goal,
833 term_position(_,_,_,_,[_,GPos]),
834 TermPos, _, M, OTerm) :-
835 !,
836 remove_quantifier(Goal0, Goal, GPos, TermPos, M1, M, OTerm).
837remove_quantifier(Goal, Goal, TermPos, TermPos, M, M, _).
838
839
844
845walk_called_by([], _, _, _, _).
846walk_called_by([H|T], M, Goal, TermPos, OTerm) :-
847 ( H = G0+N
848 -> subterm_pos(G0, M, Goal, TermPos, G, GPos),
849 ( extend(G, N, G2, GPos, GPosEx, OTerm)
850 -> walk_called(G2, M, GPosEx, OTerm)
851 ; true
852 )
853 ; subterm_pos(H, M, Goal, TermPos, G, GPos),
854 walk_called(G, M, GPos, OTerm)
855 ),
856 walk_called_by(T, M, Goal, TermPos, OTerm).
857
858subterm_pos(Sub, _, Term, TermPos, Sub, SubTermPos) :-
859 subterm_pos(Sub, Term, TermPos, SubTermPos),
860 !.
861subterm_pos(Sub, M, Term, TermPos, G, SubTermPos) :-
862 nonvar(Sub),
863 Sub = M:H,
864 !,
865 subterm_pos(H, M, Term, TermPos, G, SubTermPos).
866subterm_pos(Sub, _, _, _, Sub, _).
867
868subterm_pos(Sub, Term, TermPos, SubTermPos) :-
869 subterm_pos(Sub, Term, same_term, TermPos, SubTermPos),
870 !.
871subterm_pos(Sub, Term, TermPos, SubTermPos) :-
872 subterm_pos(Sub, Term, ==, TermPos, SubTermPos),
873 !.
874subterm_pos(Sub, Term, TermPos, SubTermPos) :-
875 subterm_pos(Sub, Term, =@=, TermPos, SubTermPos),
876 !.
877subterm_pos(Sub, Term, TermPos, SubTermPos) :-
878 subterm_pos(Sub, Term, subsumes_term, TermPos, SubTermPos),
879 !.
880
884
885walk_dcg_body(Var, _Module, TermPos, OTerm) :-
886 var(Var),
887 !,
888 undecided(Var, TermPos, OTerm).
889walk_dcg_body([], _Module, _, _) :- !.
890walk_dcg_body([_|_], _Module, _, _) :- !.
891walk_dcg_body(String, _Module, _, _) :-
892 string(String),
893 !.
894walk_dcg_body(!, _Module, _, _) :- !.
895walk_dcg_body(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :-
896 !,
897 ( nonvar(M)
898 -> walk_dcg_body(G, M, Pos, OTerm)
899 ; undecided(M, MPos, OTerm)
900 ).
901walk_dcg_body((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
902 !,
903 walk_dcg_body(A, M, PA, OTerm),
904 walk_dcg_body(B, M, PB, OTerm).
905walk_dcg_body((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
906 !,
907 walk_dcg_body(A, M, PA, OTerm),
908 walk_dcg_body(B, M, PB, OTerm).
909walk_dcg_body((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
910 !,
911 walk_dcg_body(A, M, PA, OTerm),
912 walk_dcg_body(B, M, PB, OTerm).
913walk_dcg_body((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
914 !,
915 ( walk_dcg_body(A, M, PA, OTerm)
916 ; walk_dcg_body(B, M, PB, OTerm)
917 ).
918walk_dcg_body((A|B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
919 !,
920 ( walk_dcg_body(A, M, PA, OTerm)
921 ; walk_dcg_body(B, M, PB, OTerm)
922 ).
923walk_dcg_body({G}, M, brace_term_position(_,_,PG), OTerm) :-
924 !,
925 walk_called(G, M, PG, OTerm).
926walk_dcg_body(G, M, TermPos, OTerm) :-
927 extend(G, 2, G2, TermPos, TermPosEx, OTerm),
928 walk_called(G2, M, TermPosEx, OTerm).
929
930
938
939:- meta_predicate
940 subterm_pos(+, +, 2, +, -),
941 sublist_pos(+, +, +, +, 2, -). 942:- public
943 subterm_pos/5. 944
945subterm_pos(_, _, _, Pos, _) :-
946 var(Pos), !, fail.
947subterm_pos(Sub, Term, Cmp, Pos, Pos) :-
948 call(Cmp, Sub, Term),
949 !.
950subterm_pos(Sub, Term, Cmp, term_position(_,_,_,_,ArgPosList), Pos) :-
951 is_list(ArgPosList),
952 compound(Term),
953 nth1(I, ArgPosList, ArgPos),
954 arg(I, Term, Arg),
955 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos).
956subterm_pos(Sub, Term, Cmp, list_position(_,_,ElemPosList,TailPos), Pos) :-
957 sublist_pos(ElemPosList, TailPos, Sub, Term, Cmp, Pos).
958subterm_pos(Sub, {Arg}, Cmp, brace_term_position(_,_,ArgPos), Pos) :-
959 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos).
960
961sublist_pos([EP|TP], TailPos, Sub, [H|T], Cmp, Pos) :-
962 ( subterm_pos(Sub, H, Cmp, EP, Pos)
963 ; sublist_pos(TP, TailPos, Sub, T, Cmp, Pos)
964 ).
965sublist_pos([], TailPos, Sub, Tail, Cmp, Pos) :-
966 TailPos \== none,
967 subterm_pos(Sub, Tail, Cmp, TailPos, Pos).
968
972
973extend(Goal, 0, Goal, TermPos, TermPos, _) :- !.
974extend(Goal, _, _, TermPos, TermPos, OTerm) :-
975 var(Goal),
976 !,
977 undecided(Goal, TermPos, OTerm).
978extend(M:Goal, N, M:GoalEx,
979 term_position(F,T,FT,TT,[MPos,GPosIn]),
980 term_position(F,T,FT,TT,[MPos,GPosOut]), OTerm) :-
981 !,
982 ( var(M)
983 -> undecided(N, MPos, OTerm)
984 ; true
985 ),
986 extend(Goal, N, GoalEx, GPosIn, GPosOut, OTerm).
987extend(Goal, N, GoalEx, TermPosIn, TermPosOut, _) :-
988 callable(Goal),
989 !,
990 Goal =.. List,
991 length(Extra, N),
992 extend_term_pos(TermPosIn, N, TermPosOut),
993 append(List, Extra, ListEx),
994 GoalEx =.. ListEx.
995extend(Closure, N, M:GoalEx, TermPosIn, TermPosOut, OTerm) :-
996 blob(Closure, closure), 997 !,
998 '$closure_predicate'(Closure, M:Name/Arity),
999 length(Extra, N),
1000 extend_term_pos(TermPosIn, N, TermPosOut),
1001 GoalEx =.. [Name|Extra],
1002 ( N =:= Arity
1003 -> true
1004 ; print_reference(Closure, TermPosIn, closure_arity_mismatch, OTerm)
1005 ).
1006extend(Goal, _, _, TermPos, _, OTerm) :-
1007 print_reference(Goal, TermPos, not_callable, OTerm).
1008
1009extend_term_pos(Var, _, _) :-
1010 var(Var),
1011 !.
1012extend_term_pos(term_position(F,T,FT,TT,ArgPosIn),
1013 N,
1014 term_position(F,T,FT,TT,ArgPosOut)) :-
1015 !,
1016 length(Extra, N),
1017 maplist(=(0-0), Extra),
1018 append(ArgPosIn, Extra, ArgPosOut).
1019extend_term_pos(F-T, N, term_position(F,T,F,T,Extra)) :-
1020 length(Extra, N),
1021 maplist(=(0-0), Extra).
1022
1023
1025
1026variants([], []).
1027variants([H|T], List) :-
1028 variants(T, H, List).
1029
1030variants([], H, [H]).
1031variants([H|T], V, List) :-
1032 ( H =@= V
1033 -> variants(T, V, List)
1034 ; List = [V|List2],
1035 variants(T, H, List2)
1036 ).
1037
1041
1042predicate_in_module(Module, PI) :-
1043 current_predicate(Module:PI),
1044 PI = Name/Arity,
1045 \+ hidden_predicate(Name, Arity),
1046 functor(Head, Name, Arity),
1047 \+ predicate_property(Module:Head, imported_from(_)).
1048
1049
1050hidden_predicate(Name, _) :-
1051 atom(Name), 1052 sub_atom(Name, 0, _, _, '$wrap$').
1053
1054
1055 1058
1068
1069prolog_program_clause(ClauseRef, Options) :-
1070 make_walk_option(Options, OTerm, _),
1071 setup_call_cleanup(
1072 true,
1073 ( current_module(Module),
1074 scan_module(Module, OTerm),
1075 module_clause(Module, ClauseRef, OTerm)
1076 ; retract(multifile_predicate(Name, Arity, MM)),
1077 multifile_clause(ClauseRef, MM:Name/Arity, OTerm)
1078 ; initialization_clause(ClauseRef, OTerm)
1079 ),
1080 retractall(multifile_predicate(_,_,_))).
1081
1082
1083module_clause(Module, ClauseRef, _OTerm) :-
1084 predicate_in_module(Module, Name/Arity),
1085 \+ multifile_predicate(Name, Arity, Module),
1086 functor(Head, Name, Arity),
1087 ( predicate_property(Module:Head, multifile)
1088 -> assertz(multifile_predicate(Name, Arity, Module)),
1089 fail
1090 ; predicate_property(Module:Head, Property),
1091 no_enum_property(Property)
1092 -> fail
1093 ; catch(nth_clause(Module:Head, _, ClauseRef), _, fail)
1094 ).
1095
1096no_enum_property(foreign).
1097
1098multifile_clause(ClauseRef, M:Name/Arity, OTerm) :-
1099 functor(Head, Name, Arity),
1100 catch(clauseref_not_from_development(M:Head, ClauseRef, OTerm),
1101 _, fail).
1102
1103clauseref_not_from_development(Module:Head, Ref, OTerm) :-
1104 nth_clause(Module:Head, _N, Ref),
1105 \+ ( clause_property(Ref, file(File)),
1106 module_property(LoadModule, file(File)),
1107 \+ scan_module(LoadModule, OTerm)
1108 ).
1109
1110initialization_clause(ClauseRef, OTerm) :-
1111 catch(clause(system:'$init_goal'(_File, M:_Goal, SourceLocation),
1112 true, ClauseRef),
1113 _, fail),
1114 walk_option_initialization(OTerm, SourceLocation),
1115 scan_module(M, OTerm).
1116
1117
1118 1121
1122:- multifile
1123 prolog:message//1,
1124 prolog:message_location//1. 1125
1126prolog:message(trace_call_to(PI, Context)) -->
1127 [ 'Call to ~q at '-[PI] ],
1128 '$messages':swi_location(Context).
1129
1130prolog:message_location(clause_term_position(ClauseRef, TermPos)) -->
1131 { clause_property(ClauseRef, file(File)) },
1132 message_location_file_term_position(File, TermPos).
1133prolog:message_location(clause(ClauseRef)) -->
1134 { clause_property(ClauseRef, file(File)),
1135 clause_property(ClauseRef, line_count(Line))
1136 },
1137 !,
1138 [ '~w:~d: '-[File, Line] ].
1139prolog:message_location(clause(ClauseRef)) -->
1140 { clause_name(ClauseRef, Name) },
1141 [ '~w: '-[Name] ].
1142prolog:message_location(file_term_position(Path, TermPos)) -->
1143 message_location_file_term_position(Path, TermPos).
1144prolog:message(codewalk(reiterate(New, Iteration, CPU))) -->
1145 [ 'Found new meta-predicates in iteration ~w (~3f sec)'-
1146 [Iteration, CPU], nl ],
1147 meta_decls(New),
1148 [ 'Restarting analysis ...'-[], nl ].
1149
1150meta_decls([]) --> [].
1151meta_decls([H|T]) -->
1152 [ ':- meta_predicate ~q.'-[H], nl ],
1153 meta_decls(T).
1154
1155message_location_file_term_position(File, TermPos) -->
1156 { arg(1, TermPos, CharCount),
1157 filepos_line(File, CharCount, Line, LinePos)
1158 },
1159 [ '~w:~d:~d: '-[File, Line, LinePos] ].
1160
1165
1166filepos_line(File, CharPos, Line, LinePos) :-
1167 setup_call_cleanup(
1168 ( open(File, read, In),
1169 open_null_stream(Out)
1170 ),
1171 ( copy_stream_data(In, Out, CharPos),
1172 stream_property(In, position(Pos)),
1173 stream_position_data(line_count, Pos, Line),
1174 stream_position_data(line_position, Pos, LinePos)
1175 ),
1176 ( close(Out),
1177 close(In)
1178 ))