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		).