1 % (c) 2009-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2 % Heinrich Heine Universitaet Duesseldorf
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5 :- module(hit_profiler,[add_profile_hit/1, add_profile_hit/2,
6 add_hit/2, add_hit/3,
7 add_hit_if_not_covered/2, % direct calls without abstraction of terms/args
8 add_profile_hash_hit/2,
9 add_span_hit/2,
10 add_to_profile_stats/2, get_profile_stats/2, retract_profile_stats/2,
11 profile_functor/1, get_profile_statistics/2,
12 reset_profiler/0, print_hit_profile_statistics/0]).
13
14 :- use_module(probsrc(module_information),[module_info/2]).
15 :- module_info(group,external_functions). % and debugging
16 :- module_info(description,'This module provides a simple profile just counting number of hits.').
17
18 % call with hit_profiler:print_hit_profile_statistics.
19
20 print_hit_profile_statistics :- \+ profile_functor(_),!. % print nothing
21 print_hit_profile_statistics :- print('-- ProB hit profiler statistics --'),nl,
22 profile_functor(F),
23 print('Functor : '), print(F),
24 findall(hits(Nr,A),hit(_,F,A,Nr),Hits),
25 sort(Hits,SortedHits), sum_hits(Hits,0,TotalHits), print(' --> '), print(TotalHits),nl,
26 print_hits(SortedHits),
27 fail.
28 print_hit_profile_statistics :- profile_category_stats(Category,TotalNr),
29 format('- Statistic: ~w --> ~w~n',[Category,TotalNr]),
30 fail.
31 print_hit_profile_statistics :- print('-- end --'),nl.
32
33 get_profile_statistics(F,Hits) :-
34 profile_functor(F),
35 findall(hit(A,Nr),hit(_,F,A,Nr),Hits).
36
37 sum_hits([],A,A).
38 sum_hits([hits(Nr,_)|T],A,R) :- NA is A+Nr, sum_hits(T,NA,R).
39
40 print_hits([]).
41 print_hits([hits(Nr,A)|T]) :- print(' - '), print(A), print(' --> '), print(Nr),nl,
42 print_hits(T).
43
44 :- dynamic hit/4.
45 :- dynamic profile_functor/1.
46 :- dynamic profile_category_stats/2.
47 reset_profiler :- retractall(hit(_,_,_,_)), retractall(profile_functor(_)), retractall(profile_category_stats(_,_)).
48
49 :- use_module(probsrc(eventhandling),[register_event_listener/3]).
50 :- register_event_listener(clear_specification,reset_profiler,
51 'Reset hit profiler.').
52
53 %:- meta_predicate add_profile_hit(0).
54 add_profile_hit(Call) :- add_profile_hit(Call,1).
55 %:- meta_predicate add_profile_hit(0,*).
56 add_profile_hit(Call,Level) :-
57 decompose_call(Call,Functor,Args),
58 abstract_args(Args,Level,AA),
59 %print(hit(Call,Functor,Args,AA)),nl,
60 add_hit(Functor,AA).
61
62 % add hit for a functor with span info
63 add_span_hit(_,_) :- current_prolog_flag(profiling,off),!.
64 add_span_hit(Call,Span) :-
65 error_manager:extract_line_col(Span,Line,Col,EndLine,EndCol),!,
66 decompose_call(Call,Functor,Args),
67 add_hit(Functor,[Line,Col,EndLine,EndCol|Args]).
68 add_span_hit(Call,_) :-
69 decompose_call(Call,Functor,Args),
70 add_hit(Functor,Args).
71
72
73 % add hit where term gets abstracted to hash; interesting to see if we have lots of different calls
74 add_profile_hash_hit(Functor,Term) :- term_hash(Term,Hash), add_hit(Functor,Hash).
75
76 decompose_call(X,F,A) :- var(X),!,F=var,A=[].
77 decompose_call(_Module:Call,Functor,Args) :- !, Call =.. [Functor|Args].
78 decompose_call(Call,Functor,Args) :- Call =.. [Functor|Args].
79
80
81 abstract_args([],_,[]).
82 abstract_args([H|T],Level,[AH|AT]) :- abstract_arg(H,Level,AH), abstract_args(T,Level,AT).
83
84 :- use_module(library(avl)).
85 abstract_arg(X,_,R) :- var(X),!,R=var.
86 abstract_arg(X,Level,R) :- number(X),!,(Level>0 -> R=X ; R=number).
87 abstract_arg([],_,R) :- !, R=[].
88 abstract_arg(X,Level,R) :- atomic(X),!,(Level>0 -> R=X ; R=atomic).
89 abstract_arg(b(Pred,_,_),Level,R) :- !, R=b(AP),abstract_arg(Pred,Level,AP).
90 abstract_arg(avl_set(A),Level,R) :- !, (Level>0 -> avl_size(A,Sz), R=avl_set(Sz) ; R=avl_set).
91 abstract_arg(node(A,B,C,D,E),Level,Res) :- (Level>0 -> avl_size(node(A,B,C,D,E),Sz), R=avl_node(Sz) ; R=avl_node), !, Res=R.
92 abstract_arg([H|T],Level,R) :- length([H|T],L),!,
93 (Level>0 -> R = list(L) ; R=list).
94 %LL is L//100,R=list(LL).
95 abstract_arg(X,0,R) :- !, functor(X,F,N), R=F/N.
96 abstract_arg(X,Level,R) :- X =.. [F|Args], L1 is Level-1, abstract_args(Args,L1,AA),
97 R =.. [F|AA].
98
99 :- use_module(library(terms),[term_hash/2]).
100 add_hit(F,A) :- add_hit(F,A,_).
101 add_hit(Functor,AbsArgs,NewNr) :-
102 term_hash(hit(Functor,AbsArgs),Hash),
103 add_hit_hash(Hash,Functor,AbsArgs,NewNr).
104
105 add_hit_hash(Hash,Functor,AbsArgs,New) :-
106 (retract(hit(Hash,Functor,AbsArgs,Old))
107 -> true
108 ; Old=0,
109 (profile_functor(Functor) -> true ; assertz(profile_functor(Functor)))
110 ),
111 New is Old+1,
112 assertz(hit(Hash,Functor,AbsArgs,New)).
113
114 % use if you do not want to count number of hits:
115 add_hit_if_not_covered(Functor,AbsArgs) :-
116 term_hash(hit(Functor,AbsArgs),Hash),
117 (hit(Hash,Functor,AbsArgs,_Old) -> true
118 ; assertz(hit(Hash,Functor,AbsArgs,1)),
119 (profile_functor(Functor) -> true ; assertz(profile_functor(Functor)))
120 ).
121
122 % general statistics infos like walltime, ...
123 add_to_profile_stats(Category,Nr) :-
124 (retract(profile_category_stats(Category,OldNr)) -> true ; OldNr=0),
125 NewNr is OldNr+Nr,
126 format('Updating stats ~w : ~w~n',[Category,NewNr]),
127 assertz(profile_category_stats(Category,NewNr)).
128
129 get_profile_stats(Category,Nr) :- profile_category_stats(Category,Nr).
130 retract_profile_stats(Category,Nr) :- retract(profile_category_stats(Category,Nr)).