| 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 | ||
| 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, | |
| 13 | is_memoization_closure/4, | |
| 14 | get_memoization_closure_value/4, | |
| 15 | %expand_memoize_stored_function_reference/2, | |
| 16 | store_memo_result/6, | |
| 17 | get_stored_memo_result/4, | |
| 18 | apply_to_memoize/8, | |
| 19 | ||
| 20 | print_memo_profile/0, | |
| 21 | reset_memo_table/0, | |
| 22 | reset_memo_with_statistics/0]). | |
| 23 | ||
| 24 | :- use_module(error_manager). | |
| 25 | :- use_module(debug). | |
| 26 | ||
| 27 | :- use_module(module_information,[module_info/2]). | |
| 28 | :- module_info(group,kernel). | |
| 29 | :- module_info(description,'This module provides memoization features (for closure expansion, closure1,...).'). | |
| 30 | % used when use_closure_expansion_memoization is true | |
| 31 | ||
| 32 | ||
| 33 | ||
| 34 | :- use_module(eventhandling,[register_event_listener/3]). | |
| 35 | :- register_event_listener(startup_prob,init_memo_table, | |
| 36 | 'Initialise Preferences'). | |
| 37 | :- register_event_listener(clear_specification,reset_memo_table, | |
| 38 | 'Reset Temporary Preferences.'). | |
| 39 | ||
| 40 | :- use_module(library(terms),[term_hash/3]). | |
| 41 | ||
| 42 | ||
| 43 | ||
| 44 | % ---------------- Memoization for set comprehension / lambda / closure1 expansion: | |
| 45 | ||
| 46 | get_stored_memo_expansion(Hash,Term,Result) :- | |
| 47 | stored_memo_expansion(Hash,Term,Result), | |
| 48 | inc_counter(memoization_reuse_counter,_). | |
| 49 | ||
| 50 | :- dynamic stored_memo_expansion/3. | |
| 51 | ||
| 52 | store_memo_expansion(Hash,LookupTerm,StoredResult) :- | |
| 53 | assert(stored_memo_expansion(Hash,LookupTerm,StoredResult)). | |
| 54 | ||
| 55 | compute_memo_hash(LookupTerm,Hash) :- | |
| 56 | inc_counter(memoization_hash_counter,_), | |
| 57 | term_hash(LookupTerm, | |
| 58 | [range(smallint),algorithm(sdbm), depth(infinite),if_var(ignore)],Hash). | |
| 59 | %hashing:my_term_hash(closure(Parameters,ParameterTypes,ClosureBody),Hash), | |
| 60 | %inc(Hash), % | |
| 61 | ||
| 62 | % ---------------- Memoization for function application | |
| 63 | ||
| 64 | :- dynamic registered_value/3. | |
| 65 | % we register the functions to be memoized | |
| 66 | get_registered_function(Id,Val) :- registered_value(Id,_,Val). | |
| 67 | ||
| 68 | :- use_module(tools,[remove_variables/3]). | |
| 69 | :- use_module(kernel_tools,[ground_value_check/2, value_variables/2]). | |
| 70 | % register a (usually symbolic closure) value as a function | |
| 71 | % ElType is the type of the elements of the function and MemoResultClosure is a closure that | |
| 72 | % can and should be used instead of BValue to ensure memoization works | |
| 73 | register_memoization_function(Name,BValue,ElType,RecursionInfo,MemoID,MemoResultClosure) :- | |
| 74 | value_variables(BValue,Vars), | |
| 75 | %print(vars(Name,Vars,LHSValue)),nl, print(bvalue(BValue)),nl, | |
| 76 | (RecursionInfo='$recursion_value'(RecValue) | |
| 77 | -> remove_variables(Vars,[RecValue],WVars), % do not wait on RecValue; it will be set by registering MEMOID | |
| 78 | RecValue = MemoResultClosure, | |
| 79 | InnerMemoID=MemoID % already instantiate MemoID before asserting closure; cyclic use | |
| 80 | ; WVars=Vars | |
| 81 | ), | |
| 82 | ground_value_check(WVars,Ground), | |
| 83 | %print(register(Name,MemoID,Ground,BValue)),nl,nl, | |
| 84 | construct_memoization_closure(MemoID,BValue,ElType,MemoResultClosure), | |
| 85 | register_memoization_function_aux(Ground,Name,BValue,InnerMemoID,MemoID). | |
| 86 | ||
| 87 | :- block register_memoization_function_aux(-,?,?,?,?). | |
| 88 | register_memoization_function_aux(_,Name,BValue,InnerMemoID,MemoID) :- | |
| 89 | inc_counter(memoization_function_counter,InnerMemoID), | |
| 90 | format('Registering function ~w for memoization: ~w~n',[InnerMemoID,Name]), | |
| 91 | (ground(BValue) -> true ; add_internal_error('Non ground memo closure: ',InnerMemoID:BValue)), | |
| 92 | assert(registered_value(InnerMemoID,Name,BValue)), | |
| 93 | %if(MemoID=InnerMemoID, format('Finish ~w~n',[MemoID]),format('FAILURE ~w~n',[InnerMemoID])). | |
| 94 | MemoID=InnerMemoID. % only unify after assert; in case co-routines are triggered which call get_registered_function | |
| 95 | ||
| 96 | construct_memoization_closure(MemoID,BValue,ElType,Result) :- | |
| 97 | get_infos(BValue,BInfos), | |
| 98 | XFC = b(external_function_call('MEMOIZE_STORED_FUNCTION',[b(value(int(MemoID)),integer,[])]),set(ElType),[]), | |
| 99 | TID = b(identifier('_zzzz_unary'),ElType,[]), | |
| 100 | Result = closure(['_zzzz_unary'],[ElType], | |
| 101 | b(member(TID,XFC),pred, | |
| 102 | [prob_annotation('MEMOIZE'(MemoID))|BInfos])). | |
| 103 | ||
| 104 | :- use_module(bsyntaxtree,[get_texpr_info/2, extract_info/2, extract_pos_infos/2]). | |
| 105 | % extract important infos, | |
| 106 | get_infos(Var,Res) :- var(Var),!,Res=[]. | |
| 107 | get_infos(closure(_,_,B),Res) :- extract_info(B,Infos),!, | |
| 108 | get_texpr_info(B,AllInfos),extract_pos_infos(AllInfos,Pos), | |
| 109 | append(Pos,Infos,Res). | |
| 110 | get_infos(_,[]). % :- print(no_infos(A)),nl. | |
| 111 | ||
| 112 | :- use_module(bsyntaxtree, [get_texpr_id/2]). | |
| 113 | is_memoization_closure([ID],_T,b(Body,_,INFO),MemoID) :- | |
| 114 | member(prob_annotation('MEMOIZE'(MemoID)),INFO), | |
| 115 | % check Body has not been rewritten: | |
| 116 | Body = member(TID,b(RHS,_,_)), | |
| 117 | get_texpr_id(TID,ID), | |
| 118 | is_memoize_stored_function_reference(RHS,MemoID). | |
| 119 | ||
| 120 | is_memoize_stored_function_reference(external_function_call('MEMOIZE_STORED_FUNCTION',[Arg]),MemoID) :- | |
| 121 | Arg=b(value(int(MemoID)),_,_). | |
| 122 | ||
| 123 | % check if we have a memoization closure and get its stored value | |
| 124 | get_memoization_closure_value(P,T,B,Value) :- | |
| 125 | is_memoization_closure(P,T,B,MemoID), | |
| 126 | number(MemoID), | |
| 127 | registered_value(MemoID,_,Value). | |
| 128 | ||
| 129 | % expand an (untyped) expression term referring to a stored function into full value: | |
| 130 | expand_memoize_stored_function_reference(Expr,Value) :- | |
| 131 | is_memoize_stored_function_reference(Expr,MemoID), | |
| 132 | number(MemoID), % in case this is called before function registered | |
| 133 | registered_value(MemoID,_,Value). | |
| 134 | ||
| 135 | ||
| 136 | % ---------------------------------------------- | |
| 137 | % providing stored_memo_result_id/4 fact interface | |
| 138 | % some MemoID are stored in separate table | |
| 139 | :- dynamic stored_memo_result1/3, stored_memo_result2/3, | |
| 140 | stored_memo_result3/3, stored_memo_result4/3, | |
| 141 | stored_memo_result/4. | |
| 142 | stored_memo_result_id(1,ArgHash,Argument,StoredResult) :- !, | |
| 143 | stored_memo_result1(ArgHash,Argument,StoredResult). | |
| 144 | stored_memo_result_id(2,ArgHash,Argument,StoredResult) :- !, | |
| 145 | stored_memo_result2(ArgHash,Argument,StoredResult). | |
| 146 | stored_memo_result_id(3,ArgHash,Argument,StoredResult) :- !, | |
| 147 | stored_memo_result3(ArgHash,Argument,StoredResult). | |
| 148 | stored_memo_result_id(4,ArgHash,Argument,StoredResult) :- !, | |
| 149 | stored_memo_result4(ArgHash,Argument,StoredResult). | |
| 150 | stored_memo_result_id(MemoID,ArgHash,Argument,StoredResult) :- | |
| 151 | stored_memo_result(ArgHash,MemoID,Argument,StoredResult). | |
| 152 | ||
| 153 | assert_stored_memo_result_id(1,ArgHash,Argument,StoredResult) :- !, | |
| 154 | assert(stored_memo_result1(ArgHash,Argument,StoredResult)). | |
| 155 | assert_stored_memo_result_id(2,ArgHash,Argument,StoredResult) :- !, | |
| 156 | assert(stored_memo_result2(ArgHash,Argument,StoredResult)). | |
| 157 | assert_stored_memo_result_id(3,ArgHash,Argument,StoredResult) :- !, | |
| 158 | assert(stored_memo_result3(ArgHash,Argument,StoredResult)). | |
| 159 | assert_stored_memo_result_id(4,ArgHash,Argument,StoredResult) :- !, | |
| 160 | assert(stored_memo_result4(ArgHash,Argument,StoredResult)). | |
| 161 | assert_stored_memo_result_id(MemoID,ArgHash,Argument,StoredResult) :- | |
| 162 | assert(stored_memo_result(ArgHash,MemoID,Argument,StoredResult)). | |
| 163 | ||
| 164 | retractall_stored_memo_result :- | |
| 165 | retractall(stored_memo_result1(_,_,_)), | |
| 166 | retractall(stored_memo_result2(_,_,_)), | |
| 167 | retractall(stored_memo_result3(_,_,_)), | |
| 168 | retractall(stored_memo_result4(_,_,_)), | |
| 169 | retractall(stored_memo_result(_,_,_,_)). | |
| 170 | ||
| 171 | % this clause is only ok if we have just a single function; otherwise we get collisions between different functions | |
| 172 | compute_funcall_memo_hash(int(X),MemoID,R) :- MemoID <5, !, | |
| 173 | R=X. % avoid computing hash for simple integer values; only drawback: indexing not good for too large integers | |
| 174 | % TO DO: we could register with each registered_value fact also a dynamic table_memo fact | |
| 175 | % then we can avoid clashes between different memoized functions | |
| 176 | compute_funcall_memo_hash(X,MemoID,ArgHash) :- | |
| 177 | compute_memo_hash((MemoID,X),ArgHash). | |
| 178 | ||
| 179 | ||
| 180 | % -------------------------------------------- | |
| 181 | ||
| 182 | % last argument should be left free when calling | |
| 183 | get_stored_memo_result(MemoID,Argument,ArgHash,StoredResult) :- | |
| 184 | stored_memo_result_id(MemoID,ArgHash,Argument,StoredResult), | |
| 185 | %print(stored(MemoID,ArgHash,StoredResult)),nl, | |
| 186 | inc_counter(memoization_function_reuse_counter,_). | |
| 187 | ||
| 188 | :- use_module(kernel_waitflags,[add_wd_error_span/4]). | |
| 189 | store_memo_result(MemoID,Argument,ArgHash,Result,Span,WF) :- | |
| 190 | stored_memo_result_id(MemoID,ArgHash,Argument,StoredResult), | |
| 191 | !, | |
| 192 | (Result=StoredResult -> true | |
| 193 | ; add_wd_error_span('memoised function has multiple results for: ','@fun'(Argument,MemoID),Span,WF) | |
| 194 | ). | |
| 195 | store_memo_result(MemoID,Argument,ArgHash,Result,_,_) :- | |
| 196 | assert_stored_memo_result_id(MemoID,ArgHash,Argument,Result). | |
| 197 | %assert(stored_memo_result(ArgHash,MemoID,Argument,Result)). | |
| 198 | %print(stored_memo_result(ArgHash,MemoID,Argument,Result)),nl. | |
| 199 | ||
| 200 | ||
| 201 | % function application for memoized function: | |
| 202 | apply_to_memoize(MemoID,P,T,B,X,Y,Span,WF) :- | |
| 203 | ground_value_check(X,XV), | |
| 204 | block_apply_closure_memo_groundx(XV,MemoID,X,Y,P,T,B,Span,WF). | |
| 205 | ||
| 206 | :- use_module(kernel_tools,[ground_value/1]). | |
| 207 | :- use_module(kernel_objects,[equal_object_wf/3]). | |
| 208 | ||
| 209 | :- block block_apply_closure_memo_groundx(-,?, ?,?, ?,?,?, ?,?), | |
| 210 | block_apply_closure_memo_groundx(?,-,?,?,?,?,?,?,?). | |
| 211 | ||
| 212 | ||
| 213 | block_apply_closure_memo_groundx(_,MemoID, X,Y, P,T,B, Span,WF) :- | |
| 214 | % MemoID is ground, meaning body B is ground as well | |
| 215 | % TODO: obtain stored value directly | |
| 216 | compute_funcall_memo_hash(X,MemoID,ArgHash), | |
| 217 | if(get_stored_memo_result(MemoID,X,ArgHash,StoredResult), | |
| 218 | equal_object_wf(Y,StoredResult,WF), | |
| 219 | if(check_element_of_function_closure_nowf(MemoID,X,ComputedResult,P,T,B), | |
| 220 | % ground WF to compute ground value for ComputedResult | |
| 221 | ((ground_value(ComputedResult) | |
| 222 | -> store_memo_result(MemoID,X,ArgHash,ComputedResult,Span,WF) | |
| 223 | ; add_error(memoization,'Could not compute ground value for function application',MemoID,Span), | |
| 224 | print('Argument: '),translate:print_bvalue(X),nl, | |
| 225 | print('Result: '), print(ComputedResult),nl, | |
| 226 | print('Function: '),registered_value(MemoID,_Name,FunValue), translate:print_bvalue(FunValue),nl,nl | |
| 227 | ), | |
| 228 | % To do: check if we compute two or more solutions for f(X) and add WD error | |
| 229 | equal_object_wf(Y,ComputedResult,WF) | |
| 230 | ), | |
| 231 | add_wd_error_span('function applied outside of domain (#8-Memo): ', '@fun'(X,closure(P,T,B)),Span,WF) | |
| 232 | ) | |
| 233 | ). | |
| 234 | ||
| 235 | :- use_module(kernel_waitflags, [init_wait_flags/1,ground_wait_flags/1]). | |
| 236 | :- use_module(custom_explicit_sets,[check_element_of_function_closure/6]). | |
| 237 | check_element_of_function_closure_nowf(MemoID,X,ComputedResult,_,_,_) :- | |
| 238 | registered_value(MemoID,_,closure(P,T,B)),!, | |
| 239 | init_wait_flags(WF), | |
| 240 | check_element_of_function_closure(X,ComputedResult,P,T,B,WF), | |
| 241 | ground_wait_flags(WF). | |
| 242 | check_element_of_function_closure_nowf(_,X,ComputedResult,P,T,B) :- | |
| 243 | init_wait_flags(WF), | |
| 244 | check_element_of_function_closure(X,ComputedResult,P,T,B,WF), | |
| 245 | ground_wait_flags(WF). | |
| 246 | ||
| 247 | ||
| 248 | % ------------------------------- | |
| 249 | % utilities to profile expansions | |
| 250 | :- public inc/1, store_memo_computation_time/2. | |
| 251 | :- dynamic hash_count/2. | |
| 252 | inc(Hash) :- (retract(hash_count(Hash,Nr)) -> N1 is Nr+1 ; N1 = 1), assert(hash_count(Hash,N1)). | |
| 253 | :- dynamic hash_time/2. | |
| 254 | store_memo_computation_time(Hash,Time) :- | |
| 255 | retractall(hash_time(Hash,_)), assert(hash_time(Hash,Time)). | |
| 256 | ||
| 257 | print_memo_profile :- | |
| 258 | ((stored_memo_expansion(_,_,_) ; registered_value(_,_,_)) | |
| 259 | -> print('MEMO Table:'),nl, | |
| 260 | print_memo_table | |
| 261 | ; true). | |
| 262 | ||
| 263 | % memoization:print_memo. | |
| 264 | print_memo_table :- | |
| 265 | stored_memo_expansion(Hash,LookupTerm,PackedValue), | |
| 266 | (hash_count(Hash,Count) -> print(Count), print(' : ') ; true), | |
| 267 | (hash_time(Hash,Time) -> print(Time),print(' --> ') ; true), | |
| 268 | print_memo_entry(LookupTerm), | |
| 269 | nl, print(' : '),translate:print_bvalue(PackedValue),nl,fail. | |
| 270 | print_memo_table :- | |
| 271 | registered_value(MemoID,Name,FunValue), | |
| 272 | format('MemoID ~w stored FUNCTION ~w ',[MemoID,Name]), | |
| 273 | nl, print(' : '),translate:print_bvalue(FunValue),nl,fail. | |
| 274 | print_memo_table :- | |
| 275 | registered_value(MemoID,Name,_), | |
| 276 | stored_memo_result_id(MemoID,_Hash,LookupTerm,PackedValue), | |
| 277 | format('MemoID ~w (~w) result for argument ',[MemoID,Name]), | |
| 278 | print_memo_entry(LookupTerm), | |
| 279 | nl, print(' : '),translate:print_bvalue(PackedValue),nl,fail. | |
| 280 | print_memo_table :- | |
| 281 | stored_memo_result(Hash,MemoID1,T1,_), | |
| 282 | stored_memo_result(Hash,MemoID2,T2,_), | |
| 283 | dif((MemoID1,T1),(MemoID2,T2)), | |
| 284 | format('Hash COLLISION ~w, ~w:~w vs ~w:~w~n',[Hash,MemoID1,T1,MemoID2,T2]), | |
| 285 | fail. | |
| 286 | print_memo_table :- get_counter(memoization_hash_counter,Hash), | |
| 287 | get_counter(memoization_reuse_counter,RHit), | |
| 288 | format('Hashes computed: ~w, expansions reused: ~w~n',[Hash,RHit]), | |
| 289 | get_counter(memoization_function_counter,F), | |
| 290 | get_counter(memoization_function_reuse_counter,FR), | |
| 291 | format('Memoization functions registered: ~w, results reused: ~w~n',[F,FR]). | |
| 292 | ||
| 293 | print_memo_entry(closure(Parameters,ParameterTypes,ClosureBody)) :- !, | |
| 294 | translate:print_bvalue(closure(Parameters,ParameterTypes,ClosureBody)). | |
| 295 | print_memo_entry(closure1_for_explicit_set(A)) :- !, | |
| 296 | print('closure1('),translate:print_bvalue(avl_set(A)), print(')'). | |
| 297 | print_memo_entry(A) :- translate:print_bvalue(A). | |
| 298 | ||
| 299 | :- use_module(extension('counter/counter'),[counter_init/0, reset_counter/1, | |
| 300 | new_counter/1, inc_counter/2, | |
| 301 | get_counter/2]). | |
| 302 | init_memo_table :- | |
| 303 | counter_init, | |
| 304 | new_counter(memoization_reuse_counter), new_counter(memoization_hash_counter), | |
| 305 | new_counter(memoization_function_counter), new_counter(memoization_function_reuse_counter), | |
| 306 | reset_memo_table. | |
| 307 | reset_memo_table :- | |
| 308 | reset_counter(memoization_reuse_counter), | |
| 309 | reset_counter(memoization_hash_counter), | |
| 310 | reset_counter(memoization_function_counter), | |
| 311 | reset_counter(memoization_function_reuse_counter), | |
| 312 | ? | (stored_memo_expansion(_,_,_) -> debug_println(19,'Resetting MEMO table') ; true), |
| 313 | retractall(hash_count(_,_)), | |
| 314 | retractall(hash_time(_,_)), | |
| 315 | retractall(stored_memo_expansion(_,_,_)), | |
| 316 | retractall(registered_value(_,_,_)), | |
| 317 | retractall_stored_memo_result. | |
| 318 | ||
| 319 | :- use_module(probsrc(tools),[retract_with_statistics/2]). | |
| 320 | reset_memo_with_statistics :- | |
| 321 | retract_with_statistics(memoization, | |
| 322 | [stored_memo_expansion(_,_,_),registered_value(_,_,_), | |
| 323 | stored_memo_result1(_,_,_), stored_memo_result2(_,_,_), | |
| 324 | stored_memo_result3(_,_,_), stored_memo_result4(_,_,_), | |
| 325 | stored_memo_result(_,_,_,_)]), | |
| 326 | reset_memo_table. | |
| 327 |