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 add_profiling_nr
45
46 :- dynamic hit/4.
47 :- dynamic profile_functor/1.
48 :- dynamic profile_category_stats/2.
49 reset_profiler :- retractall(hit(_,_,_,_)), retractall(profile_functor(_)), retractall(profile_category_stats(_,_)).
50
51 :- use_module(probsrc(eventhandling),[register_event_listener/3]).
52 :- register_event_listener(clear_specification,reset_profiler,
53 'Reset hit profiler.').
54
55 %:- meta_predicate add_profile_hit(0).
56 add_profile_hit(Call) :- add_profile_hit(Call,1).
57 %:- meta_predicate add_profile_hit(0,*).
58 add_profile_hit(Call,Level) :-
59 decompose_call(Call,Functor,Args),
60 abstract_args(Args,Level,AA),
61 %print(hit(Call,Functor,Args,AA)),nl,
62 add_hit(Functor,AA).
63
64 % add hit for a functor with span info
65 add_span_hit(_,_) :- current_prolog_flag(profiling,off),!.
66 add_span_hit(Call,Span) :-
67 error_manager:extract_line_col(Span,Line,Col,EndLine,EndCol),!,
68 decompose_call(Call,Functor,Args),
69 add_hit(Functor,[Line,Col,EndLine,EndCol|Args]).
70 add_span_hit(Call,_) :-
71 decompose_call(Call,Functor,Args),
72 add_hit(Functor,Args).
73
74
75 % add hit where term gets abstracted to hash; interesting to see if we have lots of different calls
76 add_profile_hash_hit(Functor,Term) :- term_hash(Term,Hash), add_hit(Functor,Hash).
77
78 decompose_call(X,F,A) :- var(X),!,F=var,A=[].
79 decompose_call(_Module:Call,Functor,Args) :- !, Call =.. [Functor|Args].
80 decompose_call(Call,Functor,Args) :- Call =.. [Functor|Args].
81
82
83 abstract_args([],_,[]).
84 abstract_args([H|T],Level,[AH|AT]) :- abstract_arg(H,Level,AH), abstract_args(T,Level,AT).
85
86 :- use_module(library(avl)).
87 abstract_arg(X,_,R) :- var(X),!,R=var.
88 abstract_arg(X,Level,R) :- number(X),!,(Level>0 -> R=X ; R=number).
89 abstract_arg([],_,R) :- !, R=[].
90 abstract_arg(X,Level,R) :- atomic(X),!,(Level>0 -> R=X ; R=atomic).
91 abstract_arg(b(Pred,_,_),Level,R) :- !, R=b(AP),abstract_arg(Pred,Level,AP).
92 abstract_arg(avl_set(A),Level,R) :- !, (Level>0 -> avl_size(A,Sz), R=avl_set(Sz) ; R=avl_set).
93 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.
94 abstract_arg([H|T],Level,R) :- length([H|T],L),!,
95 (Level>0 -> R = list(L) ; R=list).
96 %LL is L//100,R=list(LL).
97 abstract_arg(X,0,R) :- !, functor(X,F,N), R=F/N.
98 abstract_arg(X,Level,R) :- X =.. [F|Args], L1 is Level-1, abstract_args(Args,L1,AA),
99 R =.. [F|AA].
100
101 :- use_module(library(terms),[term_hash/2]).
102 add_hit(F,A) :- add_hit(F,A,_).
103 add_hit(Functor,AbsArgs,NewNr) :-
104 term_hash(hit(Functor,AbsArgs),Hash),
105 add_hit_hash(Hash,Functor,AbsArgs,NewNr).
106
107 add_hit_hash(Hash,Functor,AbsArgs,New) :-
108 (retract(hit(Hash,Functor,AbsArgs,Old))
109 -> true
110 ; Old=0,
111 (profile_functor(Functor) -> true ; assertz(profile_functor(Functor)))
112 ),
113 New is Old+1,
114 assertz(hit(Hash,Functor,AbsArgs,New)).
115
116 % use if you do not want to count number of hits:
117 add_hit_if_not_covered(Functor,AbsArgs) :-
118 term_hash(hit(Functor,AbsArgs),Hash),
119 (hit(Hash,Functor,AbsArgs,_Old) -> true
120 ; assertz(hit(Hash,Functor,AbsArgs,1)),
121 (profile_functor(Functor) -> true ; assertz(profile_functor(Functor)))
122 ).
123
124 % general statistics infos like walltime, ...
125 add_to_profile_stats(Category,Nr) :-
126 (retract(profile_category_stats(Category,OldNr)) -> true ; OldNr=0),
127 NewNr is OldNr+Nr,
128 format('Updating stats ~w : ~w~n',[Category,NewNr]),
129 assertz(profile_category_stats(Category,NewNr)).
130
131 get_profile_stats(Category,Nr) :- profile_category_stats(Category,Nr).
132 retract_profile_stats(Category,Nr) :- retract(profile_category_stats(Category,Nr)).