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