1 | % (c) 2009-2019 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_if_not_covered/2, % direct calls without abstraction of terms/args | |
7 | add_profile_hash_hit/2, | |
8 | profile_functor/1, get_profile_statistics/2, | |
9 | reset_profiler/0, print_hit_profile_statistics/0]). | |
10 | ||
11 | % call with hit_profiler:profile_statistics. | |
12 | ||
13 | print_hit_profile_statistics :- \+ profile_functor(_),!. % print nothing | |
14 | print_hit_profile_statistics :- print('-- ProB hit profiler statistics --'),nl, | |
15 | profile_functor(F), | |
16 | print('Functor : '), print(F), | |
17 | findall(hits(Nr,A),hit(_,F,A,Nr),Hits), | |
18 | sort(Hits,SortedHits), sum_hits(Hits,0,TotalHits), print(' --> '), print(TotalHits),nl, | |
19 | print_hits(SortedHits), | |
20 | fail. | |
21 | print_hit_profile_statistics :- print('-- end --'),nl. | |
22 | ||
23 | get_profile_statistics(F,Hits) :- | |
24 | profile_functor(F), | |
25 | findall(hit(A,Nr),hit(_,F,A,Nr),Hits). | |
26 | ||
27 | sum_hits([],A,A). | |
28 | sum_hits([hits(Nr,_)|T],A,R) :- NA is A+Nr, sum_hits(T,NA,R). | |
29 | ||
30 | print_hits([]). | |
31 | print_hits([hits(Nr,A)|T]) :- print(' - '), print(A), print(' --> '), print(Nr),nl, | |
32 | print_hits(T). | |
33 | ||
34 | :- dynamic hit/4. | |
35 | :- dynamic profile_functor/1. | |
36 | reset_profiler :- retractall(hit(_,_,_,_)), retractall(profile_functor(_)). | |
37 | ||
38 | %:- meta_predicate add_profile_hit(0). | |
39 | add_profile_hit(Call) :- add_profile_hit(Call,1). | |
40 | %:- meta_predicate add_profile_hit(0,*). | |
41 | add_profile_hit(Call,Level) :- | |
42 | decompose_call(Call,Functor,Args), | |
43 | abstract_args(Args,Level,AA), | |
44 | %print(hit(Call,Functor,Args,AA)),nl, | |
45 | add_hit(Functor,AA). | |
46 | ||
47 | % add hit where term gets abstracted to hash; interesting to see if we have lots of different calls | |
48 | add_profile_hash_hit(Functor,Term) :- term_hash(Term,Hash), add_hit(Functor,Hash). | |
49 | ||
50 | decompose_call(X,F,A) :- var(X),!,F=var,A=[]. | |
51 | decompose_call(_Module:Call,Functor,Args) :- !, Call =.. [Functor|Args]. | |
52 | decompose_call(Call,Functor,Args) :- Call =.. [Functor|Args]. | |
53 | ||
54 | ||
55 | abstract_args([],_,[]). | |
56 | abstract_args([H|T],Level,[AH|AT]) :- abstract_arg(H,Level,AH), abstract_args(T,Level,AT). | |
57 | ||
58 | :- use_module(library(avl)). | |
59 | abstract_arg(X,_,R) :- var(X),!,R=var. | |
60 | abstract_arg(X,Level,R) :- number(X),!,(Level>0 -> R=X ; R=number). | |
61 | abstract_arg([],_,R) :- !, R=[]. | |
62 | abstract_arg(X,Level,R) :- atomic(X),!,(Level>0 -> R=X ; R=atomic). | |
63 | abstract_arg(b(Pred,_,_),Level,R) :- !, R=b(AP),abstract_arg(Pred,Level,AP). | |
64 | abstract_arg(avl_set(A),Level,R) :- !, (Level>0 -> avl_size(A,Sz), R=avl_set(Sz) ; R=avl_set). | |
65 | 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. | |
66 | abstract_arg([H|T],Level,R) :- length([H|T],L),!, | |
67 | (Level>0 -> R = list(L) ; R=list). | |
68 | %LL is L//100,R=list(LL). | |
69 | abstract_arg(X,0,R) :- !, functor(X,F,N), R=F/N. | |
70 | abstract_arg(X,Level,R) :- X =.. [F|Args], L1 is Level-1, abstract_args(Args,L1,AA), | |
71 | R =.. [F|AA]. | |
72 | ||
73 | :- use_module(library(terms),[term_hash/2]). | |
74 | add_hit(Functor,AbsArgs) :- | |
75 | term_hash(hit(Functor,AbsArgs),Hash), | |
76 | add_hit_hash(Hash,Functor,AbsArgs). | |
77 | ||
78 | add_hit_hash(Hash,Functor,AbsArgs) :- | |
79 | (retract(hit(Hash,Functor,AbsArgs,Old)) | |
80 | -> true | |
81 | ; Old=0, | |
82 | (profile_functor(Functor) -> true ; assert(profile_functor(Functor))) | |
83 | ), | |
84 | New is Old+1, | |
85 | assert(hit(Hash,Functor,AbsArgs,New)). | |
86 | ||
87 | % use if you do not want to count number of hits: | |
88 | add_hit_if_not_covered(Functor,AbsArgs) :- | |
89 | term_hash(hit(Functor,AbsArgs),Hash), | |
90 | (hit(Hash,Functor,AbsArgs,_Old) -> true | |
91 | ; assert(hit(Hash,Functor,AbsArgs,1)), | |
92 | (profile_functor(Functor) -> true ; assert(profile_functor(Functor))) | |
93 | ). |