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 | ||
6 | :- module(memoization,[store_memo_expansion/3, | |
7 | get_stored_memo_expansion/3, | |
8 | compute_memo_hash/2, | |
9 | store_memo_computation_time/2, % for profiling | |
10 | ||
11 | register_memoization_function/6, | |
12 | get_registered_function/2, get_registered_function/3, | |
13 | get_registered_function_name/2, | |
14 | is_registered_function_name/1, is_registered_function_name/2, | |
15 | is_memoization_closure/4, | |
16 | get_memoization_closure_value/4, | |
17 | %expand_memoize_stored_function_reference/2, | |
18 | store_memo_result/6, | |
19 | get_stored_memo_result/4, | |
20 | apply_to_memoize/8, | |
21 | get_complete_memoization_expansion/6, | |
22 | element_of_memoization_closure/6, | |
23 | not_element_of_memoization_closure/6, | |
24 | is_lambda_value_domain_memoization_closure/5, | |
25 | ||
26 | tcltk_get_memo_profile_table/1, | |
27 | print_memo_profile/0, | |
28 | reset_memo_table/0, | |
29 | reset_memo_with_statistics/0]). | |
30 | ||
31 | :- use_module(error_manager). | |
32 | :- use_module(debug). | |
33 | ||
34 | :- use_module(module_information,[module_info/2]). | |
35 | :- module_info(group,kernel). | |
36 | :- module_info(description,'This module provides memoization features (for closure expansion, closure1,...).'). | |
37 | % used when use_closure_expansion_memoization is true | |
38 | ||
39 | :- use_module(probsrc(closures),[is_symbolic_closure/3]). | |
40 | :- use_module(probsrc(kernel_waitflags),[add_error_wf/5, add_message_wf/5, add_warning_wf/5]). | |
41 | ||
42 | ||
43 | ||
44 | :- use_module(eventhandling,[register_event_listener/3]). | |
45 | :- register_event_listener(startup_prob,init_memo_table, | |
46 | 'Initialise Preferences'). | |
47 | :- register_event_listener(clear_specification,reset_memo_table, | |
48 | 'Reset Temporary Preferences.'). | |
49 | ||
50 | ||
51 | ||
52 | % ---------------- Memoization for set comprehension / lambda / closure1 expansion: | |
53 | ||
54 | get_stored_memo_expansion(Hash,Term,Result) :- | |
55 | stored_memo_expansion(Hash,Term,Result), | |
56 | inc_counter(memoization_reuse_counter,_). | |
57 | ||
58 | :- dynamic stored_memo_expansion/3. | |
59 | ||
60 | store_memo_expansion(Hash,LookupTerm,StoredResult) :- | |
61 | assertz(stored_memo_expansion(Hash,LookupTerm,StoredResult)). | |
62 | ||
63 | :- if(current_prolog_flag(dialect, sicstus)). | |
64 | :- use_module(library(terms),[term_hash/3]). | |
65 | compute_memo_hash(LookupTerm,Hash) :- | |
66 | inc_counter(memoization_hash_counter,_), | |
67 | term_hash(LookupTerm, | |
68 | [range(smallint),algorithm(sdbm), depth(infinite),if_var(ignore)],Hash). | |
69 | %hashing:my_term_hash(closure(Parameters,ParameterTypes,ClosureBody),Hash), | |
70 | %inc(Hash), % | |
71 | :- else. | |
72 | :- use_module(hashing,[my_term_hash/2]). | |
73 | compute_memo_hash(LookupTerm,Hash) :- | |
74 | inc_counter(memoization_hash_counter,_), | |
75 | my_term_hash(LookupTerm,Hash). | |
76 | :- endif. | |
77 | ||
78 | % ---------------- Memoization for function application | |
79 | ||
80 | :- dynamic registered_value/3, registered_value_name/2, memoization_expansion_completed/1. | |
81 | ||
82 | % we register the functions to be memoized | |
83 | get_registered_function(Id,Val) :- registered_value(Id,_,Val). | |
84 | get_registered_function(Id,Name,Val) :- registered_value(Id,Name,Val). | |
85 | get_registered_function_name(Id,Name) :- registered_value_name(Id,Name). | |
86 | is_registered_function_name(Name) :- registered_value_name(_,Name). | |
87 | is_registered_function_name(Name,Expanded) :- registered_value_name(ID,Name), | |
88 | (memoization_expansion_completed(ID) -> Expanded=true ; Expanded=false). | |
89 | ||
90 | :- use_module(tools,[remove_variables/3]). | |
91 | :- use_module(kernel_tools,[ground_value_check/2, value_variables/2]). | |
92 | % register a (usually symbolic closure) value as a function | |
93 | % ElType is the type of the elements of the function and MemoResultClosure is a closure that | |
94 | % can and should be used instead of BValue to ensure memoization works | |
95 | register_memoization_function(Name,BValue,ElType,RecursionInfo,MemoID,MemoResultClosure) :- | |
96 | value_variables(BValue,Vars), | |
97 | %print(vars(Name,Vars,LHSValue)),nl, print(bvalue(BValue)),nl, | |
98 | (RecursionInfo='$recursion_value'(RecValue) | |
99 | -> remove_variables(Vars,[RecValue],WVars), % do not wait on RecValue; it will be set by registering MEMOID | |
100 | RecValue = MemoResultClosure, | |
101 | InnerMemoID=MemoID % already instantiate MemoID before asserting closure; cyclic use | |
102 | ; WVars=Vars | |
103 | ), | |
104 | ground_value_check(WVars,Ground), | |
105 | %print(register(Name,MemoID,Ground,BValue)),nl,nl, | |
106 | construct_memoization_closure(MemoID,BValue,ElType,MemoResultClosure), | |
107 | register_memoization_function_aux(Ground,Name,BValue,InnerMemoID,MemoID). | |
108 | ||
109 | :- block register_memoization_function_aux(-,?,?,?,?). | |
110 | register_memoization_function_aux(_,Name,BValue,InnerMemoID,MemoID) :- | |
111 | inc_counter(memoization_function_counter,InnerMemoID), | |
112 | formatsilent('Registering function ~w for memoization: ~w~n',[InnerMemoID,Name]), | |
113 | (ground_value(BValue) -> true ; add_internal_error('Non ground memo closure: ',InnerMemoID:BValue)), | |
114 | %(BValue=closure(_,_,BB) -> bsyntaxtree:check_used_ids_in_ast(BB) ; true), | |
115 | compile_value(BValue,InnerMemoID), | |
116 | assertz(registered_value_name(InnerMemoID,Name)), | |
117 | assertz(registered_value(InnerMemoID,Name,BValue)), | |
118 | %if(MemoID=InnerMemoID, format('Finish ~w~n',[MemoID]),format('FAILURE ~w~n',[InnerMemoID])). | |
119 | MemoID=InnerMemoID. % only unify after assertz; in case co-routines are triggered which call get_registered_function | |
120 | ||
121 | :- load_files(library(system), [when(compile_time), imports([environ/2])]). | |
122 | :- if(environ(cogen,true)). | |
123 | compile_value(closure(Paras,Ty,Body),InnerMemoID) :- | |
124 | compile_closure(Paras,Ty,Body,InnerMemoID),!. | |
125 | compile_value(_,_). | |
126 | :- use_module(b_cogen). | |
127 | :- else. | |
128 | compile_value(_,_). | |
129 | reset_cogen. | |
130 | :- endif. | |
131 | ||
132 | construct_memoization_closure(MemoID,BValue,ElType,Result) :- | |
133 | get_infos(BValue,BInfos), | |
134 | XFC = b(external_function_call('MEMOIZE_STORED_FUNCTION',[b(value(int(MemoID)),integer,[])]),set(ElType),[]), | |
135 | TID = b(identifier('_zzzz_unary'),ElType,[]), | |
136 | Body = b(member(TID,XFC),pred,[prob_annotation('MEMOIZE'(MemoID))|BInfos]), | |
137 | %bsyntaxtree:check_used_ids_in_ast(Body), | |
138 | Result = closure(['_zzzz_unary'],[ElType], Body). | |
139 | ||
140 | :- use_module(bsyntaxtree,[get_texpr_info/2, extract_info_wo_used_ids/2, extract_pos_infos/2]). % extract_info_wo_used_ids | |
141 | % extract important infos, | |
142 | get_infos(Var,Res) :- var(Var),!,Res=[]. | |
143 | get_infos(closure(_,_,B),Res) :- extract_info_wo_used_ids(B,Infos),!, | |
144 | get_texpr_info(B,AllInfos),extract_pos_infos(AllInfos,Pos), | |
145 | append(Pos,Infos,Res). | |
146 | get_infos(_,[]). % :- print(no_infos(A)),nl. | |
147 | ||
148 | :- use_module(bsyntaxtree, [get_texpr_id/2]). | |
149 | is_memoization_closure([ID],_T,b(Body,_,INFO),MemoID) :- | |
150 | ? | member(prob_annotation('MEMOIZE'(MemoID)),INFO), |
151 | % check Body has not been rewritten: | |
152 | Body = member(TID,b(RHS,_,_)), | |
153 | get_texpr_id(TID,ID), | |
154 | is_memoize_stored_function_reference(RHS,MemoID). | |
155 | ||
156 | is_memoize_stored_function_reference(external_function_call('MEMOIZE_STORED_FUNCTION',[Arg]),MemoID) :- | |
157 | Arg=b(value(int(MemoID)),_,_). | |
158 | ||
159 | % check if we have a memoization closure and get its stored value | |
160 | get_memoization_closure_value(P,T,B,Value) :- | |
161 | is_memoization_closure(P,T,B,MemoID), | |
162 | number(MemoID), | |
163 | registered_value(MemoID,_,Value). | |
164 | ||
165 | % expand an (untyped) expression term referring to a stored function into full value: | |
166 | %expand_memoize_stored_function_reference(Expr,Value) :- | |
167 | % is_memoize_stored_function_reference(Expr,MemoID), | |
168 | % number(MemoID), % in case this is called before function registered | |
169 | % registered_value(MemoID,_,Value). | |
170 | ||
171 | :- use_module(probsrc(closures),[is_lambda_value_domain_normal_closure/5]). | |
172 | :- dynamic stored_lambda_value_domain/3. | |
173 | % Note: the caller must check that DomainValue, Expr are not equal to fail | |
174 | is_lambda_value_domain_memoization_closure(P,T,Pred, DomainValue,Expr) :- | |
175 | ? | is_memoization_closure(P,T,Pred,MemoID), |
176 | number(MemoID), | |
177 | (stored_lambda_value_domain(MemoID,DV,E) | |
178 | -> true %print(get_domain(MemoID)),nl | |
179 | ; registered_value(MemoID,_,closure(P2,T2,Pred2)), | |
180 | %print(storing(lambda_domain(MemoID))),nl, | |
181 | (is_lambda_value_domain_normal_closure(P2,T2,Pred2, DV,E) | |
182 | -> assertz(stored_lambda_value_domain(MemoID,DV,E)) | |
183 | ; assertz(stored_lambda_value_domain(MemoID,fail,fail)), | |
184 | fail | |
185 | ) | |
186 | ), | |
187 | DomainValue=DV, Expr = E. | |
188 | ||
189 | ||
190 | % ---------------------------------------------- | |
191 | % providing stored_memo_result_id/4 fact interface | |
192 | % some MemoID are stored in separate table | |
193 | :- dynamic stored_memo_result1/3, stored_memo_result2/3, | |
194 | stored_memo_result3/3, stored_memo_result4/3, | |
195 | stored_memo_result5/3, stored_memo_result6/3, | |
196 | stored_memo_result7/3, stored_memo_result8/3, | |
197 | stored_memo_result/4. | |
198 | stored_memo_result_id(1,ArgHash,Argument,StoredResult) :- !, | |
199 | stored_memo_result1(ArgHash,Argument,StoredResult). | |
200 | stored_memo_result_id(2,ArgHash,Argument,StoredResult) :- !, | |
201 | stored_memo_result2(ArgHash,Argument,StoredResult). | |
202 | stored_memo_result_id(3,ArgHash,Argument,StoredResult) :- !, | |
203 | stored_memo_result3(ArgHash,Argument,StoredResult). | |
204 | stored_memo_result_id(4,ArgHash,Argument,StoredResult) :- !, | |
205 | stored_memo_result4(ArgHash,Argument,StoredResult). | |
206 | stored_memo_result_id(5,ArgHash,Argument,StoredResult) :- !, | |
207 | ? | stored_memo_result5(ArgHash,Argument,StoredResult). |
208 | stored_memo_result_id(6,ArgHash,Argument,StoredResult) :- !, | |
209 | ? | stored_memo_result6(ArgHash,Argument,StoredResult). |
210 | stored_memo_result_id(7,ArgHash,Argument,StoredResult) :- !, | |
211 | ? | stored_memo_result7(ArgHash,Argument,StoredResult). |
212 | stored_memo_result_id(8,ArgHash,Argument,StoredResult) :- !, | |
213 | ? | stored_memo_result8(ArgHash,Argument,StoredResult). |
214 | stored_memo_result_id(MemoID,ArgHash,Argument,StoredResult) :- | |
215 | ? | stored_memo_result(ArgHash,MemoID,Argument,StoredResult). |
216 | ||
217 | assert_stored_memo_result_id(1,ArgHash,Argument,StoredResult) :- !, | |
218 | assertz(stored_memo_result1(ArgHash,Argument,StoredResult)). | |
219 | assert_stored_memo_result_id(2,ArgHash,Argument,StoredResult) :- !, | |
220 | assertz(stored_memo_result2(ArgHash,Argument,StoredResult)). | |
221 | assert_stored_memo_result_id(3,ArgHash,Argument,StoredResult) :- !, | |
222 | assertz(stored_memo_result3(ArgHash,Argument,StoredResult)). | |
223 | assert_stored_memo_result_id(4,ArgHash,Argument,StoredResult) :- !, | |
224 | assertz(stored_memo_result4(ArgHash,Argument,StoredResult)). | |
225 | assert_stored_memo_result_id(5,ArgHash,Argument,StoredResult) :- !, | |
226 | assertz(stored_memo_result5(ArgHash,Argument,StoredResult)). | |
227 | assert_stored_memo_result_id(6,ArgHash,Argument,StoredResult) :- !, | |
228 | assertz(stored_memo_result6(ArgHash,Argument,StoredResult)). | |
229 | assert_stored_memo_result_id(7,ArgHash,Argument,StoredResult) :- !, | |
230 | assertz(stored_memo_result7(ArgHash,Argument,StoredResult)). | |
231 | assert_stored_memo_result_id(8,ArgHash,Argument,StoredResult) :- !, | |
232 | assertz(stored_memo_result8(ArgHash,Argument,StoredResult)). | |
233 | assert_stored_memo_result_id(MemoID,ArgHash,Argument,StoredResult) :- | |
234 | assertz(stored_memo_result(ArgHash,MemoID,Argument,StoredResult)). | |
235 | ||
236 | retractall_stored_memo_result :- | |
237 | retractall(stored_memo_result1(_,_,_)), | |
238 | retractall(stored_memo_result2(_,_,_)), | |
239 | retractall(stored_memo_result3(_,_,_)), | |
240 | retractall(stored_memo_result4(_,_,_)), | |
241 | retractall(stored_memo_result5(_,_,_)), | |
242 | retractall(stored_memo_result6(_,_,_)), | |
243 | retractall(stored_memo_result7(_,_,_)), | |
244 | retractall(stored_memo_result8(_,_,_)), | |
245 | retractall(stored_memo_result(_,_,_,_)). | |
246 | ||
247 | % this clause is only ok if we have just a single function; otherwise we get collisions between different functions | |
248 | compute_funcall_memo_hash(int(X),MemoID,R) :- MemoID <9, !, | |
249 | R=X. % avoid computing hash for simple integer values; only drawback: indexing not good for too large integers | |
250 | % TO DO: we could register with each registered_value fact also a dynamic table_memo fact | |
251 | % then we can avoid clashes between different memoized functions | |
252 | compute_funcall_memo_hash(X,MemoID,ArgHash) :- | |
253 | compute_memo_hash((MemoID,X),ArgHash). | |
254 | ||
255 | ||
256 | % -------------------------------------------- | |
257 | ||
258 | % last argument should be left free when calling | |
259 | get_stored_memo_result(MemoID,Argument,ArgHash,StoredResult) :- | |
260 | stored_memo_result_id(MemoID,ArgHash,Argument,StoredResult), | |
261 | %print(get_stored(MemoID,ArgHash,StoredResult)),nl, | |
262 | count_reuse(MemoID). | |
263 | ||
264 | ||
265 | :- use_module(kernel_waitflags,[add_wd_error_span/4]). | |
266 | :- use_module(tools_strings,[ajoin/2]). | |
267 | :- use_module(store,[normalise_value_for_var/3]). | |
268 | store_memo_result(MemoID,Argument,ArgHash,Result,Span,WF) :- | |
269 | normalise_value_for_var(MemoID,Result,NormResult), | |
270 | store_norm_memo_result(MemoID,Argument,ArgHash,NormResult,Span,WF). | |
271 | ||
272 | :- use_module(kernel_objects,[equal_object/2]). | |
273 | store_norm_memo_result(MemoID,Argument,ArgHash,Result,Span,WF) :- | |
274 | stored_memo_result_id(MemoID,ArgHash,Argument,StoredResult), | |
275 | !, | |
276 | (Result=StoredResult -> true | |
277 | ; equal_object(Result,StoredResult) -> format('Two representations for memoized function (~w) result.~n',[MemoID]) | |
278 | ; ajoin(['Memoized function ',MemoID,' has multiple results for: '],Msg), | |
279 | Relation = [(Argument,StoredResult),(Argument,Result)], | |
280 | add_wd_error_span(Msg,'@fun'(Argument,Relation),Span,WF) | |
281 | %,print('stored: '),translate:print_bvalue(StoredResult),nl,print('new: '),translate:print_bvalue(Result),nl | |
282 | ). | |
283 | store_norm_memo_result(MemoID,Argument,ArgHash,Result,_,_) :- | |
284 | %format('Storing memo result for ~w, argument =',[MemoID]), | |
285 | %translate:print_bvalue(Argument),nl, translate:print_bvalue(Result),nl, | |
286 | assert_stored_memo_result_id(MemoID,ArgHash,Argument,Result). | |
287 | %assertz(stored_memo_result(ArgHash,MemoID,Argument,Result)). | |
288 | %print(stored_memo_result(ArgHash,MemoID,Argument,Result)),nl. | |
289 | ||
290 | ||
291 | % function application for memoized function: | |
292 | apply_to_memoize(MemoID,P,T,B,X,Y,Span,WF) :- | |
293 | ground_value_check(X,XV), | |
294 | block_apply_closure_memo_groundx(XV,MemoID,X,Y,P,T,B,raise_wd,Span,WF). | |
295 | ||
296 | :- use_module(kernel_tools,[ground_value/1]). | |
297 | :- use_module(kernel_objects,[equal_object_wf/3]). | |
298 | ||
299 | :- block block_apply_closure_memo_groundx(-,?, ?,?, ?,?,?, ?,?,?), | |
300 | block_apply_closure_memo_groundx(?,-, ?,?, ?,?,?, ?,?,?). | |
301 | ||
302 | ||
303 | block_apply_closure_memo_groundx(_,MemoID, X,Y, P,T,B, RaiseWD, Span,WF) :- | |
304 | % MemoID is ground, meaning body B is ground as well | |
305 | % TODO: obtain stored value directly | |
306 | compute_funcall_memo_hash(X,MemoID,ArgHash), | |
307 | if(get_stored_memo_result(MemoID,X,ArgHash,StoredResult), | |
308 | equal_object_wf(Y,StoredResult,WF), | |
309 | (start_profile_function_application(MemoID,Timer), | |
310 | if(check_element_of_function_closure_nowf(MemoID,X,ComputedResult,P,T,B,Span,WF), | |
311 | % ground WF to compute ground value for ComputedResult | |
312 | (stop_profile_function_application(MemoID,Timer), | |
313 | (ground_value(ComputedResult) | |
314 | -> store_memo_result(MemoID,X,ArgHash,ComputedResult,Span,WF) | |
315 | ; add_error_wf(memoization,'Could not compute ground value for function application',MemoID,Span,WF), | |
316 | print('Argument: '),translate:print_bvalue(X),nl, | |
317 | print('Result: '), print(ComputedResult),nl, | |
318 | print('Function: '),registered_value(MemoID,_Name,FunValue), translate:print_bvalue(FunValue),nl,nl | |
319 | ), | |
320 | % To do: check if we compute two or more solutions for f(X) and add WD error | |
321 | equal_object_wf(Y,ComputedResult,WF) | |
322 | ), | |
323 | (RaiseWD=raise_wd, | |
324 | add_wd_error_span('function applied outside of domain (#8-Memo): ', '@fun'(X,closure(P,T,B)),Span,WF) | |
325 | ) | |
326 | ) | |
327 | ) | |
328 | ). | |
329 | ||
330 | :- use_module(kernel_waitflags, [init_wait_flags/2, init_wait_flags_and_push_call_stack/3,ground_wait_flags/1]). | |
331 | :- use_module(custom_explicit_sets,[check_element_of_function_closure/6]). | |
332 | check_element_of_function_closure_nowf(MemoID,X,ComputedResult,_,_,_,Span,OuterWF) :- | |
333 | registered_value(MemoID,Name,closure(P,T,B)),!, % can be expensive if closure contains large values | |
334 | init_wait_flags_and_push_call_stack(OuterWF,function_call(Name,X,Span),WF), % slows down test 1968 with recursion | |
335 | check_element_of_function_closure(X,ComputedResult,P,T,B,WF), | |
336 | ground_wait_flags(WF). | |
337 | check_element_of_function_closure_nowf(_,X,ComputedResult,P,T,B,_Span,_OuterWF) :- | |
338 | init_wait_flags(WF,[check_element_of_function_closure_nowf]), | |
339 | check_element_of_function_closure(X,ComputedResult,P,T,B,WF), | |
340 | ground_wait_flags(WF). | |
341 | ||
342 | :- use_module(library(avl),[avl_domain/2]). | |
343 | :- use_module(library(lists),[maplist/2]). | |
344 | ||
345 | % store the complete expansion of a memoized function for later re-use | |
346 | % and also passes result and done flag to an outer call | |
347 | :- block store_memoization_closure_expansion(?,-,?,?,?,?,?). | |
348 | store_memoization_closure_expansion(MemoID,_,Res,OuterDone,OuterRes,Span,WF) :- | |
349 | my_avl_domain(Res,List), | |
350 | !, | |
351 | debug_println(19,storing_expansion_of_memoized_function(MemoID)), | |
352 | (maplist(store_function_result(MemoID,Span,WF),List) | |
353 | -> assertz(memoization_expansion_completed(MemoID)) | |
354 | ; add_internal_error(memoization,'Error storing expansion for memoized function:',MemoID,Span)), | |
355 | equal_object_wf(Res,OuterRes,WF), OuterDone=true. | |
356 | store_memoization_closure_expansion(MemoID,_,R,OuterDone,OuterRes,Span,WF) :- | |
357 | add_warning_wf(memoization,'Cannot store expansion for memoized function:',MemoID:R,Span,WF), | |
358 | equal_object_wf(R,OuterRes,WF), OuterDone=true. | |
359 | ||
360 | my_avl_domain(avl_set(A),List) :- avl_domain(A,List). | |
361 | my_avl_domain([],[]). | |
362 | ||
363 | store_function_result(MemoID,Span,WF,(X,ComputedResult)) :- | |
364 | compute_funcall_memo_hash(X,MemoID,ArgHash), | |
365 | store_memo_result(MemoID,X,ArgHash,ComputedResult,Span,WF). % TO DO: we could use special version that also allows relations | |
366 | ||
367 | :- use_module(kernel_objects,[equal_object_optimized_wf/4]). | |
368 | % succeeds if function has been completely memoized and returns expansion | |
369 | try_get_complete_memoization_expansion(MemoID,Result,WF) :- | |
370 | memoization_expansion_completed(MemoID), | |
371 | debug_println(19,recovering_full_value_for_memoized_function(MemoID)), | |
372 | findall((X,Y),stored_memo_result_id(MemoID,_,X,Y),List), % probably not sorted ! | |
373 | equal_object_optimized_wf(List,Result,expand_normal_closure_memo,WF). | |
374 | ||
375 | % always succeeds to obtain the full expansion; also stores it for reuse | |
376 | :- block get_complete_memoization_expansion(-,?,?,?,?,?). | |
377 | get_complete_memoization_expansion(MemoID,Result,Done,_,_PP,WF) :- | |
378 | try_get_complete_memoization_expansion(MemoID,Cached,WF), | |
379 | !, | |
380 | Result=Cached, Done=true. | |
381 | get_complete_memoization_expansion(MemoID,Result,Done,Span,PP,WF) :- | |
382 | registered_value(MemoID,Name,Val), nonvar(Val), | |
383 | !, | |
384 | get_complete_memoization_expansion_aux(Val,MemoID,Name,Result,Done,Span,PP,WF). | |
385 | get_complete_memoization_expansion(MemoID,_,_,Span,PP,WF) :- | |
386 | add_error_wf(get_complete_memoization_expansion,'Memoized function ID not registered:',MemoID:PP,Span,WF), | |
387 | fail. | |
388 | ||
389 | ||
390 | get_complete_memoization_expansion_aux(Val,_MemoID,_,Result,Done,_Span,_PP,_WF) :- expanded_value(Val), !, | |
391 | Result=Val,Done=true. | |
392 | get_complete_memoization_expansion_aux(closure(P,T,B),MemoID,Name,Result,Done,Span,PP,WF) :- !, | |
393 | debug_println(19,expanding_memoized_function(MemoID,PP)), | |
394 | (custom_explicit_sets:is_infinite_or_very_large_closure(P,T,B,200000) | |
395 | -> add_warning_wf(PP,'Expanding infinite or very large memoized function: ',Name,B,WF) | |
396 | ? | ; is_symbolic_closure(P,T,B) |
397 | -> add_message_wf(PP,'Fully expanding symbolic memoized function: ',Name,B,WF) | |
398 | ; true), | |
399 | % bsyntaxtree:check_used_ids_in_ast(B), | |
400 | custom_explicit_sets:expand_normal_closure_direct(P,T,B,Expansion,DoneExp,WF), | |
401 | store_memoization_closure_expansion(MemoID,DoneExp,Expansion,Done,Result,Span,WF). | |
402 | get_complete_memoization_expansion_aux(Val,MemoID,Name,_,_,Span,PP,WF) :- | |
403 | add_error_wf(memoization(PP),'Illegal value stored for memoized function:',MemoID:Name,Span,WF), | |
404 | print(Val),nl, | |
405 | fail. | |
406 | ||
407 | expanded_value(avl_set(_)). | |
408 | expanded_value(global_set(_)). | |
409 | expanded_value([]). | |
410 | expanded_value([_|_]). | |
411 | ||
412 | :- use_module(kernel_tools,[ground_value/1]). | |
413 | :- use_module(kernel_objects,[check_element_of_wf/3]). | |
414 | % special treatment for element of memoization closure; possibly not a function call | |
415 | element_of_memoization_closure(MemoID,Element,WF,P,T,B) :- | |
416 | nonvar(Element), Element = (X,Y), | |
417 | ground_value(X), | |
418 | % we can do a function application; we assume that we only store functions | |
419 | !, %print(fun_apply_reuse(MemoID,Element)),nl, | |
420 | Span=B, | |
421 | block_apply_closure_memo_groundx(ground,MemoID, X,Y, P,T,B, do_not_raise_wd, Span,WF). | |
422 | element_of_memoization_closure(MemoID,Element,WF,_,_,B) :- | |
423 | % TO DO: delay before computing complete memoization | |
424 | get_complete_memoization_expansion(MemoID,Set,_Done,B,element_of_memoization_closure,WF), | |
425 | !, %print(el_of(MemoID,Element)),nl, | |
426 | check_element_of_wf(Element,Set,WF). | |
427 | ||
428 | :- use_module(kernel_objects,[not_equal_object_wf/3]). | |
429 | :- use_module(kernel_objects,[not_element_of_wf/3]). | |
430 | ||
431 | not_element_of_memoization_closure(MemoID,Element,WF,P,T,B) :- | |
432 | nonvar(Element), Element = (X,Y), | |
433 | ground_value(X), | |
434 | !, | |
435 | if(block_apply_closure_memo_groundx(ground,MemoID, X,YRes, P,T,B, do_not_raise_wd, B,WF), | |
436 | not_equal_object_wf(Y,YRes,wf), | |
437 | true). | |
438 | not_element_of_memoization_closure(MemoID,Element,WF,_,_,B) :- | |
439 | % TO DO: delay before computing complete memoization | |
440 | get_complete_memoization_expansion(MemoID,Set,_Done,B,not_element_of_memoization_closure,WF), | |
441 | !, | |
442 | ? | not_element_of_wf(Element,Set,WF). |
443 | % ------------------------------- | |
444 | ||
445 | :- dynamic function_application_time/2. | |
446 | :- load_files(library(system), [when(compile_time), imports([environ/2])]). | |
447 | :- if(environ(prob_profile,true)). | |
448 | %:- if(1=1). | |
449 | %:- print('Profiling Memoizations'),nl. | |
450 | count_reuse(MemoID) :- | |
451 | my_bb_get_reuse_counter(MemoID,Cnt), C1 is Cnt+1, bb_put(MemoID,C1), | |
452 | inc_counter(memoization_function_reuse_counter,_). | |
453 | my_bb_get_reuse_counter(Key,Val) :- (bb_get(Key,V) -> V=Val ; Val=0). | |
454 | bb_reset_reuse_counter(Key) :- bb_put(Key,0). | |
455 | start_profile_function_application(_,Walltime) :- statistics(walltime,[Walltime,_]). | |
456 | stop_profile_function_application(MemoID,Walltime1) :- statistics(walltime,[Walltime2,_]), | |
457 | Delta is Walltime2-Walltime1, | |
458 | (Delta>0 -> | |
459 | (retract(function_application_time(MemoID,Old)) | |
460 | -> New is Old+Delta ; New = Delta), | |
461 | assertz(function_application_time(MemoID,New)) | |
462 | ; true | |
463 | ). | |
464 | function_application_time_available :- true. | |
465 | :- else. | |
466 | count_reuse(_MemoID) :- | |
467 | inc_counter(memoization_function_reuse_counter,_). | |
468 | my_bb_get_reuse_counter(_,'?'). | |
469 | bb_reset_reuse_counter(_). | |
470 | start_profile_function_application(_,0). | |
471 | stop_profile_function_application(_,_). | |
472 | function_application_time_available :- fail. | |
473 | :- endif. | |
474 | ||
475 | % ------------------------------- | |
476 | % utilities to profile expansions | |
477 | :- public inc/1. | |
478 | :- dynamic hash_count/2. | |
479 | inc(Hash) :- (retract(hash_count(Hash,Nr)) -> N1 is Nr+1 ; N1 = 1), assertz(hash_count(Hash,N1)). | |
480 | :- dynamic hash_time/2. | |
481 | store_memo_computation_time(Hash,Time) :- % for closure expansions, not for funct. applications | |
482 | retractall(hash_time(Hash,_)), assertz(hash_time(Hash,Time)). | |
483 | ||
484 | % reused and walltime info requires prob_profile flag | |
485 | tcltk_get_memo_profile_table(list([Header|Entries])) :- | |
486 | Header = list(['ID','Name','Fully','Stored Values','Reused','Walltime (ms)']), | |
487 | findall(Entry,get_memo_entry_info(Entry),Entries). | |
488 | ||
489 | get_memo_entry_info(list([MemoID,Name,Complete,NrStored,ReuseCnt,Walltime])) :- | |
490 | registered_value(MemoID,Name,_FunValue), | |
491 | (memoization_expansion_completed(MemoID) -> Complete='true' ; Complete = 'false'), | |
492 | get_memo_profile_info(MemoID,NrStored,Walltime,ReuseCnt). | |
493 | ||
494 | % get some profile info about a MemoID | |
495 | get_memo_profile_info(MemoID,NrStored,Walltime,ReuseCnt) :- | |
496 | my_bb_get_reuse_counter(MemoID,ReuseCnt), | |
497 | findall(1,stored_memo_result_id(MemoID,_Hash,_,_),Stored), length(Stored,NrStored), | |
498 | (\+ function_application_time_available -> Walltime='?' | |
499 | ; function_application_time(MemoID,Walltime) -> true ; Walltime=0). | |
500 | ||
501 | ||
502 | print_memo_profile :- | |
503 | ((stored_memo_expansion(_,_,_) ; registered_value(_,_,_)) | |
504 | -> print('MEMO Table:'),nl, | |
505 | print_memo_table | |
506 | ; true). | |
507 | ||
508 | % memoization:print_memo. | |
509 | print_memo_table :- | |
510 | stored_memo_expansion(Hash,LookupTerm,PackedValue), | |
511 | (hash_count(Hash,Count) -> print(Count), print(' : ') ; true), | |
512 | (hash_time(Hash,Time) -> print(Time),print(' --> ') ; true), | |
513 | print_memo_entry(LookupTerm), | |
514 | nl, print(' : '),translate:print_bvalue(PackedValue),nl,fail. | |
515 | print_memo_table :- | |
516 | debug_mode(on), | |
517 | registered_value(MemoID,Name,FunValue), | |
518 | (memoization_expansion_completed(MemoID) | |
519 | -> Compl=' (completely evaluated)' ; Compl=''), | |
520 | format('MemoID ~w stored FUNCTION ~w~w ',[MemoID,Name,Compl]), | |
521 | nl, print(' : '),translate:print_bvalue(FunValue),nl,fail. | |
522 | print_memo_table :- | |
523 | debug_mode(on), | |
524 | registered_value_name(MemoID,Name), | |
525 | stored_memo_result_id(MemoID,_Hash,LookupTerm,PackedValue), | |
526 | format('MemoID ~w (~w) result for argument ',[MemoID,Name]), | |
527 | print_memo_entry(LookupTerm), | |
528 | nl, print(' : '),translate:print_bvalue(PackedValue),nl,fail. | |
529 | print_memo_table :- | |
530 | stored_memo_result(Hash,MemoID1,T1,_), | |
531 | stored_memo_result(Hash,MemoID2,T2,_), | |
532 | dif((MemoID1,T1),(MemoID2,T2)), | |
533 | format('Hash COLLISION ~w, ~w:~w vs ~w:~w~n',[Hash,MemoID1,T1,MemoID2,T2]), | |
534 | fail. | |
535 | print_memo_table :- format('Summary of reuse per memoization ID:~n',[]), | |
536 | registered_value_name(MemoID,Name), | |
537 | get_memo_profile_info(MemoID,NrStored,Walltime,ReuseCnt), | |
538 | format('MemoID ~w (~w) : Values Stored: ~w (~w ms to compute), Reused ~w~n',[MemoID,Name,NrStored,Walltime,ReuseCnt]), | |
539 | fail. | |
540 | print_memo_table :- get_counter(memoization_hash_counter,Hash), | |
541 | get_counter(memoization_reuse_counter,RHit), | |
542 | format('Hashes computed: ~w, expansions reused: ~w~n',[Hash,RHit]), | |
543 | get_counter(memoization_function_counter,F), | |
544 | get_counter(memoization_function_reuse_counter,FR), | |
545 | format('Memoization functions registered: ~w, results reused: ~w~n',[F,FR]). | |
546 | ||
547 | print_memo_entry(closure(Parameters,ParameterTypes,ClosureBody)) :- !, | |
548 | translate:print_bvalue(closure(Parameters,ParameterTypes,ClosureBody)). | |
549 | print_memo_entry(closure1_for_explicit_set(A)) :- !, | |
550 | print('closure1('),translate:print_bvalue(avl_set(A)), print(')'). | |
551 | print_memo_entry(A) :- translate:print_bvalue(A). | |
552 | ||
553 | :- use_module(extension('counter/counter'),[counter_init/0, reset_counter/1, | |
554 | new_counter/1, inc_counter/2, | |
555 | get_counter/2]). | |
556 | init_memo_table :- | |
557 | counter_init, | |
558 | new_counter(memoization_reuse_counter), new_counter(memoization_hash_counter), | |
559 | new_counter(memoization_function_counter), new_counter(memoization_function_reuse_counter), | |
560 | reset_memo_table. | |
561 | ||
562 | reset_memo_table :- | |
563 | ? | retract(registered_value(MemoID,_,_)), |
564 | bb_reset_reuse_counter(MemoID), | |
565 | retract(registered_value_name(MemoID,_)), | |
566 | fail. | |
567 | reset_memo_table :- | |
568 | reset_counter(memoization_reuse_counter), | |
569 | reset_counter(memoization_hash_counter), | |
570 | reset_counter(memoization_function_counter), | |
571 | reset_counter(memoization_function_reuse_counter), | |
572 | ? | (stored_memo_expansion(_,_,_) -> debug_println(19,'Resetting MEMO table') ; true), |
573 | retractall(hash_count(_,_)), | |
574 | retractall(hash_time(_,_)), | |
575 | retractall(stored_memo_expansion(_,_,_)), | |
576 | retractall(registered_value(_,_,_)), | |
577 | retractall(registered_value_name(_,_)), | |
578 | retractall(function_application_time(_,_)), | |
579 | retractall(memoization_expansion_completed(_)), | |
580 | retractall(stored_lambda_value_domain(_,_,_)), | |
581 | retractall_stored_memo_result, | |
582 | reset_cogen. | |
583 | ||
584 | :- use_module(probsrc(tools),[retract_with_statistics/2]). | |
585 | reset_memo_with_statistics :- | |
586 | retract_with_statistics(memoization, | |
587 | [stored_memo_expansion(_,_,_), | |
588 | registered_value(_,_,_),registered_value_name(_,_,_), | |
589 | memoization_expansion_completed(_), | |
590 | stored_lambda_value_domain(_,_,_), | |
591 | stored_memo_result1(_,_,_), stored_memo_result2(_,_,_), | |
592 | stored_memo_result3(_,_,_), stored_memo_result4(_,_,_), | |
593 | stored_memo_result5(_,_,_), stored_memo_result6(_,_,_), | |
594 | stored_memo_result7(_,_,_), stored_memo_result8(_,_,_), | |
595 | stored_memo_result(_,_,_,_)]), | |
596 | reset_memo_table. | |
597 |