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