36
37:- module(prolog_codewalk,
38 [ prolog_walk_code/1, 39 prolog_program_clause/2 40 ]). 41:- use_module(library(record),[(record)/1, op(_,_,record)]). 42:- use_module(library(debug),[debug/3,debugging/1,assertion/1]). 43
44:- autoload(library(apply),[maplist/2]). 45:- autoload(library(error),[must_be/2]). 46:- autoload(library(listing),[portray_clause/1]). 47:- autoload(library(lists),[member/2,nth1/3,append/3]). 48:- autoload(library(option),[meta_options/3]). 49:- autoload(library(prolog_clause),
50 [clause_info/4,initialization_layout/4,clause_name/2]). 51:- autoload(library(prolog_metainference),
52 [inferred_meta_predicate/2,infer_meta_predicate/2]). 53
54
86
87:- meta_predicate
88 prolog_walk_code(:). 89
90:- multifile
91 prolog:called_by/4,
92 prolog:called_by/2. 93
94:- predicate_options(prolog_walk_code/1, 1,
95 [ undefined(oneof([ignore,error,trace])),
96 autoload(boolean),
97 clauses(list),
98 module(atom),
99 module_class(list(oneof([user,system,library,
100 test,development]))),
101 source(boolean),
102 trace_reference(any),
103 trace_condition(callable),
104 on_trace(callable),
105 on_edge(callable),
106 infer_meta_predicates(oneof([false,true,all])),
107 walk_meta_predicates(boolean),
108 evaluate(boolean),
109 verbose(boolean)
110 ]). 111
112:- record
113 walk_option(undefined:oneof([ignore,error,trace])=ignore,
114 autoload:boolean=true,
115 source:boolean=true,
116 module:atom, 117 module_class:list(oneof([user,system,library,
118 test,development]))=[user,library],
119 infer_meta_predicates:oneof([false,true,all])=true,
120 walk_meta_predicates:boolean=true,
121 clauses:list, 122 trace_reference:any=(-),
123 trace_condition:callable, 124 on_edge:callable, 125 on_trace:callable, 126 127 clause, 128 caller, 129 initialization, 130 undecided, 131 evaluate:boolean, 132 verbose:boolean=false). 133
134:- thread_local
135 multifile_predicate/3. 136
244
245prolog_walk_code(Options) :-
246 meta_options(is_meta, Options, QOptions),
247 prolog_walk_code(1, QOptions).
248
249prolog_walk_code(Iteration, Options) :-
250 statistics(cputime, CPU0),
251 make_walk_option(Options, OTerm, _),
252 ( walk_option_clauses(OTerm, Clauses),
253 nonvar(Clauses)
254 -> walk_clauses(Clauses, OTerm)
255 ; forall(( walk_option_module(OTerm, M0),
256 copy_term(M0, M),
257 current_module(M),
258 scan_module(M, OTerm)
259 ),
260 find_walk_from_module(M, OTerm)),
261 walk_from_multifile(OTerm),
262 walk_from_initialization(OTerm)
263 ),
264 infer_new_meta_predicates(New, OTerm),
265 statistics(cputime, CPU1),
266 ( New \== []
267 -> CPU is CPU1-CPU0,
268 ( walk_option_verbose(OTerm, true)
269 -> Level = informational
270 ; Level = silent
271 ),
272 print_message(Level,
273 codewalk(reiterate(New, Iteration, CPU))),
274 succ(Iteration, Iteration2),
275 prolog_walk_code(Iteration2, Options)
276 ; true
277 ).
278
279is_meta(on_edge).
280is_meta(on_trace).
281is_meta(trace_condition).
282
286
287walk_clauses(Clauses, OTerm) :-
288 must_be(list, Clauses),
289 forall(member(ClauseRef, Clauses),
290 ( user:clause(CHead, Body, ClauseRef),
291 ( CHead = Module:Head
292 -> true
293 ; Module = user,
294 Head = CHead
295 ),
296 walk_option_clause(OTerm, ClauseRef),
297 walk_option_caller(OTerm, Module:Head),
298 walk_called_by_body(Body, Module, OTerm)
299 )).
300
304
305scan_module(M, OTerm) :-
306 walk_option_module(OTerm, M1),
307 nonvar(M1),
308 !,
309 \+ M \= M1.
310scan_module(M, OTerm) :-
311 walk_option_module_class(OTerm, Classes),
312 module_property(M, class(Class)),
313 memberchk(Class, Classes),
314 !.
315
322
323walk_from_initialization(OTerm) :-
324 walk_option_caller(OTerm, '<initialization>'),
325 forall(init_goal_in_scope(Goal, SourceLocation, OTerm),
326 ( walk_option_initialization(OTerm, SourceLocation),
327 walk_from_initialization(Goal, OTerm))).
328
329init_goal_in_scope(Goal, SourceLocation, OTerm) :-
330 '$init_goal'(_When, Goal, SourceLocation),
331 SourceLocation = File:_Line,
332 ( walk_option_module(OTerm, M),
333 nonvar(M)
334 -> module_property(M, file(File))
335 ; walk_option_module_class(OTerm, Classes),
336 source_file_property(File, module(MF))
337 -> module_property(MF, class(Class)),
338 memberchk(Class, Classes),
339 walk_option_module(OTerm, MF)
340 ; true
341 ).
342
343walk_from_initialization(M:Goal, OTerm) :-
344 scan_module(M, OTerm),
345 !,
346 walk_called_by_body(Goal, M, OTerm).
347walk_from_initialization(_, _).
348
349
354
355find_walk_from_module(M, OTerm) :-
356 debug(autoload, 'Analysing module ~q', [M]),
357 walk_option_module(OTerm, M),
358 forall(predicate_in_module(M, PI),
359 walk_called_by_pred(M:PI, OTerm)).
360
361walk_called_by_pred(Module:Name/Arity, _) :-
362 multifile_predicate(Name, Arity, Module),
363 !.
364walk_called_by_pred(Module:Name/Arity, _) :-
365 functor(Head, Name, Arity),
366 predicate_property(Module:Head, multifile),
367 !,
368 assertz(multifile_predicate(Name, Arity, Module)).
369walk_called_by_pred(Module:Name/Arity, OTerm) :-
370 functor(Head, Name, Arity),
371 ( no_walk_property(Property),
372 predicate_property(Module:Head, Property)
373 -> true
374 ; walk_option_caller(OTerm, Module:Head),
375 walk_option_clause(OTerm, ClauseRef),
376 forall(catch(clause(Module:Head, Body, ClauseRef), _, fail),
377 walk_called_by_body(Body, Module, OTerm))
378 ).
379
380no_walk_property(number_of_rules(0)). 381no_walk_property(foreign). 382
386
387walk_from_multifile(OTerm) :-
388 forall(retract(multifile_predicate(Name, Arity, Module)),
389 walk_called_by_multifile(Module:Name/Arity, OTerm)).
390
391walk_called_by_multifile(Module:Name/Arity, OTerm) :-
392 functor(Head, Name, Arity),
393 forall(catch(clause_not_from_development(
394 Module:Head, Body, ClauseRef, OTerm),
395 _, fail),
396 ( walk_option_clause(OTerm, ClauseRef),
397 walk_option_caller(OTerm, Module:Head),
398 walk_called_by_body(Body, Module, OTerm)
399 )).
400
401
406
407clause_not_from_development(Module:Head, Body, Ref, OTerm) :-
408 clause(Module:Head, Body, Ref),
409 \+ ( clause_property(Ref, file(File)),
410 module_property(LoadModule, file(File)),
411 \+ scan_module(LoadModule, OTerm)
412 ).
413
421
422walk_called_by_body(True, _, _) :-
423 True == true,
424 !. 425walk_called_by_body(Body, Module, OTerm) :-
426 set_undecided_of_walk_option(error, OTerm, OTerm1),
427 set_evaluate_of_walk_option(false, OTerm1, OTerm2),
428 catch(walk_called(Body, Module, _TermPos, OTerm2),
429 missing(Missing),
430 walk_called_by_body(Missing, Body, Module, OTerm)),
431 !.
432walk_called_by_body(Body, Module, OTerm) :-
433 format(user_error, 'Failed to analyse:~n', []),
434 portray_clause(('<head>' :- Body)),
435 debug_walk(Body, Module, OTerm).
436
439:- if(debugging(codewalk(trace))). 440debug_walk(Body, Module, OTerm) :-
441 gtrace,
442 walk_called_by_body(Body, Module, OTerm).
443:- else. 444debug_walk(_,_,_).
445:- endif. 446
451
452walk_called_by_body(Missing, Body, _, OTerm) :-
453 debugging(codewalk),
454 format(user_error, 'Retrying due to ~w (~p)~n', [Missing, OTerm]),
455 portray_clause(('<head>' :- Body)), fail.
456walk_called_by_body(undecided_call, Body, Module, OTerm) :-
457 catch(forall(walk_called(Body, Module, _TermPos, OTerm),
458 true),
459 missing(Missing),
460 walk_called_by_body(Missing, Body, Module, OTerm)).
461walk_called_by_body(subterm_positions, Body, Module, OTerm) :-
462 ( ( walk_option_clause(OTerm, ClauseRef), nonvar(ClauseRef),
463 clause_info(ClauseRef, _, TermPos, _NameOffset),
464 TermPos = term_position(_,_,_,_,[_,BodyPos])
465 -> WBody = Body
466 ; walk_option_initialization(OTerm, SrcLoc),
467 ground(SrcLoc), SrcLoc = _File:_Line,
468 initialization_layout(SrcLoc, Module:Body, WBody, BodyPos)
469 )
470 -> catch(forall(walk_called(WBody, Module, BodyPos, OTerm),
471 true),
472 missing(subterm_positions),
473 walk_called_by_body(no_positions, Body, Module, OTerm))
474 ; set_source_of_walk_option(false, OTerm, OTerm2),
475 forall(walk_called(Body, Module, _BodyPos, OTerm2),
476 true)
477 ).
478walk_called_by_body(no_positions, Body, Module, OTerm) :-
479 set_source_of_walk_option(false, OTerm, OTerm2),
480 forall(walk_called(Body, Module, _NoPos, OTerm2),
481 true).
482
483
510
511walk_called(Term, Module, parentheses_term_position(_,_,Pos), OTerm) :-
512 nonvar(Pos),
513 !,
514 walk_called(Term, Module, Pos, OTerm).
515walk_called(Var, _, TermPos, OTerm) :-
516 var(Var), 517 !,
518 undecided(Var, TermPos, OTerm).
519walk_called(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :-
520 !,
521 ( nonvar(M)
522 -> walk_called(G, M, Pos, OTerm)
523 ; undecided(M, MPos, OTerm)
524 ).
525walk_called((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
526 !,
527 walk_called(A, M, PA, OTerm),
528 walk_called(B, M, PB, OTerm).
529walk_called((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
530 !,
531 walk_called(A, M, PA, OTerm),
532 walk_called(B, M, PB, OTerm).
533walk_called((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
534 !,
535 walk_called(A, M, PA, OTerm),
536 walk_called(B, M, PB, OTerm).
537walk_called(\+(A), M, term_position(_,_,_,_,[PA]), OTerm) :-
538 !,
539 \+ \+ walk_called(A, M, PA, OTerm).
540walk_called((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
541 !,
542 ( walk_option_evaluate(OTerm, Eval), Eval == true
543 -> Goal = (A;B),
544 setof(Goal,
545 ( walk_called(A, M, PA, OTerm)
546 ; walk_called(B, M, PB, OTerm)
547 ),
548 Alts0),
549 variants(Alts0, Alts),
550 member(Goal, Alts)
551 ; \+ \+ walk_called(A, M, PA, OTerm), 552 \+ \+ walk_called(B, M, PB, OTerm)
553 ).
554walk_called(Goal, Module, TermPos, OTerm) :-
555 walk_option_trace_reference(OTerm, To), To \== (-),
556 ( subsumes_term(To, Module:Goal)
557 -> M2 = Module
558 ; predicate_property(Module:Goal, imported_from(M2)),
559 subsumes_term(To, M2:Goal)
560 ),
561 trace_condition(M2:Goal, TermPos, OTerm),
562 print_reference(M2:Goal, TermPos, trace, OTerm),
563 fail. 564walk_called(Goal, Module, _, OTerm) :-
565 evaluate(Goal, Module, OTerm),
566 !.
567walk_called(autoload_call(_), _, _, _) :-
568 !. 569walk_called(Goal, M, TermPos, OTerm) :-
570 ( ( predicate_property(M:Goal, imported_from(IM))
571 -> true
572 ; IM = M
573 ),
574 prolog:called_by(Goal, IM, M, Called)
575 ; prolog:called_by(Goal, Called)
576 ),
577 Called \== [],
578 !,
579 walk_called_by(Called, M, Goal, TermPos, OTerm).
580walk_called(Meta, M, term_position(_,E,_,_,ArgPosList), OTerm) :-
581 walk_option_walk_meta_predicates(OTerm, true),
582 ( walk_option_autoload(OTerm, false)
583 -> nonvar(M),
584 '$get_predicate_attribute'(M:Meta, defined, 1)
585 ; true
586 ),
587 ( predicate_property(M:Meta, meta_predicate(Head))
588 ; inferred_meta_predicate(M:Meta, Head)
589 ),
590 !,
591 walk_option_clause(OTerm, ClauseRef),
592 register_possible_meta_clause(ClauseRef),
593 walk_meta_call(1, Head, Meta, M, ArgPosList, E-E, OTerm).
594walk_called(Closure, _, _, _) :-
595 blob(Closure, closure),
596 !,
597 '$closure_predicate'(Closure, Module:Name/Arity),
598 functor(Head, Name, Arity),
599 '$get_predicate_attribute'(Module:Head, defined, 1).
600walk_called(ClosureCall, _, _, _) :-
601 compound(ClosureCall),
602 compound_name_arity(ClosureCall, Closure, _),
603 blob(Closure, closure),
604 !,
605 '$closure_predicate'(Closure, Module:Name/Arity),
606 functor(Head, Name, Arity),
607 '$get_predicate_attribute'(Module:Head, defined, 1).
608walk_called(Goal, Module, _, _) :-
609 nonvar(Module),
610 '$get_predicate_attribute'(Module:Goal, defined, 1),
611 !.
612walk_called(Goal, Module, TermPos, OTerm) :-
613 callable(Goal),
614 !,
615 undefined(Module:Goal, TermPos, OTerm).
616walk_called(Goal, _Module, TermPos, OTerm) :-
617 not_callable(Goal, TermPos, OTerm).
618
622
623trace_condition(Callee, TermPos, OTerm) :-
624 walk_option_trace_condition(OTerm, Cond), nonvar(Cond),
625 !,
626 cond_location_context(OTerm, TermPos, Context0),
627 walk_option_caller(OTerm, Caller),
628 walk_option_module(OTerm, Module),
629 put_dict(#{caller:Caller, module:Module}, Context0, Context),
630 call(Cond, Callee, Context).
631trace_condition(_, _, _).
632
633cond_location_context(OTerm, _TermPos, Context) :-
634 walk_option_clause(OTerm, Clause), nonvar(Clause),
635 !,
636 Context = #{clause:Clause}.
637cond_location_context(OTerm, _TermPos, Context) :-
638 walk_option_initialization(OTerm, Init), nonvar(Init),
639 !,
640 Context = #{initialization:Init}.
641
643
644undecided(Var, TermPos, OTerm) :-
645 walk_option_undecided(OTerm, Undecided),
646 ( var(Undecided)
647 -> Action = ignore
648 ; Action = Undecided
649 ),
650 undecided(Action, Var, TermPos, OTerm).
651
652undecided(ignore, _, _, _) :- !.
653undecided(error, _, _, _) :-
654 throw(missing(undecided_call)).
655
657
658evaluate(Goal, Module, OTerm) :-
659 walk_option_evaluate(OTerm, Evaluate),
660 Evaluate \== false,
661 evaluate(Goal, Module).
662
663evaluate(A=B, _) :-
664 unify_with_occurs_check(A, B).
665
669
670undefined(_, _, OTerm) :-
671 walk_option_undefined(OTerm, ignore),
672 !.
673undefined(Goal, _, _) :-
674 predicate_property(Goal, autoload(_)),
675 !.
676undefined(Goal, TermPos, OTerm) :-
677 ( walk_option_undefined(OTerm, trace)
678 -> Why = trace
679 ; Why = undefined
680 ),
681 print_reference(Goal, TermPos, Why, OTerm).
682
686
687not_callable(Goal, TermPos, OTerm) :-
688 print_reference(Goal, TermPos, not_callable, OTerm).
689
690
696
697print_reference(Goal, TermPos, Why, OTerm) :-
698 walk_option_clause(OTerm, Clause), nonvar(Clause),
699 !,
700 ( compound(TermPos),
701 arg(1, TermPos, CharCount),
702 integer(CharCount) 703 -> From = clause_term_position(Clause, TermPos)
704 ; walk_option_source(OTerm, false)
705 -> From = clause(Clause)
706 ; From = _,
707 throw(missing(subterm_positions))
708 ),
709 print_reference2(Goal, From, Why, OTerm).
710print_reference(Goal, TermPos, Why, OTerm) :-
711 walk_option_initialization(OTerm, Init), nonvar(Init),
712 Init = File:Line,
713 !,
714 ( compound(TermPos),
715 arg(1, TermPos, CharCount),
716 integer(CharCount) 717 -> From = file_term_position(File, TermPos)
718 ; walk_option_source(OTerm, false)
719 -> From = file(File, Line, -1, _)
720 ; From = _,
721 throw(missing(subterm_positions))
722 ),
723 print_reference2(Goal, From, Why, OTerm).
724print_reference(Goal, _, Why, OTerm) :-
725 print_reference2(Goal, _, Why, OTerm).
726
727print_reference2(Goal, From, trace, OTerm) :-
728 walk_option_on_trace(OTerm, Closure),
729 nonvar(Closure),
730 walk_option_caller(OTerm, Caller),
731 call(Closure, Goal, Caller, From),
732 !.
733print_reference2(Goal, From, trace, OTerm) :-
734 walk_option_on_edge(OTerm, Closure),
735 nonvar(Closure),
736 walk_option_caller(OTerm, Caller),
737 translate_location(From, Dict),
738 call(Closure, Goal, Caller, Dict),
739 !.
740print_reference2(Goal, From, Why, _OTerm) :-
741 make_message(Why, Goal, From, Message, Level),
742 print_message(Level, Message).
743
744
745make_message(undefined, Goal, Context,
746 error(existence_error(procedure, PI), Context), error) :-
747 goal_pi(Goal, PI).
748make_message(not_callable, Goal, Context,
749 error(type_error(callable, Goal), Context), error).
750make_message(trace, Goal, Context,
751 trace_call_to(PI, Context), informational) :-
752 goal_pi(Goal, PI).
753
754
755goal_pi(Goal, M:Name/Arity) :-
756 strip_module(Goal, M, Head),
757 callable(Head),
758 !,
759 functor(Head, Name, Arity).
760goal_pi(Goal, Goal).
761
762:- dynamic
763 possible_meta_predicate/2. 764
771
772register_possible_meta_clause(ClausesRef) :-
773 nonvar(ClausesRef),
774 clause_property(ClausesRef, predicate(PI)),
775 pi_head(PI, Head, Module),
776 module_property(Module, class(user)),
777 \+ predicate_property(Module:Head, meta_predicate(_)),
778 \+ inferred_meta_predicate(Module:Head, _),
779 \+ possible_meta_predicate(Head, Module),
780 !,
781 assertz(possible_meta_predicate(Head, Module)).
782register_possible_meta_clause(_).
783
784pi_head(Module:Name/Arity, Head, Module) :-
785 !,
786 functor(Head, Name, Arity).
787pi_head(_, _, _) :-
788 assertion(fail).
789
791
792infer_new_meta_predicates([], OTerm) :-
793 walk_option_infer_meta_predicates(OTerm, false),
794 !.
795infer_new_meta_predicates(MetaSpecs, OTerm) :-
796 findall(Module:MetaSpec,
797 ( retract(possible_meta_predicate(Head, Module)),
798 infer_meta_predicate(Module:Head, MetaSpec),
799 ( walk_option_infer_meta_predicates(OTerm, all)
800 -> true
801 ; calling_metaspec(MetaSpec)
802 )
803 ),
804 MetaSpecs).
805
810
811calling_metaspec(Head) :-
812 arg(_, Head, Arg),
813 calling_metaarg(Arg),
814 !.
815
816calling_metaarg(I) :- integer(I), !.
817calling_metaarg(^).
818calling_metaarg(//).
819
820
830
831walk_meta_call(I, Head, Meta, M, ArgPosList, EPos, OTerm) :-
832 arg(I, Head, AS),
833 !,
834 ( ArgPosList = [ArgPos|ArgPosTail]
835 -> true
836 ; ArgPos = EPos,
837 ArgPosTail = []
838 ),
839 ( integer(AS)
840 -> arg(I, Meta, MA),
841 extend(MA, AS, Goal, ArgPos, ArgPosEx, OTerm),
842 walk_called(Goal, M, ArgPosEx, OTerm)
843 ; AS == (^)
844 -> arg(I, Meta, MA),
845 remove_quantifier(MA, Goal, ArgPos, ArgPosEx, M, MG, OTerm),
846 walk_called(Goal, MG, ArgPosEx, OTerm)
847 ; AS == (//)
848 -> arg(I, Meta, DCG),
849 walk_dcg_body(DCG, M, ArgPos, OTerm)
850 ; true
851 ),
852 succ(I, I2),
853 walk_meta_call(I2, Head, Meta, M, ArgPosTail, EPos, OTerm).
854walk_meta_call(_, _, _, _, _, _, _).
855
856remove_quantifier(Goal, _, TermPos, TermPos, M, M, OTerm) :-
857 var(Goal),
858 !,
859 undecided(Goal, TermPos, OTerm).
860remove_quantifier(_^Goal0, Goal,
861 term_position(_,_,_,_,[_,GPos]),
862 TermPos, M0, M, OTerm) :-
863 !,
864 remove_quantifier(Goal0, Goal, GPos, TermPos, M0, M, OTerm).
865remove_quantifier(M1:Goal0, Goal,
866 term_position(_,_,_,_,[_,GPos]),
867 TermPos, _, M, OTerm) :-
868 !,
869 remove_quantifier(Goal0, Goal, GPos, TermPos, M1, M, OTerm).
870remove_quantifier(Goal, Goal, TermPos, TermPos, M, M, _).
871
872
877
878walk_called_by([], _, _, _, _).
879walk_called_by([H|T], M, Goal, TermPos, OTerm) :-
880 ( H = G0+N
881 -> subterm_pos(G0, M, Goal, TermPos, G, GPos),
882 ( extend(G, N, G2, GPos, GPosEx, OTerm)
883 -> walk_called(G2, M, GPosEx, OTerm)
884 ; true
885 )
886 ; subterm_pos(H, M, Goal, TermPos, G, GPos),
887 walk_called(G, M, GPos, OTerm)
888 ),
889 walk_called_by(T, M, Goal, TermPos, OTerm).
890
891subterm_pos(Sub, _, Term, TermPos, Sub, SubTermPos) :-
892 subterm_pos(Sub, Term, TermPos, SubTermPos),
893 !.
894subterm_pos(Sub, M, Term, TermPos, G, SubTermPos) :-
895 nonvar(Sub),
896 Sub = M:H,
897 !,
898 subterm_pos(H, M, Term, TermPos, G, SubTermPos).
899subterm_pos(Sub, _, _, _, Sub, _).
900
901subterm_pos(Sub, Term, TermPos, SubTermPos) :-
902 subterm_pos(Sub, Term, same_term, TermPos, SubTermPos),
903 !.
904subterm_pos(Sub, Term, TermPos, SubTermPos) :-
905 subterm_pos(Sub, Term, ==, TermPos, SubTermPos),
906 !.
907subterm_pos(Sub, Term, TermPos, SubTermPos) :-
908 subterm_pos(Sub, Term, =@=, TermPos, SubTermPos),
909 !.
910subterm_pos(Sub, Term, TermPos, SubTermPos) :-
911 subterm_pos(Sub, Term, subsumes_term, TermPos, SubTermPos),
912 !.
913
917
918walk_dcg_body(Var, _Module, TermPos, OTerm) :-
919 var(Var),
920 !,
921 undecided(Var, TermPos, OTerm).
922walk_dcg_body([], _Module, _, _) :- !.
923walk_dcg_body([_|_], _Module, _, _) :- !.
924walk_dcg_body(String, _Module, _, _) :-
925 string(String),
926 !.
927walk_dcg_body(!, _Module, _, _) :- !.
928walk_dcg_body(M:G, _, term_position(_,_,_,_,[MPos,Pos]), OTerm) :-
929 !,
930 ( nonvar(M)
931 -> walk_dcg_body(G, M, Pos, OTerm)
932 ; undecided(M, MPos, OTerm)
933 ).
934walk_dcg_body((A,B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
935 !,
936 walk_dcg_body(A, M, PA, OTerm),
937 walk_dcg_body(B, M, PB, OTerm).
938walk_dcg_body((A->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
939 !,
940 walk_dcg_body(A, M, PA, OTerm),
941 walk_dcg_body(B, M, PB, OTerm).
942walk_dcg_body((A*->B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
943 !,
944 walk_dcg_body(A, M, PA, OTerm),
945 walk_dcg_body(B, M, PB, OTerm).
946walk_dcg_body((A;B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
947 !,
948 ( walk_dcg_body(A, M, PA, OTerm)
949 ; walk_dcg_body(B, M, PB, OTerm)
950 ).
951walk_dcg_body((A|B), M, term_position(_,_,_,_,[PA,PB]), OTerm) :-
952 !,
953 ( walk_dcg_body(A, M, PA, OTerm)
954 ; walk_dcg_body(B, M, PB, OTerm)
955 ).
956walk_dcg_body({G}, M, brace_term_position(_,_,PG), OTerm) :-
957 !,
958 walk_called(G, M, PG, OTerm).
959walk_dcg_body(G, M, TermPos, OTerm) :-
960 extend(G, 2, G2, TermPos, TermPosEx, OTerm),
961 walk_called(G2, M, TermPosEx, OTerm).
962
963
971
972:- meta_predicate
973 subterm_pos(+, +, 2, +, -),
974 sublist_pos(+, +, +, +, 2, -). 975:- public
976 subterm_pos/5. 977
978subterm_pos(_, _, _, Pos, _) :-
979 var(Pos), !, fail.
980subterm_pos(Sub, Term, Cmp, Pos, Pos) :-
981 call(Cmp, Sub, Term),
982 !.
983subterm_pos(Sub, Term, Cmp, term_position(_,_,_,_,ArgPosList), Pos) :-
984 is_list(ArgPosList),
985 compound(Term),
986 nth1(I, ArgPosList, ArgPos),
987 arg(I, Term, Arg),
988 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos).
989subterm_pos(Sub, Term, Cmp, list_position(_,_,ElemPosList,TailPos), Pos) :-
990 sublist_pos(ElemPosList, TailPos, Sub, Term, Cmp, Pos).
991subterm_pos(Sub, {Arg}, Cmp, brace_term_position(_,_,ArgPos), Pos) :-
992 subterm_pos(Sub, Arg, Cmp, ArgPos, Pos).
993
994sublist_pos([EP|TP], TailPos, Sub, [H|T], Cmp, Pos) :-
995 ( subterm_pos(Sub, H, Cmp, EP, Pos)
996 ; sublist_pos(TP, TailPos, Sub, T, Cmp, Pos)
997 ).
998sublist_pos([], TailPos, Sub, Tail, Cmp, Pos) :-
999 TailPos \== none,
1000 subterm_pos(Sub, Tail, Cmp, TailPos, Pos).
1001
1005
1006extend(Goal, 0, Goal, TermPos, TermPos, _) :- !.
1007extend(Goal, _, _, TermPos, TermPos, OTerm) :-
1008 var(Goal),
1009 !,
1010 undecided(Goal, TermPos, OTerm).
1011extend(M:Goal, N, M:GoalEx,
1012 term_position(F,T,FT,TT,[MPos,GPosIn]),
1013 term_position(F,T,FT,TT,[MPos,GPosOut]), OTerm) :-
1014 !,
1015 ( var(M)
1016 -> undecided(N, MPos, OTerm)
1017 ; true
1018 ),
1019 extend(Goal, N, GoalEx, GPosIn, GPosOut, OTerm).
1020extend(Goal, N, GoalEx, TermPosIn, TermPosOut, _) :-
1021 callable(Goal),
1022 !,
1023 Goal =.. List,
1024 length(Extra, N),
1025 extend_term_pos(TermPosIn, N, TermPosOut),
1026 append(List, Extra, ListEx),
1027 GoalEx =.. ListEx.
1028extend(Closure, N, M:GoalEx, TermPosIn, TermPosOut, OTerm) :-
1029 blob(Closure, closure), 1030 !,
1031 '$closure_predicate'(Closure, M:Name/Arity),
1032 length(Extra, N),
1033 extend_term_pos(TermPosIn, N, TermPosOut),
1034 GoalEx =.. [Name|Extra],
1035 ( N =:= Arity
1036 -> true
1037 ; print_reference(Closure, TermPosIn, closure_arity_mismatch, OTerm)
1038 ).
1039extend(Goal, _, _, TermPos, _, OTerm) :-
1040 print_reference(Goal, TermPos, not_callable, OTerm).
1041
1042extend_term_pos(Var, _, _) :-
1043 var(Var),
1044 !.
1045extend_term_pos(term_position(F,T,FT,TT,ArgPosIn),
1046 N,
1047 term_position(F,T,FT,TT,ArgPosOut)) :-
1048 !,
1049 length(Extra, N),
1050 maplist(=(0-0), Extra),
1051 append(ArgPosIn, Extra, ArgPosOut).
1052extend_term_pos(F-T, N, term_position(F,T,F,T,Extra)) :-
1053 length(Extra, N),
1054 maplist(=(0-0), Extra).
1055
1056
1058
1059variants([], []).
1060variants([H|T], List) :-
1061 variants(T, H, List).
1062
1063variants([], H, [H]).
1064variants([H|T], V, List) :-
1065 ( H =@= V
1066 -> variants(T, V, List)
1067 ; List = [V|List2],
1068 variants(T, H, List2)
1069 ).
1070
1074
1075predicate_in_module(Module, PI) :-
1076 current_predicate(Module:PI),
1077 PI = Name/Arity,
1078 \+ hidden_predicate(Name, Arity),
1079 functor(Head, Name, Arity),
1080 \+ predicate_property(Module:Head, imported_from(_)).
1081
1082
1083hidden_predicate(Name, _) :-
1084 atom(Name), 1085 sub_atom(Name, 0, _, _, '$wrap$').
1086
1087
1088 1091
1101
1102prolog_program_clause(ClauseRef, Options) :-
1103 make_walk_option(Options, OTerm, _),
1104 setup_call_cleanup(
1105 true,
1106 ( current_module(Module),
1107 scan_module(Module, OTerm),
1108 module_clause(Module, ClauseRef, OTerm)
1109 ; retract(multifile_predicate(Name, Arity, MM)),
1110 multifile_clause(ClauseRef, MM:Name/Arity, OTerm)
1111 ; initialization_clause(ClauseRef, OTerm)
1112 ),
1113 retractall(multifile_predicate(_,_,_))).
1114
1115
1116module_clause(Module, ClauseRef, _OTerm) :-
1117 predicate_in_module(Module, Name/Arity),
1118 \+ multifile_predicate(Name, Arity, Module),
1119 functor(Head, Name, Arity),
1120 ( predicate_property(Module:Head, multifile)
1121 -> assertz(multifile_predicate(Name, Arity, Module)),
1122 fail
1123 ; predicate_property(Module:Head, Property),
1124 no_enum_property(Property)
1125 -> fail
1126 ; catch(nth_clause(Module:Head, _, ClauseRef), _, fail)
1127 ).
1128
1129no_enum_property(foreign).
1130
1131multifile_clause(ClauseRef, M:Name/Arity, OTerm) :-
1132 functor(Head, Name, Arity),
1133 catch(clauseref_not_from_development(M:Head, ClauseRef, OTerm),
1134 _, fail).
1135
1136clauseref_not_from_development(Module:Head, Ref, OTerm) :-
1137 nth_clause(Module:Head, _N, Ref),
1138 \+ ( clause_property(Ref, file(File)),
1139 module_property(LoadModule, file(File)),
1140 \+ scan_module(LoadModule, OTerm)
1141 ).
1142
1143initialization_clause(ClauseRef, OTerm) :-
1144 catch(clause(system:'$init_goal'(_File, M:_Goal, SourceLocation),
1145 true, ClauseRef),
1146 _, fail),
1147 walk_option_initialization(OTerm, SourceLocation),
1148 scan_module(M, OTerm).
1149
1150
1152
1153translate_location(clause_term_position(ClauseRef, TermPos), Dict),
1154 clause_property(ClauseRef, file(File)) =>
1155 arg(1, TermPos, CharCount),
1156 filepos_line(File, CharCount, Line, LinePos),
1157 Dict = _{ clause: ClauseRef,
1158 file: File,
1159 character_count: CharCount,
1160 line_count: Line,
1161 line_position: LinePos
1162 }.
1163translate_location(clause(ClauseRef), Dict),
1164 clause_property(ClauseRef, file(File)),
1165 clause_property(ClauseRef, line_count(Line)) =>
1166 Dict = _{ clause: ClauseRef,
1167 file: File,
1168 line_count: Line
1169 }.
1170translate_location(clause(ClauseRef), Dict) =>
1171 Dict = _{ clause: ClauseRef
1172 }.
1173translate_location(file_term_position(Path, TermPos), Dict) =>
1174 arg(1, TermPos, CharCount),
1175 filepos_line(Path, CharCount, Line, LinePos),
1176 Dict = _{ file: Path,
1177 character_count: CharCount,
1178 line_count: Line,
1179 line_position: LinePos
1180 }.
1181translate_location(file(Path, Line, -1, _), Dict) =>
1182 Dict = _{ file: Path,
1183 line_count: Line
1184 }.
1185translate_location(Var, Dict), var(Var) =>
1186 Dict = _{}.
1187
1188 1191
1192:- multifile
1193 prolog:message//1,
1194 prolog:message_location//1. 1195
1196prolog:message(trace_call_to(PI, Context)) -->
1197 [ 'Call to ~q at '-[PI] ],
1198 '$messages':swi_location(Context).
1199
1200prolog:message_location(clause_term_position(ClauseRef, TermPos)) -->
1201 { clause_property(ClauseRef, file(File)) },
1202 message_location_file_term_position(File, TermPos).
1203prolog:message_location(clause(ClauseRef)) -->
1204 { clause_property(ClauseRef, file(File)),
1205 clause_property(ClauseRef, line_count(Line))
1206 },
1207 !,
1208 [ url(File:Line), ': ' ].
1209prolog:message_location(clause(ClauseRef)) -->
1210 { clause_name(ClauseRef, Name) },
1211 [ '~w: '-[Name] ].
1212prolog:message_location(file_term_position(Path, TermPos)) -->
1213 message_location_file_term_position(Path, TermPos).
1214prolog:message(codewalk(reiterate(New, Iteration, CPU))) -->
1215 [ 'Found new meta-predicates in iteration ~w (~3f sec)'-
1216 [Iteration, CPU], nl ],
1217 meta_decls(New),
1218 [ 'Restarting analysis ...'-[], nl ].
1219
1220meta_decls([]) --> [].
1221meta_decls([H|T]) -->
1222 [ ':- meta_predicate ~q.'-[H], nl ],
1223 meta_decls(T).
1224
1225message_location_file_term_position(File, TermPos) -->
1226 { arg(1, TermPos, CharCount),
1227 filepos_line(File, CharCount, Line, LinePos)
1228 },
1229 [ url(File:Line:LinePos), ': ' ].
1230
1235
1236filepos_line(File, CharPos, Line, LinePos) :-
1237 setup_call_cleanup(
1238 ( open(File, read, In),
1239 open_null_stream(Out)
1240 ),
1241 ( copy_stream_data(In, Out, CharPos),
1242 stream_property(In, position(Pos)),
1243 stream_position_data(line_count, Pos, Line),
1244 stream_position_data(line_position, Pos, LinePos)
1245 ),
1246 ( close(Out),
1247 close(In)
1248 ))