1:- module(miser, [miserly/2]). 2
4
5:- use_module(library(random)). 6
8:- dynamic observation/3. 9
13:- dynamic implementations/2. 14
15
21:- meta_predicate miserly(0,+). 22miserly(Predicate, Implementations) :-
23 Module:Name/Arity = Predicate,
24 functor(Term0, Name, Arity),
25 format(atom(Base), 'miserly_~w_', [Name/Arity]),
26 assertz((
27 user:goal_expansion(Term0, Module:Term) :-
28 gensym(Base, Sym),
29 rename_term(Term0, Sym, Term),
30 generate_optimizing_predicate(Module:Sym/Arity, Implementations)
31 )).
32
33rename_term(Term0, NewName, Term) :-
34 Term0 =.. [_|Args],
35 Term =.. [NewName|Args].
36
37:- meta_predicate generate_optimizing_predicate(0,+). 38generate_optimizing_predicate(Predicate, Implementations) :-
39 Module:Functor/Arity = Predicate,
40 (dynamic Predicate),
41 maplist(qualify(Module), Implementations, Qualified),
42 assertz(miser:implementations(Predicate, Qualified)),
43 length(Args, Arity),
44 Head =.. [Functor|Args],
45 Body = ( miser:measure_one(Predicate, Args),
46 miser:trim_implementations(Predicate)
47 ),
48 Module:assertz(Head :- Body).
49
50qualify(Module, Predicate, Module:Predicate).
51
52
55measure_one(Predicate, Arguments) :-
56 random_implementation(Predicate, Chosen), 57 print_message(informational, miser(chose, Chosen)),
58 ( measure_cost(Chosen, Arguments, Cost)
59 -> true
60 ; remove_implementation(Predicate, Chosen, _),
61 fail
62 ),
63 !,
64 observe(Predicate, Chosen, Cost),
65 print_message(informational, miser(cost, Cost)).
66
69random_implementation(Predicate, Chosen) :-
70 repeat,
71 implementations(Predicate, Choices),
72 ( Choices=[] -> throw('No implementations to choose from') ; true),
73 random_member(Chosen, Choices).
74
76observe(Predicate, Implementation, Cost) :-
77 assertz(observation(Predicate, Implementation, Cost)).
78
80forget(Predicate, Implementation) :-
81 retractall(observation(Predicate, Implementation,_)).
82
84observation_count(Predicate, Count) :-
85 findall(Name, observation(Predicate, Name, _), Names),
86 length(Names, Count).
87
89trim_implementations(Predicate) :-
90 observation_count(Predicate, ObservationCount),
91 ObservationCount > 5,
92 !,
93
94 95 most_costly_implementation(Predicate, MostCostly),
96
97 98 remove_implementation(Predicate, MostCostly, Keepers),
99
100 ( Keepers=[] -> found_winner(Predicate, MostCostly)
101 ; Keepers=[Winner] -> found_winner(Predicate, Winner)
102 ; print_message(informational, miser(discard, MostCostly)),
103 forget(Predicate, MostCostly)
104 ).
105trim_implementations(_).
106
109most_costly_implementation(Predicate, MostCostly) :-
110 findall(Cost-Name, implementation_cost(Predicate, Name, Cost), Costs),
111 keysort(Costs, AscendingCost),
112 reverse(AscendingCost, [_-MostCostly|_]).
113
115remove_implementation(Predicate, Needle, Leftover) :-
116 once(implementations(Predicate, Choices)),
117 once(select(Needle, Choices, Leftover)),
118 retractall(implementations(Predicate,_)),
119 assertz(implementations(Predicate, Leftover)).
120
121
124implementation_cost(Pred, Name, AvgCost) :-
125 aggregate(count, Pred^Cost^observation(Pred, Name, Cost), Count),
126 aggregate(sum(Cost), Pred^observation(Pred, Name, Cost), TotalCost),
127 AvgCost is TotalCost / Count.
128
130found_winner(Predicate, Winner) :-
131 print_message(informational, miser(winner, Winner)),
132
133 134 Module:Functor/Arity = Predicate,
135 functor(Term, Functor, Arity),
136 clause(Module:Term, _, OldClause), 137
138 139 length(Args, Arity),
140 quniv(Head, Functor, Args),
141 quniv(Body, Winner, Args),
142 Module:assertz(Head :- Body),
143
144 145 erase(OldClause),
146 compile_predicates([Predicate]),
147 retractall(implementations(Predicate, _)),
148 retractall(observation(Predicate,_,_)).
149
151quniv(Module:Term, Module:Functor, Args) :-
152 Term =.. [Functor|Args],
153 !.
154quniv(Term, Functor, Args) :-
155 Term =.. [Functor|Args].
156
157
159measure_cost(Implementation, Arguments, Cost) :-
160 quniv(Goal, Implementation, Arguments),
161 statistics(inferences, Before),
162 call(Goal),
163 statistics(inferences, After),
164 Cost is After - Before.
165
166
168:- multifile prolog:message//1. 169prolog:message(miser(chose, Chosen)) --> ['chose ~p'-[Chosen]].
170prolog:message(miser(cost, Cost)) --> ['cost ~p'-[Cost]].
171prolog:message(miser(discard, Loser)) --> ['discarding ~p'-[Loser]].
172prolog:message(miser(winner, Winner)) --> ['found a winner ~p'-[Winner]]