| 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(kernel_waitflags, |
| 7 | | [init_wait_flags/1, init_wait_flags/2, |
| 8 | | waitflag0_is_set/1, |
| 9 | | get_wait_flag_infos/2, get_wait_flag_info/2, is_wait_flag_info/2, |
| 10 | | add_wait_flag_info/3, portray_wait_flag_infos/1, |
| 11 | | push_wait_flag_call_stack_info/3, opt_push_wait_flag_call_stack_info/3, debug_opt_push_wait_flag_call_stack_info/3, |
| 12 | | opt_push_wait_flag_call_stack_quantifier_info/6, |
| 13 | | copy_wait_flag_call_stack_info/3, |
| 14 | | init_quantifier_wait_flag/6, init_wait_flags_and_push_call_stack/3, |
| 15 | | init_wait_flags_with_call_stack/2, |
| 16 | | add_call_stack_to_span/3, |
| 17 | | add_error_wf/5, add_warning_wf/5, add_message_wf/5, add_internal_error_wf/5, |
| 18 | | add_state_error_wf/5, |
| 19 | | portray_call_stack/1, get_call_stack/2, |
| 20 | | get_wait_flag/3, get_wait_flag/4, |
| 21 | | get_bounded_wait_flag/4, get_bounded_priority/2, |
| 22 | | block_get_wait_flag/4, |
| 23 | | get_wait_flag0/2, |
| 24 | | get_wait_flag1/2, get_wait_flag1/3, % deterministic wait flag |
| 25 | | get_last_wait_flag/3, |
| 26 | | get_idle_wait_flag/3, |
| 27 | | get_binary_choice_wait_flag/3, |
| 28 | | get_pow2_binary_choice_priority/2, |
| 29 | | get_binary_choice_wait_flag_exp_backoff/3, get_binary_choice_wait_flag_exp_backoff/4, |
| 30 | | %refresh_wait_flag/4, |
| 31 | | add_fd_variable_for_labeling/3, add_fd_variable_for_labeling/2, add_fd_variables_for_labeling/2, |
| 32 | | get_new_subsidiary_wait_flag/4, |
| 33 | | update_waitflag/4, |
| 34 | | ground_constraintprop_wait_flags/1, |
| 35 | | check_is_wait_flag/1, |
| 36 | | no_pending_waitflags/1, |
| 37 | | create_inner_wait_flags/3, copy_wf01e_wait_flags/2, |
| 38 | | copy_wfe_from_inner_if_necessary/2, |
| 39 | | %copy_wf_start/2, |
| 40 | | copy_wf_start/3, |
| 41 | | copy_wf_finish/2, |
| 42 | | copy_waitflag_store/2, |
| 43 | | |
| 44 | | clone_wait_flags_from1/3, clone_wait_flags_from1_finish/3, |
| 45 | | ground_wait_flag0/1, |
| 46 | | %create_wdguarded_wait_flags/4, |
| 47 | | get_large_finite_wait_flag/3, |
| 48 | | get_enumeration_starting_wait_flag/3, |
| 49 | | %get_enumeration_almost_finished_wait_flag/3, |
| 50 | | get_enumeration_finished_wait_flag/2, % get_wfe |
| 51 | | grd_ef/1, % ground enumeration finished waitflag |
| 52 | | get_integer_enumeration_wait_flag/3, |
| 53 | | ground_det_wait_flag/1, ground_wait_flag_to/2, |
| 54 | | ground_wait_flags/1, ground_inner_wait_flags/1, |
| 55 | | ground_inner_wait_flags_in_context/2, |
| 56 | | start_attach_inner_abort_errors/1, re_attach_pending_inner_abort_errors/2, |
| 57 | | deref_wf/2, |
| 58 | | |
| 59 | | add_abort_error_span/5, |
| 60 | | add_wd_error_span/4, |
| 61 | | add_wd_error/3, add_wd_error_set_result/6, |
| 62 | | pending_abort_error/1, pending_abort_error/4, |
| 63 | | get_wait_flags_context_msg/2, |
| 64 | | add_wd_error_span_now/4, |
| 65 | | assert_must_abort_wf/2, |
| 66 | | |
| 67 | | get_minimum_waitflag_prio/3, |
| 68 | | portray_waitflags/1, quick_portray_waitflags/1, quick_portray_waitflags_store/1, |
| 69 | | get_waitflags_phase/2, |
| 70 | | find_waitflag_info/4, |
| 71 | | |
| 72 | | integer_priority/1, large_finite_priority/1, integer_pow2_priority/1, last_priority/1, |
| 73 | | |
| 74 | | my_get_kodkod_predicates/3, my_add_predicate_to_kodkod/3, |
| 75 | | my_get_satsolver_predicates/3, my_add_predicate_to_satsolver/3, |
| 76 | | |
| 77 | | get_wf_dynamic_info/3, put_wf_dynamic_info/3, % these infos are stored together with the Kodkod preds |
| 78 | | % they can always be added and do not require updating the WF term like add_wait_flag_info does |
| 79 | | % add_wait_flag_info are static/lexical scoping infos; these are dynamic infos |
| 80 | | |
| 81 | | set_silent/1]). |
| 82 | | /* File: kernel_waitflags.pl */ |
| 83 | | /* Created: 17/3/06 by Michael Leuschel */ |
| 84 | | |
| 85 | | :- meta_predicate assert_must_abort_wf(0,*). |
| 86 | | %:- meta_predicate assert_must_abort2_wf(0,-). |
| 87 | | |
| 88 | | /* |
| 89 | | Phases of the ProB Kernel: |
| 90 | | |
| 91 | | -> all Waitflags unbound |
| 92 | | |
| 93 | | * Phase 0: propagation of completely known ground values in a deterministic fashion |
| 94 | | |
| 95 | | -> WF0 is bound (first to s(VAR) and then to s(0)) |
| 96 | | when WF0 is not ground one knows that the WF0 phase is still ongoing |
| 97 | | (relevant for getting 1.0 waitflag) |
| 98 | | |
| 99 | | * Phase 1: deterministic propagation (not necessarily of completely known full values) |
| 100 | | |
| 101 | | -> WF1 is bound (1.0) |
| 102 | | |
| 103 | | * Phase 2: boolean propagation (e.g., P or Q will now try P or Q) |
| 104 | | |
| 105 | | -> WF2 is bound |
| 106 | | |
| 107 | | * Phase 3: non-deterministic propagation (e.g, x: {1,2,3}) |
| 108 | | |
| 109 | | -> Enumeration Starting WF is bound |
| 110 | | |
| 111 | | * Enumeration Phase: (later to be split into enumeration of finite and infinite types (e.g., integer) |
| 112 | | |
| 113 | | -> Enumeration Finished Waitflag bound |
| 114 | | |
| 115 | | * Error Generation Phase: errors for, e.g., division by zero, f(x) with x outside domain of f,... are generated |
| 116 | | * This phase should not create choice points and should not detect failure |
| 117 | | (e.g., in the |
| 118 | | case of negated existential quantifiers the Enumeration Finished Waitflag will be set outside of delay_not) |
| 119 | | |
| 120 | | |
| 121 | | We now distinguish |
| 122 | | - Enumeration Wait Flags for Decision Variables with estimated enumeration domain size as priority |
| 123 | | - Binary Choice Point Wait Flags (stemming e.g. from disjunctions) |
| 124 | | |
| 125 | | Note: all floats like 1.0, 1.5, 2.0 ... are dealt with before all integers (even 1) ! |
| 126 | | |
| 127 | | There are three ways to create a waitflag store: |
| 128 | | - init_wait_flags : to create a fresh empty store |
| 129 | | - create_inner_wait_flags: the inner WFE should not be instantiated and will be instantiated from the outside |
| 130 | | useful for a nested quantifier where well-definedness errors should only be raised when the outer quantifier |
| 131 | | is set and where you want to enumerate the inner quantifier in isolation (e.g., for exists to be able to use the Prolog cut) |
| 132 | | - copy_wf_start to create a temporary copy with WF0 unset, which will be unified with copy_wf_finish |
| 133 | | useful for adding a new predicate to the constraint solver and ensure that WF0 is not set until |
| 134 | | predicate has been fully interpreted, to avoid enumerations/inefficient computations (e.g., there |
| 135 | | could be an obvious inconsistency at the end of the predicate) |
| 136 | | */ |
| 137 | | |
| 138 | | :- use_module(error_manager). |
| 139 | | :- use_module(self_check). |
| 140 | | :- use_module(typechecker). |
| 141 | | :- use_module(library(clpfd),[fd_size/2, fd_degree/2, (in/2)]). |
| 142 | | :- use_module(tools). |
| 143 | | :- use_module(tools_portability, [exists_source/1]). |
| 144 | | :- use_module(covsrc(coverage_tools_annotations),['$NOT_COVERED'/1]). |
| 145 | | :- use_module(preferences,[preference/2, get_preference/2]). |
| 146 | | :- use_module(debug,[debug_format/3]). |
| 147 | | |
| 148 | | :- use_module(module_information,[module_info/2]). |
| 149 | | :- module_info(group,kernel). |
| 150 | | :- module_info(description,'This module manages the various choice points and enumerators of ProB, by maintaining the kernel Waitflags store.'). |
| 151 | | |
| 152 | | :- type wait_flag +--> (var ; wfx(simple,mutable,simple,list(any)) ; no_wf_available). |
| 153 | | % a mutable either contains: |
| 154 | | % wfm_store(AVLWaitflagHeap,NewFDVARS,KodSatPredicateList) |
| 155 | | % wfm_ref(Mutable) a reference pointing to another Mutable which should be used to store waitflags |
| 156 | | |
| 157 | | :- use_module(library(lists),[is_list/1, delete/3, last/2]). |
| 158 | | :- use_module(library(avl)). |
| 159 | | |
| 160 | | % -------------- ATTRIBUTES ------------------ |
| 161 | | |
| 162 | | % Portable attributed variable handling. |
| 163 | | % Use SICStus-style library(atts) and verify_attributes/3 if available, |
| 164 | | % otherwise the SWI/hProlog-style attr builtins and attr_unify_hook/2. |
| 165 | | :- if(\+ exists_source(library(atts))). |
| 166 | | |
| 167 | | |
| 168 | | is_wf_abort_pending(Var) :- get_attr(Var,kernel_waitflags,wf_abort_pending). |
| 169 | | is_not_wf_abort_pending(Var) :- \+ get_attr(Var,kernel_waitflags,wf_abort_pending). |
| 170 | | put_wf_abort_pending(Var) :- put_attr(Var,kernel_waitflags,wf_abort_pending). |
| 171 | | |
| 172 | | attr_unify_hook(wf_abort_pending, Value) :- |
| 173 | | % we are unifying the EWF enumeration finished waitflag, not the store |
| 174 | | (nonvar(Value) -> true % EWF bound, enumeration finished |
| 175 | | ; get_attr(Value,kernel_waitflags,wf_abort_pending) -> true % other EWF Value already has same attribute |
| 176 | | ; put_attr(Value,kernel_waitflags,wf_abort_pending) |
| 177 | | ). |
| 178 | | |
| 179 | | :- else. |
| 180 | | |
| 181 | | :- use_module(library(atts)). |
| 182 | | :- attribute %wf_store/1,wf_fdvars/1, wf_kodkod/2, wf_satsolver/2, % now stored in mutable |
| 183 | | wf_abort_pending/0. |
| 184 | | |
| 185 | | is_wf_abort_pending(Var) :- get_atts(Var,+wf_abort_pending). |
| 186 | | is_not_wf_abort_pending(Var) :- get_atts(Var,-wf_abort_pending). |
| 187 | | put_wf_abort_pending(Var) :- put_atts(Var,+wf_abort_pending). |
| 188 | | |
| 189 | | % verify_attributes is called whenever a variable Var that might have attributes is about to be bound to Value (it might have none). |
| 190 | | % verify(VariableBeforeUnification, ValueWithWhichVariableUnifies, GoalWhichSICStusShouldCallAfterUnif) |
| 191 | | verify_attributes(Var, Value, [] ) :- get_atts(Var,+wf_abort_pending),!, |
| 192 | | % we are unifying the EWF enumeration finished waitflag, not the store |
| 193 | | (nonvar(Value) -> true % EWF bound, enumeration finished |
| 194 | | ; get_atts(Value,+wf_abort_pending) -> true % other EWF Value already has same attribute |
| 195 | | ; put_atts(Value,+wf_abort_pending) |
| 196 | | ). |
| 197 | | verify_attributes(Var, Value, [] ) :- |
| 198 | | (nonvar(Value) -> print('Trying to unify WFE flags'),nl |
| 199 | | ; print(verify_attributes(Var,Value)),nl). |
| 200 | | % The SICStus documentation is not entirely clear: it seems we only have to copy attributes from Var to Value, not the other way around |
| 201 | | |
| 202 | | :- endif. |
| 203 | | |
| 204 | | % -------------- MUTABLES ------------------ |
| 205 | | |
| 206 | | % Should we use several mutables? |
| 207 | | put_mutable_other_attr(Store,wf_preds(ID,Type,PredList)) :- !, |
| 208 | | get_mutable_store_for_update(Store,S,FD,KodSat,StoreToUpdate), |
| 209 | | update_preds(KodSat,ID,Type,PredList,KodSat2), |
| 210 | | update_mutable(wfm_store(S,FD,KodSat2),StoreToUpdate). |
| 211 | | put_mutable_other_attr(Store,wf_info(ID,Val)) :- !, % Store other infos in the wf_preds list |
| 212 | | get_mutable_store_for_update(Store,S,FD,KodSat,StoreToUpdate), |
| 213 | | (select(wf_info(ID,_),KodSat,Rest) -> true ; Rest=KodSat), |
| 214 | | update_mutable(wfm_store(S,FD,[wf_info(ID,Val)|Rest]),StoreToUpdate). |
| 215 | | put_mutable_other_attr(Store,New) :- |
| 216 | | add_internal_error('Uncovered put_mutable_other_attr',put_mutable_other_attr(Store,New)). |
| 217 | | |
| 218 | | % update AVL WF heap in WF Store |
| 219 | | % faster version of put_mutable_attr(Store,wf_store(NewHeap)) |
| 220 | | put_mutable_wf_store_attr(Store,NewHeap) :- |
| 221 | | get_mutable_store_for_update(Store,_,FD,KodSat,StoreToUpdate), |
| 222 | | update_mutable(wfm_store(NewHeap,FD,KodSat),StoreToUpdate). |
| 223 | | |
| 224 | | % update FD Variables List in WF Store |
| 225 | | % faster version of put_mutable_attr(Store,wf_fdvars(NewFDVARS)) |
| 226 | | put_mutable_wf_fdvars_attr(Store,NewFDVARS) :- |
| 227 | | get_mutable_store_for_update(Store,Heap,_,KodSat,StoreToUpdate), |
| 228 | | update_mutable(wfm_store(Heap,NewFDVARS,KodSat),StoreToUpdate). |
| 229 | | |
| 230 | | % TO DO: improve my_get_wf_store_fdvars_atts / put_mutable_attr pairs of calls to make them more efficient |
| 231 | | |
| 232 | | % update Kodkod or Satsolver predicates attached in store: |
| 233 | | update_preds([],ID,Type,PredList,[wf_preds(ID,Type,PredList)]). |
| 234 | | update_preds([wf_preds(ID,Type,_)|T],ID,Type,PredList,Res) :- !, |
| 235 | | Res = [wf_preds(ID,Type,PredList)|T]. |
| 236 | | update_preds([H|T],ID,Type,PredList,[H|RT]) :- |
| 237 | | update_preds(T,ID,Type,PredList,RT). |
| 238 | | |
| 239 | | % a utility predicate that always returns a mutable with wfm attribute |
| 240 | | get_mutable_store_for_update(Store, S,FD,KodSat, MutableToUpdate) :- mutable(Store),!, |
| 241 | | get_mutable(MutableInfo,Store), |
| 242 | | (get_mutable_infos__for_update_aux(MutableInfo,S,FD,KodSat,Store,MutableToUpdate) -> true |
| 243 | | ; add_internal_error('get_mutable_infos__for_update_aux failed for:',Store),fail). |
| 244 | | get_mutable_store_for_update(Store, S,[],[], Res) :- var(Store),!, Res=Store, |
| 245 | | empty_avl(S), |
| 246 | | create_mutable(wfm_store(S,[],[]),Store). |
| 247 | | get_mutable_store_for_update(Store, _,_,_, _) :- |
| 248 | | add_internal_error('get_mutable_store_for_update failed for:',Store),fail. |
| 249 | | |
| 250 | | get_mutable_infos__for_update_aux(wfm_store(S,FD,KodSat),S,FD,KodSat,Store,Store). |
| 251 | | get_mutable_infos__for_update_aux(wfm_ref(OuterStore),S,FD,KodSat,_,MutableToUpdate) :- |
| 252 | | get_mutable_store_for_update(OuterStore,S,FD,KodSat,MutableToUpdate). |
| 253 | | |
| 254 | | % follow links of wfm_ref to get access to proper mutable store to update |
| 255 | | deref_store(Store,MutableToUpdate) :- mutable(Store), !, |
| 256 | | (Store=wfm_ref(Store2) -> deref_store(Store2,MutableToUpdate) |
| 257 | | ; MutableToUpdate=Store). |
| 258 | | deref_store(Store,MutableToUpdate) :- var(Store),!, MutableToUpdate=Store, |
| 259 | | empty_avl(S), |
| 260 | | create_mutable(wfm_store(S,[],[]),Store). |
| 261 | | deref_store(Store, _) :- |
| 262 | | add_internal_error('deref_store failed for:',Store),fail. |
| 263 | | |
| 264 | | % get the associated infos for a mutable store; follow chain of wfm_ref's: |
| 265 | | get_mutable_infos(S,FD,KodSat,Store) :- mutable(Store), |
| 266 | | get_mutable(MutableInfo,Store), |
| 267 | | get_mutable_infos_aux(MutableInfo,S,FD,KodSat). |
| 268 | | get_mutable_infos_aux(wfm_store(S,FD,KodSat),S,FD,KodSat). |
| 269 | | get_mutable_infos_aux(wfm_ref(OuterStore),S,FD,KodSat) :- get_mutable_infos(S,FD,KodSat,OuterStore). |
| 270 | | |
| 271 | | my_get_wf_store_att(Store,Heap) :- get_mutable_infos(S,_,_,Store),!, |
| 272 | | Heap=S. |
| 273 | | my_get_wf_store_att(_,E) :- empty_avl(E). |
| 274 | | |
| 275 | | my_get_wf_preds_att(Store,ID,Type,PredList) :- get_mutable_infos(_,_,KodSat,Store),!, |
| 276 | | (member(wf_preds(ID,Type,R),KodSat) -> PredList=R). |
| 277 | | |
| 278 | | my_get_wf_info_att(Store,ID,Value) :- get_mutable_infos(_,_,KodSat,Store),!, |
| 279 | | (member(wf_info(ID,V),KodSat) -> Value=V). |
| 280 | | |
| 281 | | my_get_all_wf_info_atts(Store,List) :- get_mutable_infos(_,_,KodSat,Store),!, |
| 282 | | findall(wf_info(ID,V),member(wf_info(ID,V),KodSat),List). |
| 283 | | my_get_all_wf_info_atts(_,List) :- |
| 284 | | %init_wait_flags/1 will not initialise a mutable and get_mutable_infos will fail |
| 285 | | List=[]. |
| 286 | | |
| 287 | | my_get_fdvars_att(Store,FDList) :- get_mutable_infos(_,FD,_,Store),!, |
| 288 | | FDList=FD. |
| 289 | | my_get_fdvars_att(_,[]). |
| 290 | | |
| 291 | | my_get_wf_store_fdvars_atts(Store,Heap,FDList) :- get_mutable_infos(S,FD,_,Store),!, |
| 292 | | Heap=S, FDList=FD. |
| 293 | | my_get_wf_store_fdvars_atts(_,E,[]) :- empty_avl(E). |
| 294 | | |
| 295 | | % Mutable store should now point to another mutable store (OuterStore) |
| 296 | | % ensures that calls which add waitflags to Store now get-redirected to OuterStore |
| 297 | | set_mutable_ref(Store,OuterStore) :- mutable(Store), |
| 298 | | !, |
| 299 | | update_mutable(wfm_ref(OuterStore),Store). |
| 300 | | set_mutable_ref(Store,OuterStore) :- % not instantiated yet, we can simply unify |
| 301 | | Store=OuterStore. |
| 302 | | |
| 303 | | |
| 304 | | % ------------------------- |
| 305 | | |
| 306 | | % the Call must succeed and generate one abort_error |
| 307 | | assert_must_abort_wf(M:Call,WF) :- assert_must_succeed_any(M:(kernel_waitflags:assert_must_abort2_wf(M:Call,WF))). |
| 308 | | |
| 309 | | :- use_module(tools_printing,[format_with_colour_nl/4]). |
| 310 | | assert_must_abort2_wf(_,_) :- |
| 311 | | get_error(well_definedness_error,M), |
| 312 | | add_internal_error('Abort error prior to call in assert_must_abort: ',M),fail. |
| 313 | | assert_must_abort2_wf(Call,WF) :- |
| 314 | | (real_error_occurred -> RE=true ; RE=false), |
| 315 | | init_wait_flags(WF,[assert_must_abort2_wf]), |
| 316 | | call(Call), |
| 317 | | (ground_wait_flags(WF) |
| 318 | | -> add_internal_error('Call did not fail after grounding WF: ',assert_must_abort2_wf(Call,WF)),fail |
| 319 | | ; get_error(well_definedness_error,_), % we have 1 abort_error |
| 320 | | format_with_colour_nl(user_output,[blue],'Got expected well-definedness error',[]), |
| 321 | | (RE=false -> reset_real_error_occurred ; true) |
| 322 | | ). |
| 323 | | |
| 324 | | |
| 325 | | :- assert_must_succeed(( kernel_waitflags:init_wait_flags(WF), kernel_waitflags:check_is_wait_flag(WF) )). |
| 326 | | |
| 327 | | check_is_wait_flag(WFX) :- var(WFX),!, |
| 328 | | add_internal_error('Variable as waitflag: ',check_is_wait_flag(WFX)). |
| 329 | | check_is_wait_flag(no_wf_available) :- !. |
| 330 | | check_is_wait_flag(WFX) :- |
| 331 | | WFX = wfx(WF0,Store,WFE,Infos) |
| 332 | | -> (get_mutable_infos(_,_,_,Store) |
| 333 | | -> true |
| 334 | | ; print('WF does not yet contain heap: '), print(WFX),nl), |
| 335 | | %add_internal_error('WF does not contain heap: ',check_is_wait_flag(WFX))) |
| 336 | | (var(WF0) -> true ; WF0 = s(WF00), \+compound(WF00) -> true |
| 337 | | ; compound(WF0) -> add_internal_error('WF0 is compound: ',WF0) ; true |
| 338 | | ), |
| 339 | | (compound(WFE) -> add_internal_error('WFE is compound: ',WFE) ; true), |
| 340 | | (nonvar(Infos),is_list(Infos) -> true ; add_internal_error('WF Infos not list: ',Infos)) |
| 341 | | ; add_internal_error('Illegal WF Format: ',check_is_wait_flag(WFX)). |
| 342 | | |
| 343 | | |
| 344 | | % initialise a new waitflag store |
| 345 | | init_wait_flags(WF,Info) :- |
| 346 | | (nonvar(Info) -> true ; add_internal_error('Illegal WF Format: ',init_wait_flags(WF,Info))), |
| 347 | | init_debug_wait_flag_info(Info,Infos), |
| 348 | | WF=wfx(_,_Store,_,Infos). |
| 349 | | init_wait_flags(wfx(_,_Store,_,[])). % no_expansion_context_available |
| 350 | | init_wait_flags_with_infos(wfx(_,_Store,_,Infos),Infos). % infos copied as is without checking |
| 351 | | init_wait_flags_with_sd_infos(wfx(_,Store,_,StaticInfos),StaticInfos,DynamicInfos) :- |
| 352 | | init_wait_flags_store_with_dynamic_infos(Store,DynamicInfos). |
| 353 | | |
| 354 | | %init_wait_flags(wfx(_,Store,_,[])) :- init_wait_flags_store(Store). |
| 355 | | % we no longer do this because of performance, (see, e.g., LotsOfInvariants.mch) : |
| 356 | | init_wait_flags_store(Store) :- empty_avl(Heap), |
| 357 | | create_mutable(wfm_store(Heap,[],[]),Store). |
| 358 | | init_wait_flags_store_with_dynamic_infos(Store,KodkodDynInfos) :- empty_avl(Heap), |
| 359 | | create_mutable(wfm_store(Heap,[],KodkodDynInfos),Store). |
| 360 | | %init_wait_flags_store(Store) :- |
| 361 | | % empty_avl(Heap), |
| 362 | | % put_atts(Store,wf_store(Heap)), |
| 363 | | % put_atts(Store,wf_fdvars([])). |
| 364 | | |
| 365 | | |
| 366 | | :- assert_must_succeed(( kernel_waitflags:init_wait_flags(WF), |
| 367 | | kernel_waitflags:ground_wait_flag0(WF), kernel_waitflags:waitflag0_is_set(WF) )). |
| 368 | | :- assert_must_fail(( kernel_waitflags:init_wait_flags(WF), kernel_waitflags:waitflag0_is_set(WF) )). |
| 369 | | waitflag0_is_set(wfx(WF0,_Store,_EF,_INFOS)) :- ground(WF0). |
| 370 | | waitflag0_is_set(no_wf_available). |
| 371 | | |
| 372 | | get_new_subsidiary_wait_flag(OldWF,Info,WFX,NewWF) :- |
| 373 | | (ground(OldWF) /* then we have created a choice point with the old WF: double new WF prio */ |
| 374 | | -> double_prio(OldWF,NewPrio), get_wait_flag(NewPrio,Info,WFX,NewWF) |
| 375 | | ; NewWF = OldWF |
| 376 | | ). |
| 377 | | |
| 378 | | double_prio(OldPrio,NewPrio) :- number(OldPrio),!, NewPrio is OldPrio*2. |
| 379 | | double_prio(s(_),2) :- !. % for things like s(0) created for WF0 |
| 380 | | double_prio(Old,New) :- add_internal_error('Unknown priority: ',double_prio(Old,New)), New=2. |
| 381 | | |
| 382 | | % not used at the moment: |
| 383 | | %refresh_wait_flag(OldWF,Info,WFX,NewWF) :- |
| 384 | | % (ground(OldWF) /* then we have created a choice point with the old WF: double new WF prio */ |
| 385 | | % -> get_wait_flag(OldWF,Info,WFX,NewWF) |
| 386 | | % ; NewWF = OldWF |
| 387 | | % ). |
| 388 | | |
| 389 | | :- volatile silent/0. |
| 390 | | :- dynamic silent/0. |
| 391 | | set_silent(true) :- !,(silent -> true ; assertz(silent)). |
| 392 | | set_silent(false) :- retractall(silent). |
| 393 | | %waitflag_not_init :- silent -> true ; print('waitflag-store not initialised'),nl, '$NOT_COVERED'('This should not happen'). |
| 394 | | |
| 395 | | :- use_module(eventhandling,[register_event_listener/3]). |
| 396 | | :- register_event_listener(start_unit_tests,set_silent(true),'Allow wf not to be set up without printing a warning'). |
| 397 | | :- register_event_listener(stop_unit_tests, set_silent(false), 'Printing wf warnings again'). |
| 398 | | |
| 399 | | :- use_module(library(lists),[maplist/2]). |
| 400 | | add_fd_variables_for_labeling(Vars,WF) :- WF==no_wf_available,!, |
| 401 | | add_internal_error('Cannot add FDVars to waitflag store: ',Vars). |
| 402 | | add_fd_variables_for_labeling(Vars,WF) :- |
| 403 | | WF=wfx(_,Store,_EnumFinished,_INFOS), |
| 404 | | !, |
| 405 | | my_get_fdvars_att(Store,FDVARS), |
| 406 | | l_add_fd_var_to_FDVARS(Vars,FDVARS,NewFDVARS), |
| 407 | | put_mutable_wf_fdvars_attr(Store,NewFDVARS). |
| 408 | | add_fd_variables_for_labeling(Vars,WF) :- |
| 409 | | add_internal_error('Illegal waitflag store: ',add_fd_variables_for_labeling(Vars,WF)). |
| 410 | | |
| 411 | | l_add_fd_var_to_FDVARS([],Acc,Acc). |
| 412 | | l_add_fd_var_to_FDVARS([Var|VT],FDVARS,NewFDVARS) :- |
| 413 | | (nonvar(Var) -> F2=FDVARS; add_fd_var_to_FDVARS(Var,FDVARS,F2)), |
| 414 | | l_add_fd_var_to_FDVARS(VT,F2,NewFDVARS). |
| 415 | | |
| 416 | | % adds a CLP(FD) variable with given domain Size, will be enumerated by labeling (even if clpfd_solver preference is false !) |
| 417 | | % Size could be computed by fd_size(FDVariable,Size) |
| 418 | | add_fd_variable_for_labeling(FDVariable,WF) :- |
| 419 | | add_fd_variable_for_labeling_aux(FDVariable,WF). |
| 420 | | add_fd_variable_for_labeling(FDVariable,Size,WF) :- Size = not_used_anymore, |
| 421 | | add_fd_variable_for_labeling_aux(FDVariable,WF). |
| 422 | | |
| 423 | | |
| 424 | | add_fd_variable_for_labeling_aux(FDVariable,_WF) :- nonvar(FDVariable),!. |
| 425 | | add_fd_variable_for_labeling_aux(FDVariable,WF) :- |
| 426 | | % otherwise: store the FDVariable in the separate list of FD Variables (all mixed together) |
| 427 | | WF=wfx(_,Store,_EnumFinished,_), |
| 428 | | my_get_fdvars_att(Store,FDVARS), |
| 429 | | add_fd_var_to_FDVARS(FDVariable,FDVARS,NewFDVARS), |
| 430 | | %% fd_size(FDVariable,Size),print(added(FDVariable,Size,NewFDVARS,old(FDVARS))),nl, |
| 431 | | %% print(added_fd_variable(FDVariable,_Size,NewFDVARS)),nl,portray_waitflags_store(Store),nl,nl,%% |
| 432 | | put_mutable_wf_fdvars_attr(Store,NewFDVARS). |
| 433 | | |
| 434 | | add_fd_var_to_FDVARS(FDVariable,FDVARS,NewFDVARS) :- |
| 435 | | %print_term_summary(add_fd_var_to_FDVARS(FDVariable)),nl, |
| 436 | | %(fd_size(FDVariable,Sz), Sz=sup -> trace ; true), |
| 437 | | (FDVARS=[HH|_],HH==FDVariable -> NewFDVARS = FDVARS % variable already in list [cheap check at front] |
| 438 | | ; NewFDVARS = [FDVariable|FDVARS]). %% this adds new variables at front; will be given priority over older ones |
| 439 | | %% add_fd_var(FDVARS,FDVariable,NewFDVARS), %% this adds new variables at the end and does more thorough duplicate check |
| 440 | | |
| 441 | | |
| 442 | | % a bit like append: but cleans up list: removes numbers + checks if var already in list |
| 443 | | % runtimes for tests: 349 stays at 220ms, test 1088 4660 -> 5040ms |
| 444 | | %add_fd_var([],Var,[Var]). |
| 445 | | %add_fd_var([V|T],Var,Res) :- |
| 446 | | % (V==Var -> Res = [V|T] %,print(dup(V)),nl, |
| 447 | | % ; nonvar(V) -> add_fd_var(T,Var,Res) %,print(nonvar(V)),nl |
| 448 | | % ; Res = [V|RT], add_fd_var(T,Var,RT)). |
| 449 | | |
| 450 | | |
| 451 | | :- use_module(library(random),[random_select/3]). |
| 452 | | % reverse the list at each step; alternating taking from end and front; makes no sense with randomise_enumeration_order |
| 453 | | %my_get_next_fdvar_to_enumerate_rev(FDVARS,NextFDVar,RemainingFDVARS) :- lists:reverse(FDVARS,RevFDVARS), |
| 454 | | % my_get_next_fdvar_to_enumerate(RevFDVARS,NextFDVar,RemainingFDVARS). |
| 455 | | |
| 456 | | my_get_next_fdvar_to_enumerate([],_NextFDVar,_RemainingFDVARS) :- !,fail. |
| 457 | | my_get_next_fdvar_to_enumerate([V1|FDVARS],NextFDVar,RemainingFDVARS) :- |
| 458 | | nonvar(V1), |
| 459 | | !, % skip over non-variables (numbers); clpfd_get_next_variable_to_label does not delete variable from list and may crash with leading non-variable terms ! |
| 460 | | my_get_next_fdvar_to_enumerate(FDVARS,NextFDVar,RemainingFDVARS). |
| 461 | | my_get_next_fdvar_to_enumerate(FDVARS,NextFDVar,RemainingFDVARS) :- |
| 462 | | preferences:preference(randomise_enumeration_order,true), |
| 463 | | !, |
| 464 | | get_min_fd_size_elements(FDVARS,MinFDVars), |
| 465 | | random_select(NextFDVar,MinFDVars,_), |
| 466 | | %print(random_enum(NextFDVar,FDVARS,MinFDVars)),nl, |
| 467 | | RemainingFDVARS=FDVARS. % still contains variable; but no problem as it will be discarded later |
| 468 | | my_get_next_fdvar_to_enumerate(FDVARS,NextFDVar,RemainingFDVARS) :- |
| 469 | | %clpfd_interface:clpfd_get_next_variable_to_label_ffc(FDVARS,NextFDVar,RemainingFDVARS). |
| 470 | | clpfd_interface:clpfd_get_next_variable_to_label(FDVARS,NextFDVar), |
| 471 | | % print(enumerating(NextFDVar,FDVARS)),nl, maplist(tools_printing:print_arg,FDVARS),nl, |
| 472 | | RemainingFDVARS=FDVARS. |
| 473 | | % ((FDVARS=[H|T],H==NextFDVar) -> RemainingFDVARS=T ; RemainingFDVARS=FDVARS).% does not seem to buy any speed |
| 474 | | |
| 475 | | get_min_fd_size_elements([V1|FDVARS],MinFDVars) :- clpfd_size(V1,Size), |
| 476 | | get_min_aux(FDVARS,Size,[V1],MinFDVars). |
| 477 | | |
| 478 | | get_min_aux([],_,MinFDVars,MinFDVars). |
| 479 | | get_min_aux([V1|FDVARS],Size,MAcc,MinFDVars) :- number(V1),!, |
| 480 | | get_min_aux(FDVARS,Size,MAcc,MinFDVars). |
| 481 | | get_min_aux([V1|FDVARS],Size,MAcc,MinFDVars) :- |
| 482 | | clpfd_size(V1,Size1), |
| 483 | | (lt_size(Size1,Size) |
| 484 | | -> get_min_aux(FDVARS,Size1,[V1],MinFDVars) |
| 485 | | ; Size1=Size -> get_min_aux(FDVARS,Size,[V1|MAcc],MinFDVars) |
| 486 | | ; get_min_aux(FDVARS,Size,MAcc,MinFDVars) |
| 487 | | ). |
| 488 | | |
| 489 | | lt_size(X,Y) :- number(X),(Y=sup -> true ; X<Y). |
| 490 | | |
| 491 | | % ------------- |
| 492 | | |
| 493 | | % using this is relevant for e.g. tests 415, 416, 1096 : to give variables without frozen goals a lower priority |
| 494 | | % TO DO: we could filter out those before we call clpfd_get_next_variable_to_label !? |
| 495 | | fd_priority_leq_limit(FDVAR,Prio,Limit) :- |
| 496 | | clpfd_size(FDVAR,Size), |
| 497 | | number(Size), % not =sup or =inf |
| 498 | | geq_limit(Limit,Size), % the calculation below will only increase the Size |
| 499 | | (Size < 2 -> Prio = Size |
| 500 | | ; geq_limit(Limit,Size*4) -> Prio = Size % avoid calling frozen and fd_degree, Priority only used for warnings and bisect decisions |
| 501 | | ; (enumeration_only_fdvar(FDVAR) -> Prio is Size*4, Prio =< Limit |
| 502 | | ; Prio = Size) |
| 503 | | ). |
| 504 | | |
| 505 | | gt_limit(inf,_) :- !. |
| 506 | | gt_limit(inf_overflow,_) :- !. |
| 507 | | gt_limit(sup,_) :- !. |
| 508 | | gt_limit(X,Limit) :- X > Limit. |
| 509 | | |
| 510 | | geq_limit(inf,_) :- !. |
| 511 | | geq_limit(inf_overflow,_) :- !. |
| 512 | | geq_limit(sup,_) :- !. |
| 513 | | geq_limit(X,Limit) :- X >= Limit. |
| 514 | | |
| 515 | | |
| 516 | | |
| 517 | | % ------------- |
| 518 | | |
| 519 | | |
| 520 | | enumeration_only_fdvar(FDVAR) :- var(FDVAR),fd_degree(FDVAR,D),!, |
| 521 | | D=0, |
| 522 | | frozen(FDVAR,Goal), % print(frozen(FDVAR,D,Goal)),nl, |
| 523 | | enum_only_frozen_goal(Goal,FDVAR). |
| 524 | | enumeration_only_fdvar(_). |
| 525 | | |
| 526 | | % TO DO: maybe use enumeration_only_goal in b_enumerate |
| 527 | | enum_only_frozen_goal((A,B),Var) :- !, enum_only_frozen_goal(A,Var), enum_only_frozen_goal(B,Var). |
| 528 | | enum_only_frozen_goal(true,_). |
| 529 | | enum_only_frozen_goal(Module:Call,Var) :- enum_only_frozen_goal_m(Module,Call,Var). |
| 530 | | |
| 531 | | enum_only_frozen_goal_m(clpfd,_,_) :- !. |
| 532 | | enum_only_frozen_goal_m(kernel_objects,G,V) :- !, enum_only_frozen_goal_k_obj(G,V). |
| 533 | | enum_only_frozen_goal_m(b_interpreter_components,observe_variable_block(_,_,_,_,_),_). |
| 534 | | enum_only_frozen_goal_m(b_interpreter_components,observe_variable1_block(_,_,_,_),_). |
| 535 | | enum_only_frozen_goal_m(custom_explicit_sets,block_copy_waitflag_store(_,_,_,_,_),_). |
| 536 | | |
| 537 | | enum_only_frozen_goal_k_obj(safe_less_than_equal(_,X,Y),_) :- (number(X);number(Y)), !. |
| 538 | | enum_only_frozen_goal_k_obj(call_enumerate_int(X,_,_,_),Var) :- Var==X,!. |
| 539 | | enum_only_frozen_goal_k_obj(enumerate_int_wf(X,_,_,_,_),Var) :- Var==X,!. |
| 540 | | enum_only_frozen_goal_k_obj(true,_). |
| 541 | | |
| 542 | | |
| 543 | | % get a wait-flag that will be triggered first next time; |
| 544 | | % can be used to ensure that all pending co-routines complete |
| 545 | | get_idle_wait_flag(Info,wfx(WF0,Store,EnumFinished,_),LWF) :- !, |
| 546 | | (var(WF0) -> LWF=WF0 |
| 547 | | ; WF0=s(WF00), var(WF00) -> LWF=WF00 |
| 548 | | ; nonvar(EnumFinished) -> LWF=1 % waitflag store already grounded to completion; nobody may drive it anymore |
| 549 | | ; get_waitflag_from_store(0.9,Info,Store,LWF) |
| 550 | | ). |
| 551 | | get_idle_wait_flag(_Info,no_wf_available,1). |
| 552 | | |
| 553 | | |
| 554 | | get_wait_flag(Prio,Store,WF) :- get_wait_flag(Prio,'??',Store,WF). |
| 555 | | get_wait_flag(Prio,_Info,wfx(WF0,_Store,EnumFinished,_),WF) :- (Prio=0 ; ground(EnumFinished)), |
| 556 | | !, % if EnumFinished is ground nothing will drive the Waitflag store anymore |
| 557 | | % WF0 can be set to a variable by clone_wait_flags_from1 |
| 558 | | WF=WF0. |
| 559 | | get_wait_flag(1.0,Info,wfx(WF0,Store,_EnumFinished,_),WF) :- |
| 560 | | % WF for deterministic computations, not guaranteed to generate efficient representations |
| 561 | | % (those are triggered in WF0 phase) |
| 562 | | !, |
| 563 | | %used to b: (var(WF0) -> get_waitflag_from_store(1.0,Info,Store,WF) ; WF=1). |
| 564 | | (ground(WF0) % if WF0 is ground the WF0 phase is completed fully; |
| 565 | | -> WF=1 % we can return this waitflag immediately; |
| 566 | | % good idea also if we are already in the later stages of propagation |
| 567 | | % so as not to delay the attached deterministic propagations (see test 383, SudokuHexAsConstant.mch) |
| 568 | | ; get_waitflag_from_store(1.0,Info,Store,WF)). |
| 569 | | get_wait_flag(Prio,Info,wfx(_,Store,EnumFinished,_),WF) :- !, |
| 570 | | (ground(EnumFinished) -> WF=Prio /* enumeration has finished: return a ground WF */ |
| 571 | | ; get_waitflag_from_store(Prio,Info,Store,WF)). |
| 572 | | get_wait_flag(Prio,Info,Store,WF) :- check_is_wait_flag(Store), |
| 573 | | (Store=no_wf_available -> WF=Prio ; |
| 574 | | Store=none -> print(get_wait_flag_deprecated(Prio,Info,Store,WF)),nl, WF=Prio ; |
| 575 | | add_internal_error('Illegal call: ',get_wait_flag(Prio,Info,Store,WF))). |
| 576 | | |
| 577 | | :- use_module(kernel_card_arithmetic,[is_inf_or_overflow_card/1]). |
| 578 | | % get Waitflag with Priority Prio, additional information Info from Store |
| 579 | | get_waitflag_from_store(Prio,Info,Store,WF) :- |
| 580 | | % print(get_waitflag_from_store(Prio,Info,Store,WF)),nl, |
| 581 | | (is_inf_or_overflow_card(Prio) -> integer_priority(RealPrio) |
| 582 | | ; RealPrio=Prio), |
| 583 | | my_get_wf_store_att(Store,Heap), |
| 584 | | (avl_fetch(RealPrio,Heap,wf(WFs,_OldInfo)) %,print(fetch(RealPrio,WFs,_OldInfo)),nl |
| 585 | | -> ((RealPrio < 2 %is_finite_priority(RealPrio) |
| 586 | | ; Info = allow_reuse(_)) |
| 587 | | %RealPrio < 100000 % TO DO: investigate performance if reduce the threshold |
| 588 | | % here we re-use the waitflag instead of storing a new one |
| 589 | | -> (var(WFs) -> WF1 = WFs %, print(reusing_wf(RealPrio,WF1,Info)),nl |
| 590 | | ; WFs = [WF1|_]-_ -> true % add_wf has constructed a difference list |
| 591 | | ; print(wf_already_grounded(Prio,Info,WFs)),nl, |
| 592 | | WFs = WF1 |
| 593 | | ) |
| 594 | | ; push_waitflag(WFs,WF1,WFs2) -> |
| 595 | | % poses problems for 1003, possibly 1194; keep WFs as a FIFO stack to have localised enumeration |
| 596 | | %(RealPrio<100000 -> test_runner:inc_test_target_coverage ; true), |
| 597 | | avl_store(RealPrio,Heap,wf(WFs2,Info),NewHeap), |
| 598 | | put_mutable_wf_store_attr(Store,NewHeap) |
| 599 | | ; add_internal_error('Pushing waitflag failed:',RealPrio:WFs) |
| 600 | | ) |
| 601 | | ; avl_store(RealPrio,Heap,wf(WF1,Info),NewHeap), % print(storing_fresh_wf(RealPrio,WF1,Info)),nl, |
| 602 | | put_mutable_wf_store_attr(Store,NewHeap) % put_atts seems to be expensive |
| 603 | | ),!, |
| 604 | | WF=WF1. |
| 605 | | get_waitflag_from_store(Prio,Info,Store,WF) :- |
| 606 | | add_internal_error('Error getting Waitflag: ', get_waitflag_from_store(Prio,Info,Store,WF)),fail. |
| 607 | | |
| 608 | | % ---------------- |
| 609 | | |
| 610 | | % utilities for managing difference lists of waitflag variables for a particular priority: |
| 611 | | |
| 612 | | % for each priority we store wf(WFQueue,Info) |
| 613 | | % WFQueue is either a free variable (aka waitflag), or a difference list of free variables (waitflags) |
| 614 | | |
| 615 | | % push new waitflag NextWF onto an existing WF list for a priority |
| 616 | | push_waitflag(WFs,NextWF,NewWFs) :- var(WFs),!, NewWFs = [WFs,NextWF|TAIL]-TAIL. % create difference list |
| 617 | | push_waitflag(Head-TAIL,NextWF,NewWFs) :- !, TAIL = [NextWF|NewTAIL], NewWFs = Head-NewTAIL. |
| 618 | | push_waitflag(WFs,_,WFs) :- add_internal_error('Illegal waitflag list:',WFs). |
| 619 | | |
| 620 | | % pop the next waitflag NextWF from a list of waitflags associated with some priority |
| 621 | | pop_waitflag(WFs,NextWF,Tail) :- var(WFs),!, NextWF=WFs,Tail=[]. |
| 622 | | pop_waitflag(Head-Tail,NextWF,NextTail) :- Head \== Tail, % should always succeed |
| 623 | | !, |
| 624 | | Head = [NextWF|NextHead], |
| 625 | | (NextHead==Tail -> NextTail=[] ; NextTail = NextHead-Tail). |
| 626 | | pop_waitflag(WFs,_,_) :- add_internal_error('Illegal waitflag list, cannot pop:',WFs),fail. |
| 627 | | |
| 628 | | % merge_waitflag_queues(InnerWF,OuterWF,MergedWF) |
| 629 | | merge_waitflag_queues(WF1,WFs,MergedWFs) :- var(WFs),!, |
| 630 | | push_waitflag(WF1,WFs,MergedWFs). |
| 631 | | merge_waitflag_queues(WF1,Head2-Tail2,MergedWFs) :- var(WF1),!, |
| 632 | | MergedWFs = [WF1|Head2]-Tail2. % add WF1 at front |
| 633 | | merge_waitflag_queues(Head1-Tail1,Head2-Tail2,MergedWFs) :- !, % concatenation of difference lists |
| 634 | | Tail1=Head2, |
| 635 | | MergedWFs = Head1-Tail2. |
| 636 | | merge_waitflag_queues(WF1,WFs,MergedWFs) :- |
| 637 | | add_internal_error('Illegal WF list:',merge_waitflag_queues(WF1,WFs,MergedWFs)), |
| 638 | | MergedWFs = WFs. |
| 639 | | |
| 640 | | |
| 641 | | % ------------------------ |
| 642 | | |
| 643 | | % a version which delays getting a waitflag until the Prio is known: |
| 644 | | :- block block_get_wait_flag(-,?,?,?). |
| 645 | | block_get_wait_flag(Prio,Info,WFX,WF) :- get_wait_flag(Prio,Info,WFX,WF). |
| 646 | | |
| 647 | | % check if there are no waitflags and no FD variables; note: there could be pending co-routines on WF0 |
| 648 | | no_pending_waitflags(no_wf_available). |
| 649 | | no_pending_waitflags(wfx(_WF0,Store,_WFE,_)) :- |
| 650 | | my_get_wf_store_fdvars_atts(Store,Heap,FDList), |
| 651 | | FDList=[], % no FD Variables |
| 652 | | empty_avl(Heap). % no waitflags pending |
| 653 | | % Note grounding could still be in progress |
| 654 | | % TO DO: we could add attribute before grounding and remove after grounding !? |
| 655 | | |
| 656 | | |
| 657 | | % ------------------- |
| 658 | | |
| 659 | | % storing Predicates for Kodkod external function: |
| 660 | | my_get_kodkod_predicates(wfx(_,Store,_,_),ID,PredicateList) :- my_get_wf_preds(Store,ID,kodod,PredicateList). |
| 661 | | my_get_wf_preds(Store,ID,Type,PredicateList) :- |
| 662 | | (my_get_wf_preds_att(Store,ID,Type,PredicateList) |
| 663 | | -> true |
| 664 | | ; PredicateList = [] |
| 665 | | ). |
| 666 | | %my_store_wf_kodkod(Store,ID,PredicateList) :- put_atts(Store,+wf_kodkod(ID,PredicateList)). |
| 667 | | my_add_predicate_to_kodkod(wfx(_,Store,_,_),ID,Predicate) :- |
| 668 | | my_add_predicate_aux(wfx(_,Store,_,_),ID,kodod,Predicate). |
| 669 | | my_add_predicate_aux(wfx(_,Store,_,_),ID,Type,Predicate) :- |
| 670 | | my_get_wf_preds(Store,ID,Type,PredicateList), |
| 671 | | %length(PredicateList,Len), format('Adding pred to ~w of len ~w~n',[ID,Len]), |
| 672 | | put_mutable_other_attr(Store,wf_preds(ID,Type,[Predicate|PredicateList])). |
| 673 | | |
| 674 | | % ------------------- |
| 675 | | |
| 676 | | % storing Predicates for external function calling satsolver: |
| 677 | | my_get_satsolver_predicates(wfx(_,Store,_,_),ID,PredicateList) :- |
| 678 | | my_get_wf_preds(Store,ID,satsolver,PredicateList). |
| 679 | | my_add_predicate_to_satsolver(wfx(_,Store,_,_),ID,Predicate) :- |
| 680 | | my_add_predicate_aux(wfx(_,Store,_,_),ID,satsolver,Predicate). |
| 681 | | |
| 682 | | % ------------------- |
| 683 | | |
| 684 | | % allow to store and update other information entries |
| 685 | | % they are mixed in with the Kodkod predicate list |
| 686 | | |
| 687 | | get_wf_all_dynamic_infos(no_wf_available,[]). |
| 688 | | get_wf_all_dynamic_infos(wfx(_,Store,_,_),List) :- my_get_all_wf_info_atts(Store,List). |
| 689 | | |
| 690 | | get_wf_dynamic_info(wfx(_,Store,_,_),ID,Val) :- my_get_wf_info_att(Store,ID,Val). |
| 691 | | |
| 692 | | put_wf_dynamic_info(no_wf_available,_,_). |
| 693 | | put_wf_dynamic_info(wfx(_,Store,_,_),ID,Val) :- put_mutable_other_attr(Store,wf_info(ID,Val)). |
| 694 | | |
| 695 | | % ------------------- |
| 696 | | |
| 697 | | |
| 698 | | ground_wait_flag0(wfx(WF0,_,_,_)) :- grd_wf0(WF0). |
| 699 | | |
| 700 | | ground_wait_flags(wfx(WF0,Store,EnumFinish,WFInfos)) :- !, |
| 701 | ? | grd_wf0(WF0), |
| 702 | | deref_store(Store,DStore), |
| 703 | | init_wf_infos_for_grounding(WFInfos,WFInfos2), |
| 704 | | %nl,print(' ground_wait_flags:'),nl,portray_waitflags_store(Store), portray_call_stack(wfx(WF0,Store,EnumFinish,WFInfos)),nl, |
| 705 | ? | ground_waitflags_store_clpfd(DStore,WFInfos2), |
| 706 | | grd_ef(EnumFinish). |
| 707 | | ground_wait_flags(no_wf_available) :- !. |
| 708 | | ground_wait_flags(W) :- |
| 709 | | add_internal_error('Waitflags in wrong format: ',ground_wait_flags(W)). |
| 710 | | |
| 711 | | grd_wf0(E) :- %print(start_grd_wf0(E)),nl, |
| 712 | | (var(E) -> |
| 713 | | E=s(E2), % first make nonvar, and then ground (separate call to avoid merging unifications) |
| 714 | ? | grd_wf01(E2) %%,print(grd_wf0_done),nl |
| 715 | | ; E=s(E2) -> (nonvar(E2),E2 \== 0 -> add_internal_error('Illegal WF0 Waitflag value: ',grd_wf0(E)) |
| 716 | | ; grd_wf01(E2)) |
| 717 | | ; add_internal_error('Illegal WF0 Waitflag value functor: ',grd_wf0(E)) |
| 718 | | ). |
| 719 | | grd_wf01(0). |
| 720 | | |
| 721 | | grd_ef(E) :- var(E) -> E=0 |
| 722 | | ; ((E==0;E==wd_guarded) -> true ; add_internal_error('Illegal EF Waitflag value: ',grd_ef(E))). |
| 723 | | |
| 724 | | /* currently unused: |
| 725 | | create_wdguarded_wait_flags(wfx(WF0,Store,EnumFinish,Info),Res,Expected, |
| 726 | | wfx(WF0,Store,LocalEnumFinish,Info)) :- |
| 727 | | %% if Res=Expected then the computations of the inner waitflags should be well-defined; |
| 728 | | %% otherwise they may not |
| 729 | | copy_wfe(EnumFinish,Res,Expected,LocalEnumFinish). |
| 730 | | :- block copy_wfe(-,?,?,?), copy_wfe(?,-,?,?). |
| 731 | | copy_wfe(EnumFinish,Res,Expected,LocalEnumFinish) :- |
| 732 | | (Res==Expected -> LocalEnumFinish=EnumFinish |
| 733 | | ; LocalEnumFinish=wd_guarded %% branch is pruned by well-definedness condition |
| 734 | | ). |
| 735 | | */ |
| 736 | | |
| 737 | | % ground_constraintprop_wait_flags will not ground WFE flag |
| 738 | | |
| 739 | | :- load_files(library(system), [when(compile_time), imports([environ/2])]). |
| 740 | | :- if(environ(prob_safe_mode,true)). |
| 741 | | ground_constraintprop_wait_flags(W) :- check_is_wait_flag(W),fail. |
| 742 | | :- endif. |
| 743 | | ground_constraintprop_wait_flags(wfx(WF0,Store,_WFE,WFInfos)) :- |
| 744 | | %% print(ground_constraintprop_wait_flags(WF0,Store,_WFE)),nl, %% |
| 745 | ? | !,grd_wf0(WF0),% print(finished_grounding_wf0),nl,portray_waitflags_store(Store), |
| 746 | | deref_store(Store,DStore), |
| 747 | | init_wf_infos_for_grounding(WFInfos,WFInfos2), |
| 748 | ? | ground_waitflags_store_clpfd(DStore,WFInfos2). |
| 749 | | ground_constraintprop_wait_flags(no_wf_available) :- !. |
| 750 | | ground_constraintprop_wait_flags(W) :- |
| 751 | | add_internal_error('Waitflags in wrong format',ground_constraintprop_wait_flags(W)). |
| 752 | | |
| 753 | | |
| 754 | | |
| 755 | | :- use_module(clpfd_interface,[clpfd_in_domain/1, clpfd_labeling/2]). |
| 756 | | :- use_module(library(lists),[reverse/2]). |
| 757 | | |
| 758 | | % deprecated: |
| 759 | | ground_wf(Prio,WF) :- |
| 760 | | (var(WF) -> WF=Prio ; if(WF=Prio,true,add_internal_error('Illegal waitflag: ',ground_wf(Prio,WF)))). |
| 761 | | |
| 762 | | :- if(environ(debug_waitflags,true)). |
| 763 | | % provide feedback about waitflag grounding |
| 764 | | init_wf_infos_for_grounding(Infos,NewInfos) :- |
| 765 | | %print(start_wf_grounding(Infos)),nl, |
| 766 | | ord_add_element(Infos,wf_indent(_),NewInfos). |
| 767 | | |
| 768 | | % provided indentation to see scope of grounding |
| 769 | | indent_wf(WFInfos) :- member(wf_indent(Var),WFInfos),!,indent_var(Var). |
| 770 | | indent_wf(_). |
| 771 | | % indent based upon a shared variable and increment it |
| 772 | | indent_var(X) :- var(X),!, X=s(_). |
| 773 | | indent_var(s(X)) :- !,print('.'), indent_var(X). |
| 774 | | indent_var(_) :- print('***'). |
| 775 | | |
| 776 | | :- use_module(library(terms),[term_hash/3]). |
| 777 | | ground_prio(Prio,WFMin,Info,WFInfos) :- WFInfos \= '$debug_done', |
| 778 | | (member(IM,WFInfos),get_info_context_description(IM,Msg) -> true ; Msg=''), |
| 779 | | nl,indent_wf(WFInfos), |
| 780 | | term_hash(Info,[if_var(ignore)],Hash), |
| 781 | | format(' -> ~w --> #~w# ~w :: ~w ~w~n',[Prio,Hash,Info,WFMin,Msg]), |
| 782 | | !, |
| 783 | | ground_prio(Prio,WFMin,Info,'$debug_done'). % recursive, but this time normal clauses will apply |
| 784 | | :- else. |
| 785 | | init_wf_infos_for_grounding(I,I). |
| 786 | | :- endif. |
| 787 | | ground_prio(Prio,WF,Info,WFInfos) :- %print(ground_prio(Prio,WF,Info)),nl, |
| 788 | | nonvar(WF),!, |
| 789 | | (WF=[H|T] -> % we used sometimes to have a list of waitflags; ground one-by one; |
| 790 | | add_internal_error('Deprecated grounding of lists:',ground_prio(Prio,WF,Info,WFInfos)), |
| 791 | | reverse([H|T],Ls), |
| 792 | | maplist(ground_wf(Prio),Ls) |
| 793 | | ; ground(WF) -> true % already grounded by somebody else |
| 794 | | ; add_internal_error('Waitflag already partially grounded: ',ground_prio(Prio,WF,Info))). |
| 795 | | %ground_prio(Prio,WF,Info,WFInfos) :- get_debug_kernel_waitflags(Cntr),!, |
| 796 | | % print(ground_prio(Cntr,Prio,WF,Info)),nl, WF=Prio, print(grounded_prio(Cntr,Prio,WF,Info)),nl. |
| 797 | | ground_prio(Prio,WF,_Info,_WFInfos) :- |
| 798 | | %external_functions:indent_format(user_output,'~w (~w)~n',[Prio,Info],no_trace),portray_attached_goals(WF),nl, |
| 799 | | %% (debug:debug_mode(on) -> external_functions:indent_format(user_output,'~w (~w)~n',[Prio,Info],no_trace) ; true), |
| 800 | | % print(ground(Prio,WF,Info)),nl, translate:print_frozen_info(WF),nl, |
| 801 | | WF = Prio. % ground waitflag |
| 802 | | % print(grounded(Prio,Info)),nl,nl, %% |
| 803 | | |
| 804 | | %:- use_module(kernel_objects,[enum_warning_large/3]). |
| 805 | | label_clpfd_variable(Variable) :- label_clpfd_variable(2097153,Variable). |
| 806 | | label_clpfd_variable(Prio,Variable) :- |
| 807 | | %print(label_clpfd_variable(Prio,Variable)),nl, |
| 808 | | (gt_limit(Prio,2097152), % note Prio > test also works with float(X) terms ! |
| 809 | | check_if_labeling_domain_large(Variable,2097152,Size,RANGE) % {x|x:1..2**23 & x mod 2 = x mod 1001} takes about 2 minutes; {x|x:1..2**21 & x mod 2 = x mod 1001} takes about 30 seconds; 2**21 = 2097152, 2**23 = 8388608 |
| 810 | | -> %kernel_objects:enum_warning_large(Variable,'INTEGER VARIABLE',RANGE), % could in principle also be enumerated set; but extremely unlikely given size; enum_warning will generate virtual time-outs, ... -> we no longer do this; for AMASS scheduler.mch there is a time-out after step 301 otherwise |
| 811 | | performance_messages:perfmessage(enumerating_large_integer_variable(RANGE)), |
| 812 | | (number(Size) |
| 813 | | -> clpfd_labeling([Variable],[bisect]) % ffc no longer required: just a single variable |
| 814 | | ; add_warning(label_clpfd_variable,'Trying to enumerate FD Variable with infinite domain (possibly due to WD error) ',RANGE) |
| 815 | | % or due to clpfd_tables element/3 adding unbounded variables for labeling (add_fd_variables_for_labeling) |
| 816 | | ) |
| 817 | | % we use bisecting rather than default enumeration; e.g., x:1..8388610 & y:1..8388610 & x*x*x = y*y + y + 10 is relatively quickly determined to be unsatisfiable (380 ms) |
| 818 | | % Note: test 1099 tests this |
| 819 | | % TO DO: investigate whether it makes sense to use bisect for smaller values already |
| 820 | ? | ; preferences:preference(randomise_enumeration_order,true) -> clpfd_interface:clpfd_randomised_in_domain(Variable) |
| 821 | ? | ; clpfd_in_domain(Variable)). % TO DO: use random ? |
| 822 | | |
| 823 | | :- use_module(clpfd_interface,[ clpfd_size/2]). |
| 824 | | check_if_labeling_domain_large(H,Limit,Size,Res) :- |
| 825 | | clpfd_size(H,Size), |
| 826 | | gt_limit(Size,Limit), |
| 827 | | clpfd_interface:clpfd_domain(H,From,To), |
| 828 | | Res=From:To. |
| 829 | | |
| 830 | | %check_if_labeling_domain_finite(H) :- |
| 831 | | % clpfd_size(H,Size), number(Size). |
| 832 | | |
| 833 | | % mix ProB labeling with CLP(FD) labeling |
| 834 | | ground_waitflags_store_clpfd(Store,WFInfos) :- |
| 835 | | my_get_wf_store_fdvars_atts(Store,Heap,FD),!, |
| 836 | ? | ground_waitflags_store_clpfd_aux(Store,Heap,FD,WFInfos). |
| 837 | | ground_waitflags_store_clpfd(Store,WFInfos) :- |
| 838 | | add_internal_error('Illegal Waitflag: ',ground_waitflags_store_clpfd(Store,WFInfos)),fail. |
| 839 | | |
| 840 | | ground_waitflags_store_clpfd_aux(Store,Heap,FDVars,WFInfos) :- FDVars \= [], |
| 841 | | %my_get_fdvars_att(Store,FDVars), |
| 842 | | %get_atts(Store,wf_fdvars(FDVars)), % there is a list of FD vars available |
| 843 | | !, |
| 844 | | ( avl_del_min_waitflag(Heap,Prio,wf(WFMin,Info),NewHeap) |
| 845 | | -> % we have non-ground waitflags with a matching priority |
| 846 | | (my_get_next_fdvar_to_enumerate(FDVars,NextFDVar,RemainingFDVARS), |
| 847 | | fd_priority_leq_limit(NextFDVar,FDPrio,Prio) |
| 848 | ? | -> enum_fd_variable_store(FDPrio,Store,NextFDVar,RemainingFDVARS,WFInfos) |
| 849 | | ; put_mutable_wf_store_attr(Store,NewHeap), % write the modified heap back |
| 850 | | % debug:hit_counter(XXX),print(grounding(XXX,Prio,_Info)),nl, (XXX=16556->trace ; true), |
| 851 | ? | ground_prio(Prio,WFMin,Info,WFInfos), |
| 852 | ? | ground_waitflags_store_clpfd(Store,WFInfos) % continue recursively |
| 853 | | ) |
| 854 | | ; % there are no pending waitflag |
| 855 | | (my_get_next_fdvar_to_enumerate(FDVars,NextFDVar,RemainingFDVARS) |
| 856 | | -> enum_fd_variable_store(Store,NextFDVar,RemainingFDVARS,WFInfos) |
| 857 | | ; true % heap and FDVars list is empty, nothing more to do |
| 858 | | ) |
| 859 | | ). |
| 860 | | ground_waitflags_store_clpfd_aux(Store,Heap,[],WFInfos) :- % no FDVars are available to enumerate |
| 861 | | avl_del_min_waitflag(Heap,Prio,wf(WFMin,Info),NewHeap), |
| 862 | | !, |
| 863 | | put_mutable_wf_store_attr(Store,NewHeap), % write the modified heap back |
| 864 | | % debug:hit_counter(XXX),print(grounding(XXX,Prio,_Info)),nl, (XXX=16556->trace ; true), |
| 865 | ? | ground_prio(Prio,WFMin,Info,WFInfos), % ground waitflag |
| 866 | ? | ground_waitflags_store_clpfd(Store,WFInfos). % continue recursively |
| 867 | | ground_waitflags_store_clpfd_aux(_Store,_Heap,[],_). % heap and FDVars list is empty, nothing more to do |
| 868 | | |
| 869 | | %:- use_module(library(lists),[exclude/3]). |
| 870 | | enum_fd_variable_store(Store,NextFDVar,RemainingFDVARS,WFInfos) :- |
| 871 | | %exclude(nonvar,RemainingFDVARS,RemainingFDVARS2), |
| 872 | | put_mutable_wf_fdvars_attr(Store,RemainingFDVARS), |
| 873 | | %% print(labeling(NextFDVar,RemainingFDVARS)),nl, portray_fd_vars([NextFDVar|RemainingFDVARS]),nl,nl, |
| 874 | | label_clpfd_variable(NextFDVar), |
| 875 | | ground_waitflags_store_clpfd(Store,WFInfos). |
| 876 | | % a version of the above where we know the priority |
| 877 | | enum_fd_variable_store(FDPrio,Store,NextFDVar,RemainingFDVARS,WFInfos) :- |
| 878 | | %exclude(nonvar,RemainingFDVARS,RemainingFDVARS2), % does not seem to buy a lot |
| 879 | | put_mutable_wf_fdvars_attr(Store,RemainingFDVARS), |
| 880 | | %% print(labeling(NextFDVar,RemainingFDVARS)),nl, portray_fd_vars([NextFDVar|RemainingFDVARS]),nl,nl, |
| 881 | ? | label_clpfd_variable(FDPrio,NextFDVar), |
| 882 | ? | ground_waitflags_store_clpfd(Store,WFInfos). |
| 883 | | |
| 884 | | :- if(false). |
| 885 | | % small utility to trace through waitflag enumeration |
| 886 | | :- dynamic spying_on/1. |
| 887 | | spying_on(1). |
| 888 | | spy_waitflags(_,_) :- \+ spying_on(_) , !. |
| 889 | | spy_waitflags(Msg,Store) :- retract(spying_on(Nr)),print(Msg),nl, |
| 890 | | (Nr=1 |
| 891 | | -> assertz(spying_on(Nr)), |
| 892 | | print(' (j,t,p,q) ==> '),read_term(T,[]), |
| 893 | | action(T,Store) |
| 894 | | ; N1 is Nr-1, assertz(spying_on(N1)) |
| 895 | | ). |
| 896 | | action(t,_Store) :- !,trace. |
| 897 | | action(p,Store) :- !,portray_waitflags_store(Store), spy_waitflags('',Store). |
| 898 | | action(q,_Store) :- !,retractall(spying_on). |
| 899 | | action(Nr,_) :- number(Nr),!, retractall(spying_on(_)), assertz(spying_on(Nr)). |
| 900 | | action(_,_). |
| 901 | | :- endif. |
| 902 | | |
| 903 | | :- assert_must_succeed(( kernel_waitflags:init_wait_flags(WF), kernel_waitflags:portray_waitflags(WF), |
| 904 | | kernel_waitflags:get_wait_flag(2,'Test',WF,WF2), when(nonvar(WF2),print(wf2)), |
| 905 | | FD in 1..2,kernel_waitflags:add_fd_variable_for_labeling(FD,WF), |
| 906 | | kernel_waitflags:portray_waitflags(WF), kernel_waitflags:ground_wait_flags(WF) )). |
| 907 | | % PORTRAYING Waitflags |
| 908 | | portray_waitflags(wfx(WF0,Store,WFE,Infos)) :- flush_output, |
| 909 | | delete(Infos,call_stack(_),Infos2), |
| 910 | | print('*WAITFLAG STORE: '),print(wfx(WF0,'STORE',WFE,Infos2)),nl, |
| 911 | | portray_wait_flag_infos(Infos),nl, |
| 912 | | (var(WF0) -> print('> WF0 :: '), portray_attached_goals(WF0),nl ; true), |
| 913 | | portray_waitflags_store(Store),!, |
| 914 | | (var(WFE) -> print('> WFE :: '), portray_attached_goals(WFE),nl ; true), |
| 915 | | print('*END WAITFLAG STORE'),nl. |
| 916 | | %my_portray_avl(Heap),nl. |
| 917 | | portray_waitflags(none) :- !, print('*WAITFLAG STORE: none'),nl. |
| 918 | | portray_waitflags(no_wf_available) :- !, print('*WAITFLAG STORE: none'),nl. |
| 919 | | portray_waitflags(Store) :- |
| 920 | | add_internal_error('Illegal Waitflag: ',portray_waitflags(Store)),flush_output. |
| 921 | | |
| 922 | | portray_fd_vars([]) :- !, '$NOT_COVERED'('This is debugging code!'). |
| 923 | | portray_fd_vars([V|T]) :- print('> '), print(V), nonvar(V),!, nl, |
| 924 | | portray_fd_vars(T), '$NOT_COVERED'('This is debugging code!'). |
| 925 | | portray_fd_vars([V|T]) :- clpfd_size(V,Size), !, print(' : '), print(Size), |
| 926 | | portray_attached_goals(V), |
| 927 | | portray_fd_vars(T), |
| 928 | | '$NOT_COVERED'('This is debugging code!'). |
| 929 | | portray_fd_vars(X) :- print('> *** UNKNOWN FDVARS: '), print(X), nl, |
| 930 | | '$NOT_COVERED'('This is debugging code!'). |
| 931 | | |
| 932 | | portray_waitflags_store(Store) :- |
| 933 | | my_get_fdvars_att(Store,FDList), |
| 934 | | (FDList=[] -> true ; print('FDVARS:'),nl,portray_fd_vars(FDList),nl), |
| 935 | | my_get_wf_store_att(Store,Heap), |
| 936 | | avl_to_list(Heap,List), portray_avl_els(List). |
| 937 | | |
| 938 | | portray_avl_els([]). |
| 939 | | portray_avl_els([Prio-wf(LWF,Info)|T]) :- |
| 940 | | print('> '),print(Prio), print(' : '), print(LWF), print(' : '), portray_info(Info),nl, |
| 941 | | portray_attached_goals(LWF), |
| 942 | | portray_avl_els(T). |
| 943 | | |
| 944 | | portray_info(label_clpfd_vars(Vars)) :- print('label_clpfd_vars :: '), |
| 945 | | translate:l_print_frozen_info(Vars). |
| 946 | | portray_info(I) :- print(I). |
| 947 | | |
| 948 | | portray_attached_goals(V) :- V==[],!. |
| 949 | | portray_attached_goals(LWF) :- nonvar(LWF),LWF=[H|T],!, |
| 950 | | portray_attached_goals(H), |
| 951 | | portray_attached_goals(T). |
| 952 | | portray_attached_goals(LWF) :- frozen(LWF,Goal), print(' :: '), portray_goal(Goal),nl. |
| 953 | | |
| 954 | | :- use_module(tools_printing,[print_term_summary/1]). |
| 955 | | portray_goal((A,B)) :- !, portray_goal(A), print(','), print(' '), portray_goal(B). |
| 956 | | portray_goal(A) :- print_term_summary(A). |
| 957 | | |
| 958 | | |
| 959 | | :- public my_portray_avl/1. |
| 960 | | my_portray_avl(V) :- var(V), !, add_internal_error('Variable: ',my_portray_avl(V)). |
| 961 | | my_portray_avl(V) :- portray_avl(V). |
| 962 | | |
| 963 | | |
| 964 | | quick_portray_waitflags(wfx(WF0,Store,WFE,_)) :- |
| 965 | | my_get_wf_store_fdvars_atts(Store,Heap,FDList), |
| 966 | | avl_domain(Heap,List), |
| 967 | | format('% Waitflags-Store WF0=~w,WFE=~w, Flags=~w, FDVars=~w~n',[WF0,WFE,List,FDList]). |
| 968 | | quick_portray_waitflags(no_wf_available) :- |
| 969 | | format('% Waitflags-Store no_wf_available~n',[]). |
| 970 | | quick_portray_waitflags_store(Store) :- |
| 971 | | my_get_wf_store_fdvars_atts(Store,Heap,FDList), |
| 972 | | avl_domain(Heap,List), |
| 973 | | format('% Waitflags-Store Flages=~w, FDVars=~w~n',[List,FDList]). |
| 974 | | |
| 975 | | % get information about the phase a Waitflag store is in |
| 976 | | get_waitflags_phase(no_wf_available,Phase) :- Phase=no_wf_available. |
| 977 | | get_waitflags_phase(wfx(WF0,_,WFE,_),Phase) :- |
| 978 | | (var(WF0) -> Phase=phase0 |
| 979 | | ; \+ ground(WF0) -> Phase=phase1 |
| 980 | | ; ground(WFE) -> Phase=enumeration_finished |
| 981 | | ; Phase = grounding). % TODO: get avl_min |
| 982 | | |
| 983 | | :- assert_must_succeed(( kernel_waitflags:init_wait_flags(WF), |
| 984 | | kernel_waitflags:get_wait_flag1(WF,WF1), when(ground(WF1),X=a), |
| 985 | | kernel_waitflags:ground_wait_flags(WF), X==a )). |
| 986 | | |
| 987 | | % create a copy of the waitflags with WF0 and WFE as variable; should be finished with copy_wf_finish |
| 988 | | % can be used if you temporarily want to disable non-deterministic enumeration, ... |
| 989 | | % This is typically used within e.g., a local scope where a conjunction of predicates is added |
| 990 | | % we start 1) by doing copy_wf_start(OuterWF,LocalWF), 2) assert all predicates, |
| 991 | | % and then 3) call copy_wf_finish at the end of the block |
| 992 | | % This ensures that during assertion of the predicates only efficient deterministic computations occur |
| 993 | | copy_wf_start(wfx(_,WFStore,_,Infos),Info,wfx(_,WFStore,_,NewInfos)) :- |
| 994 | | add_debug_wait_flag_info(Infos,wf_copy(Info),NewInfos). |
| 995 | | copy_wf_start(no_wf_available,_,no_wf_available). |
| 996 | | |
| 997 | | % just copy WF0 and WFE over to new waitflag |
| 998 | | copy_wf_finish(wfx(WF0,_,WFE,_),wfx(WF0,Store,WFE2,Info)) :- |
| 999 | ? | (var(WFE) -> WFE2 = WFE |
| 1000 | | ; % the outer WF is already fully grounded and will not be driven anymore |
| 1001 | | % so now we ground all the constraints that have been set-up since copy_wf_start |
| 1002 | | ground_wait_flags(wfx(WF0,Store,WFE2,Info)) |
| 1003 | | ). |
| 1004 | | copy_wf_finish(no_wf_available,no_wf_available). |
| 1005 | | |
| 1006 | | |
| 1007 | | /* create a copy where the enumeration_finished waitflag is shared; |
| 1008 | | the inner enumeration_finished wait flags should normally not be grounded */ |
| 1009 | | create_inner_wait_flags(wfx(_,OuterStore,WFE,Infos),Info,wfx(_WF0Inner,S,WFEInner,NewInfos)) :- |
| 1010 | | add_debug_wait_flag_info(Infos,Info,NewInfos), |
| 1011 | | copy_wfe_to_inner(WFE,WFEInner), |
| 1012 | | my_get_all_wf_info_atts(OuterStore,DynInfos), % copy dynamic wf_infos from outer to inner store |
| 1013 | | init_wait_flags_store_with_dynamic_infos(S,DynInfos). |
| 1014 | | |
| 1015 | | create_inner_wait_flags(no_wf_available,_,no_wf_available). |
| 1016 | | |
| 1017 | | % was using: get_inner_enumeration_over_wait_flag/get_enumeration_almost_finished_wait_flag |
| 1018 | | %:- block copy_wfe_to_inner(-,?,?). |
| 1019 | | %copy_wfe_to_inner(_,WFE,WFE). |
| 1020 | | |
| 1021 | | :- block copy_wfe_to_inner(-,-). |
| 1022 | | copy_wfe_to_inner(WFE,_) :- var(WFE),!. % inner was grounded before outer |
| 1023 | | copy_wfe_to_inner(WFE,WFE). |
| 1024 | | % copy enumeration finished waitflag from inner computation if WFE was not grounded there |
| 1025 | | % assumes inner WF enumeration is finished |
| 1026 | | copy_wfe_from_inner_if_necessary(wfx(_,_,WFEInner,_),wfx(_,_,WFE,_)) :- var(WFEInner),!, WFE=WFEInner. |
| 1027 | | copy_wfe_from_inner_if_necessary(_,_). |
| 1028 | | |
| 1029 | | % is very similar to ground_constraintprop_wait_flags, but will also ground EF if no abort is pending |
| 1030 | | ground_inner_wait_flags(WF) :- |
| 1031 | ? | ground_constraintprop_wait_flags(WF), |
| 1032 | | ground_ef_wait_flag_unless_abort_pending(WF). |
| 1033 | | |
| 1034 | | % copy WF0 and WFE, set up a new store for the rest |
| 1035 | | copy_wf01e_wait_flags(wfx(WF0,WFX,WFE,Infos),wfx(WF0,S,WFE,Infos)) :- |
| 1036 | | init_wait_flags_store(S), |
| 1037 | | get_waitflag_from_store(1,copy_wf01e,WFX,WF1), % now ground wait flag 1 if it is grounded in the orginal WF store |
| 1038 | | copy_wf01e_wait_flags_aux(WF1,S). |
| 1039 | | copy_wf01e_wait_flags(no_wf_available,no_wf_available). |
| 1040 | | |
| 1041 | | :- block copy_wf01e_wait_flags_aux(-,?). |
| 1042 | | copy_wf01e_wait_flags_aux(_,S) :- |
| 1043 | | ground_waitflags_store_up_to_no_clpfd(1,S,[]). % no CLPFD - labeling required until prio 1 |
| 1044 | | |
| 1045 | | %-------------- |
| 1046 | | |
| 1047 | | % the following is useful when new predicates are checked during enumeration |
| 1048 | | % creates a copy of the wait_flags, except for WF0; this needs to be grounded separately with grd_wf0/1 or clone_finish |
| 1049 | | % thanks to the copy, WF0 is a variable again and we give priority to propagations that create avl_sets |
| 1050 | | clone_wait_flags_from1(wfx(_WF0,S,WFE,Infos),Ground,wfx(_NewWF0,S2,NewWFE,Infos)) :- |
| 1051 | | (nonvar(WFE) |
| 1052 | | -> Ground=ground_upon_finish, |
| 1053 | | add_debug_message(clone_wait_flags_from1,'Cloning WF store whose enumeration is finished: ',Infos) |
| 1054 | | ; Ground=no_grounding, |
| 1055 | | NewWFE=WFE % waitflag store still being driven by enumerator, no need to ground/enumerate afterwards |
| 1056 | | ), |
| 1057 | | deref_store(S,S2). |
| 1058 | | clone_wait_flags_from1(no_wf_available,no_grounding,no_wf_available). |
| 1059 | | |
| 1060 | | % call after clone_wait_flags_from1, after you have set up all predicates/constraints |
| 1061 | | clone_wait_flags_from1_finish(wfx(WF0,_,_,_),Ground,wfx(WF0,S2,NewWFE,Infos)) :- % finish copying by copying over WF0 |
| 1062 | ? | (Ground=no_grounding -> true |
| 1063 | | ; ground_wait_flags(wfx(WF0,S2,NewWFE,Infos)) % the cloned store is not being enumerated anymore; do it ourselves |
| 1064 | | ). |
| 1065 | | clone_wait_flags_from1_finish(no_wf_available,_,no_wf_available). |
| 1066 | | |
| 1067 | | %-------------- |
| 1068 | | |
| 1069 | | get_wait_flag0(wfx(WF0,_,_,_),WF0). |
| 1070 | | get_wait_flag0(no_wf_available,0). |
| 1071 | | |
| 1072 | | %get_wait_flag0(WFX,WF0) :- get_wait_flag(0,WFX,WF0). /* when this is ground you can do det. propagatons */ |
| 1073 | | get_wait_flag1(WFX,WF1) :- get_wait_flag(1.0,WFX,WF1). /* when this is ground you can do det. propagatons */ |
| 1074 | | get_wait_flag1(Info,WFX,WF1) :- %print(getwf1(Info)),nl, portray_waitflags(WFX),nl, |
| 1075 | | get_wait_flag(1.0,Info,WFX,WF1). |
| 1076 | | |
| 1077 | | get_binary_choice_wait_flag(_,no_wf_available,WF2) :- !, WF2=2. |
| 1078 | | get_binary_choice_wait_flag(Info,WF,WF2) :- get_preference(data_validation_mode,true),!, |
| 1079 | | get_binary_choice_wait_flag_exp_backoff(1048576,Info,WF,WF2). |
| 1080 | | % in DV mode we do not want to enumerate bool(.) or similar; we want to wait for data enumeration to decide those |
| 1081 | | % prio was 1048576, caused slowdown for TYPES_AUTORISES_RVF3_GEN__MRGA.mch before improvement to b_check_exists_wfwd |
| 1082 | | get_binary_choice_wait_flag(Info,WFX,WF2) :- !, get_binary_choice_wait_flag_exp_backoff(4,Info,WFX,WF2). |
| 1083 | | %get_binary_choice_wait_flag(Info,WFX,WF2) :- % use 3 rather than 2 to give priority over enumeration choicepoints |
| 1084 | | % get_wait_flag(4,Info,WFX,WF2). /* when this is ground you can do binary propagatons */ |
| 1085 | | |
| 1086 | | %get_middle_wait_flag(Info,WFX,WFn) :- get_wait_flag(10,Info,WFX,WFn). |
| 1087 | | |
| 1088 | ? | get_last_wait_flag(Info,WFX,Res) :- last_finite_priority(P), get_wait_flag(P,Info,WFX,Res). |
| 1089 | | |
| 1090 | | % ------------------------ |
| 1091 | | get_wait_flag_infos(wfx(_,_,_,Infos),Infos). |
| 1092 | | get_wait_flag_infos(no_wf_available,[]). |
| 1093 | | |
| 1094 | | portray_wait_flag_infos(wfx(_,_,_,Infos)) :- !, portray_wait_flag_infos(Infos). |
| 1095 | | portray_wait_flag_infos(no_wf_available) :- !. |
| 1096 | | portray_wait_flag_infos(List) :- maplist(portray_wait_flag_info,List). |
| 1097 | | |
| 1098 | | portray_wait_flag_info(call_stack(CallStack)) :- !, translate_call_stack(CallStack,TS), write(TS). |
| 1099 | | portray_wait_flag_info(X) :- write(X),nl. |
| 1100 | | |
| 1101 | | |
| 1102 | | :- use_module(library(ordsets),[ord_member/2,ord_add_element/3]). |
| 1103 | | get_wait_flag_info(wfx(_,_,_,Infos),Info) :- member(Info,Infos). |
| 1104 | | |
| 1105 | | % use if the Info field is known, requires ordered/sorted Infos list |
| 1106 | | % used for wfx_no_enumeration information, see test 1368 |
| 1107 | | is_wait_flag_info(wfx(_,_,_,Infos),Info) :- |
| 1108 | | (nonvar(Infos) -> ord_member(Info,Infos) ; print(var_waitflag),nl,fail). |
| 1109 | | |
| 1110 | | %set_wait_flag_infos(wfx(WF0,Store,WFE,_),Infos,wfx(WF0,Store,WFE,Infos)). |
| 1111 | | %set_wait_flag_infos(no_wf_available,_,no_wf_available). |
| 1112 | | |
| 1113 | | % add new Info entry to WF store's info list |
| 1114 | | add_wait_flag_info(wfx(WF0,Store,WFE,Infos),Info,wfx(WF0,Store,WFE,NewInfos)) :- |
| 1115 | | (ord_add_element(Infos,Info,NewInfos) -> true %, print(added_wf_infos(NewInfos)),nl |
| 1116 | | ; add_internal_error('Could not add_wait_flag_info:',(Info,Infos)), |
| 1117 | | NewInfos = [Info|Infos]). |
| 1118 | | add_wait_flag_info(no_wf_available,_,no_wf_available). |
| 1119 | | |
| 1120 | | |
| 1121 | | % CALL STACK related predicates |
| 1122 | | % -------------- |
| 1123 | | :- use_module(tools_lists,[ord_update_nonvar/4]). |
| 1124 | | % push call stack information into the WF info field |
| 1125 | | push_wait_flag_call_stack_info(no_wf_available,_,WF2) :- !, WF2=no_wf_available. |
| 1126 | | push_wait_flag_call_stack_info(wfx(WF0,Store,WFE,Infos),CallInfo,wfx(WF0,Store,WFE,NewInfos)) :- |
| 1127 | | ord_update_nonvar(call_stack(Stack),Infos,call_stack([CallInfo|Stack]),NewInfos),!, |
| 1128 | | %print(push_call_stack(CallInfo,Stack)),nl, |
| 1129 | | (var(Stack) -> Stack=[] % no call stack available yet |
| 1130 | | ; true). |
| 1131 | | push_wait_flag_call_stack_info(WF,CallInfo,WF) :- add_internal_error('Pushing call stack failed: ',CallInfo). |
| 1132 | | |
| 1133 | | % only push in TRACE_INFO mode to avoid performance hit in regular mode |
| 1134 | | opt_push_wait_flag_call_stack_info(WF,_,WF2) :- preference(provide_trace_information,false),!, WF2=WF. |
| 1135 | | opt_push_wait_flag_call_stack_info(WF,CallInfo,WF2) :- |
| 1136 | | push_wait_flag_call_stack_info(WF,CallInfo,WF2). |
| 1137 | | |
| 1138 | | debug_opt_push_wait_flag_call_stack_info(WF,CallInfo,WF2) :- |
| 1139 | | (debug_mode(off) -> WF2=WF |
| 1140 | | ; opt_push_wait_flag_call_stack_info(WF,CallInfo,WF2) |
| 1141 | | ). |
| 1142 | | |
| 1143 | | :- use_module(tools_lists,[ord_member_nonvar_chk/2]). |
| 1144 | | add_call_stack_to_span(Span,wfx(_,_,_,Infos),NewSpan) :- |
| 1145 | | (var(Infos) -> write(illegal_wfx),nl,fail ; true), |
| 1146 | | ord_member_nonvar_chk(call_stack(CallStack),Infos), |
| 1147 | | !, |
| 1148 | | (Span = pos_context(Span1,call_stack(Stack1),Span2), % we already have a call_stack |
| 1149 | | last(CallStack,LNew), last(Stack1,L1), |
| 1150 | | LNew \== L1, % check that we have not already merged in the new call stack |
| 1151 | | append(Stack1,CallStack,NewStack) |
| 1152 | | -> NewSpan = pos_context(Span1,call_stack(NewStack),Span2) |
| 1153 | | ; % we do not already have merged in a call-stack |
| 1154 | | NewSpan = pos_context(Span,call_stack(CallStack),unknown) |
| 1155 | | ). |
| 1156 | | add_call_stack_to_span(Span,_,Span). |
| 1157 | | |
| 1158 | | % a variation of add_error/4 |
| 1159 | | add_error_wf(Src,Msg,V,Span,WF) :- |
| 1160 | | add_call_stack_to_span(Span,WF,NewSpan), |
| 1161 | | add_error(Src,Msg,V,NewSpan). |
| 1162 | | |
| 1163 | | add_internal_error_wf(Src,Msg,V,Span,WF) :- |
| 1164 | | add_call_stack_to_span(Span,WF,NewSpan), |
| 1165 | | add_internal_error(Src,Msg,V,NewSpan). |
| 1166 | | |
| 1167 | | % a variation of add_error/4 |
| 1168 | | add_warning_wf(Src,Msg,V,Span,WF) :- |
| 1169 | | add_call_stack_to_span(Span,WF,NewSpan), |
| 1170 | | add_warning(Src,Msg,V,NewSpan). |
| 1171 | | |
| 1172 | | % a variation of add_message/4 |
| 1173 | | add_message_wf(Src,Msg,V,Span,WF) :- |
| 1174 | | add_call_stack_to_span(Span,WF,NewSpan), |
| 1175 | | add_message(Src,Msg,V,NewSpan). |
| 1176 | | |
| 1177 | | :- use_module(translate,[translate_call_stack/2]). |
| 1178 | | portray_call_stack(Var) :- var(Var),!, |
| 1179 | | add_internal_error('Illegal var WF:',portray_call_stack(Var)). |
| 1180 | | portray_call_stack(wfx(_,_,_,Infos)) :- |
| 1181 | | ord_member_nonvar_chk(call_stack(CallStack),Infos),!, |
| 1182 | | translate_call_stack(CallStack,TS),!,write(TS),nl. |
| 1183 | | portray_call_stack(_) :- write(no_call_stack_available),nl. |
| 1184 | | |
| 1185 | | % copy call stack info from one wait flag to another |
| 1186 | | copy_wait_flag_call_stack_info(wfx(_,_,_,FromInfos),wfx(WF0,Store,WFE,Infos),wfx(WF0,Store,WFE,NewInfos)) :- |
| 1187 | | ord_member_nonvar_chk(call_stack(CallStack),FromInfos),!, |
| 1188 | | ord_add_element(Infos,call_stack(CallStack),NewInfos). |
| 1189 | | copy_wait_flag_call_stack_info(_,WF,WF). |
| 1190 | | |
| 1191 | | % get call stack, empty list if none available |
| 1192 | | get_call_stack(wfx(_,_,_,FromInfos),Stack) :- |
| 1193 | | ord_member_nonvar_chk(call_stack(CallStack),FromInfos),!, |
| 1194 | | Stack=CallStack. |
| 1195 | | get_call_stack(_,[]). |
| 1196 | | |
| 1197 | | :- use_module(library(lists),[select/3]). |
| 1198 | | init_quantifier_wait_flag(OuterWF,_QK,Paras,ParaValues,Pos,WF) :- |
| 1199 | ? | select(QK,Pos,Pos1), |
| 1200 | | detect_quantifier_kind(QK,QuantKind),!, % see if we have position infos which indicate the origin of the comprehension_set / quantifier |
| 1201 | | simplify_span(Pos1,SPos), |
| 1202 | | init_wait_flags_and_push_call_stack(OuterWF,quantifier_call(QuantKind,Paras,ParaValues,SPos),WF). |
| 1203 | | init_quantifier_wait_flag(OuterWF,QuantKind,Paras,ParaValues,Pos,WF) :- |
| 1204 | | simplify_span(Pos,SPos), |
| 1205 | | init_wait_flags_and_push_call_stack(OuterWF,quantifier_call(QuantKind,Paras,ParaValues,SPos),WF). |
| 1206 | | |
| 1207 | | % check grounding of WFE flag occurs after everything else |
| 1208 | | :- public observe_wait_flags_wfe/1. % debugging utility |
| 1209 | | observe_wait_flags_wfe(wfx(WF0,WFX,WFE,Infos)) :- !, obs(WF0,WFX,WFE,Infos). |
| 1210 | | observe_wait_flags_wfe(_). |
| 1211 | | :- block obs(?,?,-,?). |
| 1212 | | obs(WF0,WFX,WFE,Infos) :- |
| 1213 | | add_message_wf(kernel_waitflags,'WFE grounded:',WFE,unknown,wfx(WF0,WFX,WFE,Infos)), |
| 1214 | | var(WF0),!, |
| 1215 | | add_error_wf(kernel_waitflags,'WF0 not grounded before WFE:',WF0,unknown,wfx(WF0,WFX,WFE,Infos)). |
| 1216 | | obs(WF0,WFX,WFE,Infos) :- my_get_fdvars_att(WFX,FDList), FDList \= [], !, |
| 1217 | | add_error_wf(kernel_waitflags,'FDVars not grounded before WFE:',FDList,unknown,wfx(WF0,WFX,WFE,Infos)). |
| 1218 | | obs(WF0,WFX,WFE,Infos) :- my_get_wf_store_att(WFX,Heap), avl_to_list(Heap,List), List \= [], !, |
| 1219 | | add_error_wf(kernel_waitflags,'Waitflags not grounded before WFE:',List,unknown,wfx(WF0,WFX,WFE,Infos)). |
| 1220 | | obs(_WF0,_WFX,_WFE,_Infos). |
| 1221 | | |
| 1222 | | % a version of opt_push_wait_flag_call_stack_info for quantifiers |
| 1223 | | opt_push_wait_flag_call_stack_quantifier_info(WF,_,_,_,_,WF2) :- |
| 1224 | | preference(provide_trace_information,false),!, WF2=WF. |
| 1225 | | opt_push_wait_flag_call_stack_quantifier_info(no_wf_available,_,_,_,_,WF2) :- !, WF2=no_wf_available. |
| 1226 | | opt_push_wait_flag_call_stack_quantifier_info(WF,QuantKind,Paras,ParaValues,Pos,WF2) :- |
| 1227 | | simplify_span(Pos,SPos), |
| 1228 | | opt_push_wait_flag_call_stack_info(WF,quantifier_call(QuantKind,Paras,ParaValues,SPos),WF2). |
| 1229 | | |
| 1230 | | detect_quantifier_kind(prob_annotation('LAMBDA'),lambda). |
| 1231 | | detect_quantifier_kind(quantifier_kind(QK),QK). |
| 1232 | | |
| 1233 | | %init_wait_flags_and_push_call_stack(_,_,WF) :- !, init_wait_flags(WF). % comment in to disable tracking quantifiers |
| 1234 | | % makes a difference for memoize test 1968 with recursive calls |
| 1235 | | init_wait_flags_and_push_call_stack(OuterWF,CallStackTerm,WF) :- |
| 1236 | | get_call_stack(OuterWF,OuterCallStack), |
| 1237 | | %print(init_quantifier(QuantKind,Paras,OuterCallStack)),nl, |
| 1238 | | CallStack = [CallStackTerm|OuterCallStack], |
| 1239 | | get_wf_all_dynamic_infos(OuterWF,DynInfos), |
| 1240 | | init_wait_flags_with_sd_infos(WF,[call_stack(CallStack)],DynInfos). |
| 1241 | | %portray_call_stack(WF). |
| 1242 | | |
| 1243 | | init_wait_flags_with_call_stack(WF,CallStack) :- |
| 1244 | | init_wait_flags_with_infos(WF,[call_stack(CallStack)]). |
| 1245 | | |
| 1246 | | % -------------- |
| 1247 | | |
| 1248 | | :- if((environ(prob_safe_mode,true) ; environ(prob_src_profile,true) ; environ(prob_profile,true))). |
| 1249 | | % TODO: should this be controlled also by prob_profiling_on preference |
| 1250 | | add_debug_wait_flag_info(Infos,Info,NewInfos) :- ord_add_element(Infos,Info,NewInfos). |
| 1251 | | init_debug_wait_flag_info([],Infos) :- !, Infos=[]. |
| 1252 | | init_debug_wait_flag_info([H|T],Infos) :- !, Infos=[H|T]. |
| 1253 | | init_debug_wait_flag_info(Info,[Info]). |
| 1254 | | :- else. |
| 1255 | | add_debug_wait_flag_info(Infos,_,Infos). |
| 1256 | | init_debug_wait_flag_info(_,[]). |
| 1257 | | :- endif. |
| 1258 | | % ------------------------ |
| 1259 | | |
| 1260 | | % BINARY CHOICE WAITFLAGS |
| 1261 | | |
| 1262 | | :- use_module(tools,[max_tagged_pow2/1]). |
| 1263 | | % last power of 2 exponent that is still a finite priority |
| 1264 | | last_finite_pow2_prio_exponent(Lim) :- max_tagged_pow2(Pow), |
| 1265 | | Lim is Pow-1. % stay below last_finite_priority, i.e., max_tagged_integer-1024 |
| 1266 | | |
| 1267 | | % utility to get power of two priority: |
| 1268 | | get_pow2_binary_choice_priority(Exp,Prio) :- last_finite_pow2_prio_exponent(Lim), |
| 1269 | | (Exp =< Lim -> Prio is floor(2**Exp) |
| 1270 | | ; Prio is floor(2**Lim)). |
| 1271 | | |
| 1272 | | % get a binary choice wait flag, start with 2 but for every further call double the priority (exponential backoff) |
| 1273 | | % idea: give priority to data enumerations when too many choice points arise |
| 1274 | | % TO DO: when triggering: keep the WF info with an empty trigger or store in separate info field |
| 1275 | | get_binary_choice_wait_flag_exp_backoff(Info,WFX,WF2) :- |
| 1276 | | get_binary_choice_wait_flag_exp_backoff(2,Info,WFX,WF2). |
| 1277 | | get_binary_choice_wait_flag_exp_backoff(_,_Info,no_wf_available,WF2) :- !, WF2=2. |
| 1278 | | |
| 1279 | | % StartPrio should normally be a power of 2: |
| 1280 | | get_binary_choice_wait_flag_exp_backoff(MinPrio,Info,wfx(WF0,Store,WFE,_II),WF2) :- |
| 1281 | | (nonvar(WFE) -> add_message(kernel_waitflags,'Getting waitflag from grounded store: ',Info), |
| 1282 | | % probably a good idea to use clone_wait_flags_from1 if this happens |
| 1283 | | WF2=WF0 % use at least WF0 for WF2, maybe it is still being enumerated |
| 1284 | | ; my_get_wf_store_att(Store,Heap), |
| 1285 | | large_finite_priority(Lim), % avoid creating too big numbers and stay in finite area |
| 1286 | | (MinPrio < 1 -> StartPrio=1 ; StartPrio=MinPrio), |
| 1287 | | get_bin_aux(StartPrio,Lim,Info,Heap,NewHeap,WF2), |
| 1288 | | put_mutable_wf_store_attr(Store,NewHeap) |
| 1289 | | ). |
| 1290 | | |
| 1291 | | % to do : maybe store attribute of current exponential ?? |
| 1292 | | get_bin_aux(Prio,Lim,Info,Heap,NewHeap,WF2) :- |
| 1293 | | avl_fetch(Prio,Heap,wf(WFs,OldInfo)), |
| 1294 | | !, |
| 1295 | | (%Prio >= Lim -> pop_waitflag(WFs,WF2,_), % should we get last waitflag or simply push |
| 1296 | | % NewHeap=Heap ; /* for large finite priorities single waitflag stored */ |
| 1297 | | Prio<Lim, OldInfo = '$binary'(_) |
| 1298 | | -> double_prio(Prio,P2), get_bin_aux(P2,Lim,Info,Heap,NewHeap,WF2) |
| 1299 | | ; push_waitflag(WFs,WF2,WFs2), |
| 1300 | | avl_store(Prio,Heap,wf(WFs2,'$binary'(Info)),NewHeap) % just update Info; so that next time we double |
| 1301 | | ). |
| 1302 | | get_bin_aux(Prio,_,Info,Heap,NewHeap,WF2) :- % we have found an unused power of 2 |
| 1303 | | avl_store(Prio,Heap,wf(WF2,'$binary'(Info)),NewHeap). |
| 1304 | | |
| 1305 | | % ------------------------ |
| 1306 | | |
| 1307 | | get_enumeration_finished_wait_flag(wfx(_,_,WFE,_),Res) :- !,Res=WFE. |
| 1308 | | get_enumeration_finished_wait_flag(no_wf_available,WFE) :- !,WFE=1. |
| 1309 | | get_enumeration_finished_wait_flag(W,E) :- |
| 1310 | | add_internal_error('Waitflags in wrong format: ',get_enumeration_finished_wait_flag(W,E)). |
| 1311 | | |
| 1312 | | |
| 1313 | | ground_det_wait_flag(wfx(WF0,Store,_,WFInfos)) :- !, %% print(ground_det_wait_flag),nl, |
| 1314 | ? | grd_wf0(WF0), |
| 1315 | | deref_store(Store,DStore), |
| 1316 | | init_wf_infos_for_grounding(WFInfos,WFInfos2), |
| 1317 | | ground_waitflags_store_up_to_no_clpfd(1,DStore,WFInfos2). % no CLPFD labeling required for prio until 1 |
| 1318 | | ground_det_wait_flag(no_wf_available) :- !. |
| 1319 | | ground_det_wait_flag(W) :- |
| 1320 | | add_internal_error('Waitflags in wrong format: ',ground_det_wait_flag(W)). |
| 1321 | | |
| 1322 | | ground_wait_flag_to(wfx(WF0,Store,_,WFInfos),Limit) :- !,%% print(ground_det_wait_flag),nl, |
| 1323 | | grd_wf0(WF0), |
| 1324 | | deref_store(Store,DStore), |
| 1325 | | init_wf_infos_for_grounding(WFInfos,WFInfos2), |
| 1326 | ? | ground_waitflags_store_clpfd_up_to(Limit,DStore,WFInfos2). |
| 1327 | | ground_wait_flag_to(no_wf_available,_) :- !. |
| 1328 | | ground_wait_flag_to(W,Limit) :- |
| 1329 | | add_internal_error('Waitflags in wrong format: ',ground_wait_flag_to(W,Limit)). |
| 1330 | | |
| 1331 | | useless_wait_flag(treat_next_integer(_VarID,Val,Rest)) :- Rest==[], |
| 1332 | | kernel_tools:ground_value(Val). |
| 1333 | | useless_wait_flag(tighter_enum(_VarID,Val,_Type)) :- %ground(Val). |
| 1334 | | kernel_tools:ground_value(Val). |
| 1335 | | %nonvar(Val), quick_ground(Val). |
| 1336 | | %quick_ground(int(N)) :- integer(N). |
| 1337 | | %quick_ground(string(S)) :- atom(S). |
| 1338 | | |
| 1339 | | % show which waitflags are actually useless |
| 1340 | | % TODO: think about pruning the WF store; e.g., when calling deref_store ?? |
| 1341 | | :- public portray_useless_waitflags_in_store/1. |
| 1342 | | portray_useless_waitflags_in_store(Store) :- |
| 1343 | | my_get_wf_store_att(Store,Heap), |
| 1344 | | avl_member(AMin,Heap,wf(_,Info)), |
| 1345 | | useless_wait_flag(Info), |
| 1346 | | format(' useless waitflag ~w --> ~w~n',[AMin,Info]), |
| 1347 | | fail. |
| 1348 | | portray_useless_waitflags_in_store(_). |
| 1349 | | |
| 1350 | | |
| 1351 | | |
| 1352 | | ground_waitflags_store_up_to_no_clpfd(Prio,Store,WFInfos) :- % print(prio(Prio)),nl, |
| 1353 | | my_get_wf_store_att(Store,Heap), % portray_waitflags_store(Store), % |
| 1354 | | ( avl_min(Heap,Min,_) -> % heap is non-empty, first element is WF with priority Min |
| 1355 | | ( Min =< Prio -> % we have non-ground waitflags with a matching priority |
| 1356 | | (avl_del_min_waitflag(Heap,AMin,wf(WFMin,Info),NewHeap),AMin==Min % remove the first element |
| 1357 | | -> true |
| 1358 | | ; add_internal_error('Could not remove min. in ground_waitflags_store_up_to_no_clpfd: ',Min:Info:Heap), fail |
| 1359 | | ), |
| 1360 | | put_mutable_wf_store_attr(Store,NewHeap), % write the modified heap back |
| 1361 | | %% print(grounding2(Prio,_Info)),nl, %% |
| 1362 | | ground_prio(Min,WFMin,Info,WFInfos), |
| 1363 | | ground_waitflags_store_up_to_no_clpfd(Prio,Store,WFInfos) % continue recursively |
| 1364 | | ; % no more matching waitflags present |
| 1365 | | true) % stop here |
| 1366 | | ; % heap is empty, nothing more to do |
| 1367 | | true). % stop here |
| 1368 | | |
| 1369 | | ground_waitflags_store_clpfd_up_to(Limit,Store,WFInfos) :- |
| 1370 | | my_get_wf_store_fdvars_atts(Store,Heap,FDVars), |
| 1371 | | !, |
| 1372 | | ( avl_del_min_waitflag(Heap,Prio,wf(WFMin,Info),NewHeap), |
| 1373 | | Prio =< Limit |
| 1374 | | -> % we have non-ground waitflags with a matching priority |
| 1375 | | ( my_get_next_fdvar_to_enumerate(FDVars,NextFDVar,RemainingFDVARS), |
| 1376 | | fd_priority_leq_limit(NextFDVar,FDPrio,Limit) |
| 1377 | | -> (FDPrio > Limit -> true |
| 1378 | ? | ; enum_fd_variable_store(FDPrio,Store,NextFDVar,RemainingFDVARS,WFInfos)) |
| 1379 | | ; put_mutable_wf_store_attr(Store,NewHeap), % write the modified heap back |
| 1380 | ? | ground_prio(Prio,WFMin,Info,WFInfos), % ground waitflag |
| 1381 | ? | ground_waitflags_store_clpfd_up_to(Limit,Store,WFInfos) % continue recursively |
| 1382 | | ) |
| 1383 | | ; % no pending waitflag |
| 1384 | | my_get_next_fdvar_to_enumerate(FDVars,NextFDVar,RemainingFDVARS), |
| 1385 | | fd_priority_leq_limit(NextFDVar,FDPrio,Limit) |
| 1386 | | -> enum_fd_variable_store(FDPrio,Store,NextFDVar,RemainingFDVARS,WFInfos) |
| 1387 | | ; true % heap and FDVars list is empty, nothing more to do |
| 1388 | | ). |
| 1389 | | ground_waitflags_store_clpfd_up_to(Limit,Store,WFInfos) :- |
| 1390 | | add_internal_error('Illegal Waitflag: ',ground_waitflags_store_clpfd_up_to(Limit,Store,WFInfos)),fail. |
| 1391 | | |
| 1392 | | % -------------------- |
| 1393 | | |
| 1394 | | :- assert_must_succeed(( kernel_waitflags:init_wait_flags(WF), |
| 1395 | | kernel_waitflags:get_wait_flag(10001,test1,WF,WF1), |
| 1396 | | kernel_waitflags:get_wait_flag(10001,test2,WF,WF2), |
| 1397 | | check_eq(WF,wfx(_,Store,_,_)), |
| 1398 | | kernel_waitflags:my_get_wf_store_fdvars_atts(Store,Heap,_FDVars), |
| 1399 | | kernel_waitflags:avl_del_min_waitflag(Heap,Prio1,wf(WFMin1,_Info1),Heap2), |
| 1400 | | check_eqeq(Prio1,10001), check_eqeq(WFMin1,WF1), |
| 1401 | | kernel_waitflags:avl_del_min_waitflag(Heap2,Prio2,wf(WFMin2,_Info2),_), |
| 1402 | | check_eqeq(Prio2,10001), check_eqeq(WFMin2,WF2) |
| 1403 | | )). |
| 1404 | | |
| 1405 | | % a conditional version of avl_del_min: where we either delete or update the minimal element |
| 1406 | | |
| 1407 | | :- if(current_prolog_flag(dialect, swi)). |
| 1408 | | avl_del_min_waitflag(AVL0, Key, wf(NextWF,Info), AVL) :- |
| 1409 | | avl_del_min(AVL0,Key,Val0,AVL1), |
| 1410 | | Val0 = wf(WFMin,Info), |
| 1411 | | pop_waitflag(WFMin,NextWF,RemainingWFMin), |
| 1412 | | (RemainingWFMin==[] -> AVL=AVL1 |
| 1413 | | ; avl_store(Key,AVL1,wf(RemainingWFMin,Info),AVL) |
| 1414 | | ). |
| 1415 | | |
| 1416 | | :- else. |
| 1417 | | % optimized code to delete and update in one traversal; requires access to inner predicates of library(avl) |
| 1418 | | |
| 1419 | | avl_del_min_waitflag(AVL0, Key, Val, AVL) :- |
| 1420 | | avl_del_min_wf_aux(AVL0, Key, Val, AVL, _). |
| 1421 | | |
| 1422 | | avl_del_min_wf_aux(node(K,V,B,L,R), Key, Val, AVL, Delta) :- |
| 1423 | | ( L == empty -> |
| 1424 | | Key = K, |
| 1425 | | V = wf(WFMin,Info), |
| 1426 | | pop_waitflag(WFMin,NextWF,RemainingWFMin), |
| 1427 | | Val = wf(NextWF,Info), |
| 1428 | | (RemainingWFMin==[] -> % single waitflag |
| 1429 | | %print(single_wf(Key,WFMin,Info)),nl, |
| 1430 | | AVL = R, Delta=1 % we delete the minimal element |
| 1431 | | ; % there are multiple waitflags for the same priority |
| 1432 | | % print(multiple_wf(Key,WFMin,Info)),nl, |
| 1433 | | AVL = node(K,wf(RemainingWFMin,Info),B,L,R), % update AVL with remaining waitflags |
| 1434 | | Delta = 0 % we do not delete the node, but update it |
| 1435 | | ) |
| 1436 | | ; avl_del_min_wf_aux(L, Key, Val, L1, D1), |
| 1437 | | B1 is B+D1, |
| 1438 | | avl:avl(B1, K, V, L1, R, AVL), |
| 1439 | | avl:avl_shrinkage(AVL, D1, Delta) |
| 1440 | | ). |
| 1441 | | |
| 1442 | | :- endif. |
| 1443 | | |
| 1444 | | % ------------------- |
| 1445 | | |
| 1446 | | update_waitflag(Prio,CurrentWaitflag,NewWaitFlag,WF) :- |
| 1447 | | /* if the CurrentWaitflag is already ground and now a new WF with lower priority has been added to the store: |
| 1448 | | create a new non-ground waitflag to give priority to new WF with lower priority value */ |
| 1449 | | (var(CurrentWaitflag) -> NewWaitFlag=CurrentWaitflag |
| 1450 | | ; WF=wfx(_WF0,Store,_,_),my_get_wf_store_att(Store,Heap), |
| 1451 | | (avl_min(Heap,Min,wf(_NewerWF,_Info)), |
| 1452 | | (is_inf_or_overflow_card(Prio) ; Min<Prio) |
| 1453 | | -> get_waitflag_from_store(Prio,updated_wf,Store,NewWaitFlag) % could be optimized |
| 1454 | | % ,print(updating_wf(Prio,CurrentWaitflag,NewWaitFlag,Min)),nl |
| 1455 | | ; fdvar_with_higher_prio_exists(Store,Prio) -> get_waitflag_from_store(Prio,updated_wf,Store,NewWaitFlag) |
| 1456 | | ; NewWaitFlag=CurrentWaitflag |
| 1457 | | ) |
| 1458 | | ). |
| 1459 | | |
| 1460 | | fdvar_with_higher_prio_exists(Store,Limit) :- |
| 1461 | | my_get_fdvars_att(Store,FDVars), |
| 1462 | | my_get_next_fdvar_to_enumerate(FDVars,NextFDVar,_), |
| 1463 | | fd_priority_leq_limit(NextFDVar,_,Limit). |
| 1464 | | |
| 1465 | | % get the minimum waitflag, if it exists |
| 1466 | | get_minimum_waitflag_prio(wfx(WF0,Store,_,_),MinPrio,Info) :- |
| 1467 | | (var(WF0) -> MinPrio=0, Info=wf0 |
| 1468 | | ; WF0=s(WF00), var(WF00) -> MinPrio = 1, Info=wf0_nonvar |
| 1469 | | ; my_get_wf_store_att(Store,Heap), |
| 1470 | | avl_min(Heap,MinPrio,wf(_LWF,Info))). |
| 1471 | | |
| 1472 | | |
| 1473 | | add_wd_error(Msg,Term,WF) :- |
| 1474 | | try_extract_span(Term,Span), % try extract span if possible; |
| 1475 | | % e.g., for {x|x>10 } = res & card(res)=10 we have a closure/3 as Term |
| 1476 | | add_wd_error_span(Msg,Term,Span,WF). |
| 1477 | | |
| 1478 | | try_extract_span(closure(_,_,B),Span) :- !, Span=B. |
| 1479 | | try_extract_span(b(_,_,Infos),Span) :- !, Span=Infos. |
| 1480 | | try_extract_span(_,unknown). |
| 1481 | | |
| 1482 | | add_wd_error_set_result(Msg,Term,Result,ResultValue,Span,WF) :- |
| 1483 | | is_wd_guarded_result(Result), % just dummy co-routine to detect variables which have WD assignments pending on them; should not be enumerated |
| 1484 | | % add well-definedness error but also set Result Variable to ResultValue to trigger pending co-routines if wd_guarded |
| 1485 | | add_abort_error7(well_definedness_error,Msg,Term,Result,ResultValue,Span,WF). |
| 1486 | | |
| 1487 | | add_wd_error_span(Msg,Term,Span,WF) :- |
| 1488 | | add_abort_error_span(well_definedness_error,Msg,Term,Span,WF). |
| 1489 | | % the same but adding a WD error directly, without any delay: |
| 1490 | | add_wd_error_span_now(Msg,Term,Span,WF) :- |
| 1491 | | add_abort_error2(true,well_definedness_error,Msg,Term,0,0,Span,WF). |
| 1492 | | |
| 1493 | | :- block is_wd_guarded_result(-). |
| 1494 | | is_wd_guarded_result(_). |
| 1495 | | |
| 1496 | | add_abort_error_span(ErrType,Msg,Term,Span,WF) :- add_abort_error7(ErrType,Msg,Term,0,0,Span,WF). |
| 1497 | | |
| 1498 | | |
| 1499 | | :- use_module(probsrc(debug), [debug_mode/1]). |
| 1500 | | add_abort_error7(_ErrType,_Msg,_Term,_Result,_ResultValue,_Span,_WF) :- |
| 1501 | | preference(disprover_mode,true), |
| 1502 | | !, % When Disproving we can assume well-definedness of the PO; sometimes the relevant hypotheses will be filtered out |
| 1503 | | fail. |
| 1504 | | add_abort_error7(ErrType,Msg,Term,Result,ResultValue,Span,WF) :- |
| 1505 | | preference(raise_abort_immediately,F), F \= false, |
| 1506 | | !, |
| 1507 | | (F=full -> AWF=1 % really raise immediately; may entail more spurious messages, particularly in WF0 |
| 1508 | | ; get_idle_wait_flag(add_abort_error7,WF,AWF), %get_wait_flag0(WF,AWF), |
| 1509 | | (var(AWF),debug_mode(on) -> |
| 1510 | | (pending_abort_error(WF) |
| 1511 | | -> format(user_output,'Additional WD Error pending:~n',[]) % TODO: no use in calling add_abort_error2 below |
| 1512 | | ; true), |
| 1513 | | add_message(wd_error_pending,Msg,Term,Span) |
| 1514 | | ; true), |
| 1515 | | mark_pending_abort_error(WF,Msg,Term,Span) |
| 1516 | | ), |
| 1517 | | %when(nonvar(AWF), |
| 1518 | | |
| 1519 | | %(tools_printing:print_error('Raising error immediately without checking rest of predicate for unsatisfiability (because RAISE_ABORT_IMMEDIATELY set to TRUE): error could be spurious!'),true)), |
| 1520 | | string_concatenate('Raising error immediately without checking rest of predicate for unsatisfiability (because RAISE_ABORT_IMMEDIATELY set to TRUE or full): error could be spurious!\n! ',Msg,NewMsg), |
| 1521 | | add_abort_error2(AWF,ErrType,NewMsg,Term,Result,ResultValue,Span,WF). |
| 1522 | | add_abort_error7(ErrType,Msg,Term,Result,ResultValue,Span,WF) :- |
| 1523 | | %add_message_wf(add_abort_error,'Possible WD Error: ',Term,Span,WF), % happens a lot in test 1886 |
| 1524 | | mark_pending_abort_error(WF), |
| 1525 | | get_enumeration_finished_wait_flag(WF,AWF), % infinite enumeration will never result in failure ? and thus never discard a WD error ? --> better to activate WD/abort error earlier, but the following does not fully work: |
| 1526 | | %integer_priority(P), get_wait_flag(P,add_abort_error7,WF,AWF), % causes problem for test 1122 |
| 1527 | | add_abort_error2(AWF,ErrType,Msg,Term,Result,ResultValue,Span,WF). |
| 1528 | | |
| 1529 | | |
| 1530 | | :- use_module(error_manager,[add_new_event_in_error_scope/1]). |
| 1531 | | :- use_module(state_space, |
| 1532 | | [store_abort_error_for_context_state_if_possible/4]). |
| 1533 | | :- block add_abort_error2(-,?,?,?,?,?,?,?). |
| 1534 | | add_abort_error2(wd_guarded,_Err,_Msg,_Term,Result,ResultValue,_Span,_WF) :- !,% ignoring error message; no-wd problem |
| 1535 | | % set Result to default ResultValue; useful to get rid of pending co-routines; result will not be used |
| 1536 | | (Result=ResultValue -> true ; print(add_abort_error_failure(Result,ResultValue)),nl). |
| 1537 | | add_abort_error2(_AWF,ErrType,Msg,Term,_,_,Span,WF) :- |
| 1538 | | add_call_stack_to_span(Span,WF,Span2), |
| 1539 | | (register_abort_errors_in_error_scope(Level) |
| 1540 | | -> (get_preference(provide_trace_information,false) |
| 1541 | | -> format('Registering WD Error in error scope (~w): ~w~n',[Level,Msg]) |
| 1542 | | ; add_message_wf(wd_error,'Registering WD Error in error scope: ',Msg,Span,WF) |
| 1543 | | ), |
| 1544 | | assert(pending_inner_abort_error(Level,ErrType,Msg,Term,Span2)) |
| 1545 | | % ,trace,write(level(Level,ErrType)),nl,get_enumeration_finished_wait_flag(WF,WFE), when(nonvar(WFE),(write(abewf(Level,Msg)),nl,trace)) |
| 1546 | | % add_new_event_in_error_scope(abort_error(ErrType)) % do not register as error yet; we will copy it to the outer WF |
| 1547 | | ; store_abort_error_for_context_state_if_possible(ErrType,Msg,Term,Span2) |
| 1548 | | -> true |
| 1549 | | ; add_error(add_abort_error2,'Could not store error: ',(Msg,Term),Span2)), |
| 1550 | | % TODO: think about: throw(enumeration_warning('WD ERROR',ErrType,'','',throwing)), % TODO: throw and recognise as special error and treat e.g., in Keeping comprehension-set symbolic messages |
| 1551 | | fail. |
| 1552 | | |
| 1553 | | :- dynamic register_abort_errors_in_error_scope/0, pending_inner_abort_error/5. |
| 1554 | | |
| 1555 | | |
| 1556 | | :- use_module(eventhandling,[register_event_listener/3]). |
| 1557 | | :- register_event_listener(clear_specification,reset_waitflags, 'Reset kernel_waitflags.'). |
| 1558 | | |
| 1559 | | reset_waitflags :- |
| 1560 | | retractall(register_abort_errors_in_error_scope), |
| 1561 | | retractall(pending_inner_abort_error(_,_,_,_,_)), |
| 1562 | | bb_put(wf_findall_nesting_level,0). |
| 1563 | | |
| 1564 | | % clear pending inner abort errors |
| 1565 | | % there is still a potential issue if a time-out appears just in the middle |
| 1566 | | start_attach_inner_abort_errors(NewLevel) :- |
| 1567 | | (bb_get(wf_findall_nesting_level,L) -> Level=L ; Level=0), |
| 1568 | | NewLevel is Level+1, |
| 1569 | | bb_put(wf_findall_nesting_level,NewLevel), |
| 1570 | | retractall(pending_inner_abort_error(NewLevel,_,_,_,_)). |
| 1571 | | |
| 1572 | | % succeeds when abort errors should be asserted for later copying (at the end of a findall) to the outer WF |
| 1573 | | register_abort_errors_in_error_scope(Level) :- |
| 1574 | | register_abort_errors_in_error_scope, |
| 1575 | | get_wf_findall_nesting_level(Level). |
| 1576 | | |
| 1577 | | get_wf_findall_nesting_level(L) :- |
| 1578 | | (bb_get(wf_findall_nesting_level,L) -> Level=L |
| 1579 | | ; write(missing_wf_findall_nesting_level),nl, Level=0). |
| 1580 | | |
| 1581 | | % extract all pending inner abort errors and attach them to the outer WF store |
| 1582 | | % should be called after ground_inner_wait_flags_in_context |
| 1583 | | re_attach_pending_inner_abort_errors(Level,OuterWF) :- |
| 1584 | | get_wf_findall_nesting_level(L), |
| 1585 | | (Level=L -> true |
| 1586 | | ; write(unexpected_wf_findall_nesting(L,expected(Level))),nl |
| 1587 | | % could happen if a time-out occured in middle of updating wf_findall_nesting_level info |
| 1588 | | ), |
| 1589 | | LL1 is Level-1, bb_put(wf_findall_nesting_level,LL1), |
| 1590 | | findall(pending(ErrType,Msg,Term,Span), |
| 1591 | | retract(pending_inner_abort_error(Level,ErrType,Msg,Term,Span)), PendingList), |
| 1592 | | maplist(re_add_pending_aux(OuterWF),PendingList). |
| 1593 | | |
| 1594 | | re_add_pending_aux(WF,pending(ErrType,Msg,Term,Span)) :- |
| 1595 | | format('Reattaching error ~w in outer WF~n',[ErrType]), |
| 1596 | | add_abort_error_span(ErrType,Msg,Term,Span,WF). |
| 1597 | | |
| 1598 | | |
| 1599 | | % add abort / state error directly (now), but do not fail unlike add_wd_error_span_now |
| 1600 | | add_state_error_wf(ErrType,Msg,Term,Span,WF) :- |
| 1601 | | add_call_stack_to_span(Span,WF,Span2), |
| 1602 | | (store_abort_error_for_context_state_if_possible(ErrType,Msg,Term,Span2) -> true |
| 1603 | | ; add_error_wf(ErrType,Msg,Term,Span2,WF) |
| 1604 | | ). |
| 1605 | | |
| 1606 | | |
| 1607 | | % ground enumeration finished waitflag unless abort is pending |
| 1608 | | % useful inside of exists, ... to complete all pending co-routines |
| 1609 | | ground_ef_wait_flag_unless_abort_pending(wfx(_WF0,_WFX,WFE,_)) :- |
| 1610 | | var(WFE), %print(check_abort_pending(_WF0,_WFX,WFE)),nl, |
| 1611 | | is_not_wf_abort_pending(WFE), |
| 1612 | | !, %print(grd_ef(WFE)),nl, |
| 1613 | | grd_ef(WFE). |
| 1614 | | ground_ef_wait_flag_unless_abort_pending(_). |
| 1615 | | |
| 1616 | | % special grounding of inner waitflags taking context (all_solutions, positive, negative) into account |
| 1617 | | % one should call re_attach_pending_inner_abort_errors on the OuterWF after the forall/negation |
| 1618 | | % in order to retract pending_inner_abort_error and re-attach the WD errors to the OuterWF |
| 1619 | | ground_inner_wait_flags_in_context(all_solutions,WF) :- |
| 1620 | | WF = wfx(_WF0,_WFX,WFE,_),!, |
| 1621 | ? | ground_constraintprop_wait_flags(WF), |
| 1622 | | (var(WFE), |
| 1623 | | is_wf_abort_pending(WFE) |
| 1624 | | -> !, % cut, we have found a WD error, whole findall result is useless anyway; cut |
| 1625 | | % happens in tests 629, 1921, 1966, 2224 |
| 1626 | | debug_format(19,'WD Error(s) pending, could be spurious ~n',[]), |
| 1627 | | assert(register_abort_errors_in_error_scope), |
| 1628 | | call_cleanup(grd_ef(WFE), % will not raise WD errors but store them for OuterWF |
| 1629 | | retract(register_abort_errors_in_error_scope)) |
| 1630 | | ; grd_ef(WFE) |
| 1631 | | ). |
| 1632 | | ground_inner_wait_flags_in_context(negative,WF) :- |
| 1633 | ? | ground_inner_wait_flags_in_context(all_solutions,WF). |
| 1634 | | ground_inner_wait_flags_in_context(_,WF) :- |
| 1635 | | ground_wait_flags(WF). % TODO: do not ground WFE, ensure it is shared; |
| 1636 | | % but currently positive context only used in external funs with wf_not_available |
| 1637 | | |
| 1638 | | |
| 1639 | | % try and get a user-readable description of the context in which the WF store was created |
| 1640 | | get_wait_flags_context_msg(wfx(_WF0,_WFX,_WFE,Infos),Msg) :- |
| 1641 | | member(Info,Infos), |
| 1642 | | get_info_context_description(Info,Msg). |
| 1643 | | |
| 1644 | | :- use_module(bsyntaxtree, [get_texpr_ids/2]). |
| 1645 | | get_info_context_description(call_stack(CS),Msg) :- translate_call_stack(CS,Msg). |
| 1646 | | % TODO: do we need expansion_context anymore? |
| 1647 | | get_info_context_description(expansion_context(Type,Parameters),Msg) :- |
| 1648 | | (Parameters=[b(identifier(_),_,_)|_] |
| 1649 | | -> get_texpr_ids(Parameters,Ids), |
| 1650 | | get_msg_aux(Type,Ids,Parameters,Msg) |
| 1651 | | ; get_msg_aux(Type,Parameters,[],Msg) |
| 1652 | | ). |
| 1653 | | get_info_context_description(expansion_context_with_pos(Type,Parameters,Info),Msg) :- |
| 1654 | | get_msg_aux(Type,Parameters,Info,Msg). |
| 1655 | | % also deal with : check_element_of_function_closure_nowf(MemoID) |
| 1656 | | |
| 1657 | | get_msg_aux(Type,Parameters,Info,Msg) :- |
| 1658 | | extract_span_description(Info,PosMsg),!, % we could do this only if preference trace_info set ? |
| 1659 | | ajoin_with_sep(['expanding', Type, 'at', PosMsg, 'over ids'|Parameters],' ',Msg). |
| 1660 | | get_msg_aux(Type,[],_Info,Msg) :- !, |
| 1661 | | ajoin(['expanding ', Type],Msg). |
| 1662 | | get_msg_aux(Type,Parameters,_Info,Msg) :- |
| 1663 | | ajoin_with_sep(['expanding', Type, 'over ids'|Parameters],' ',Msg). |
| 1664 | | |
| 1665 | | |
| 1666 | | % check whether an abort error is pending. |
| 1667 | | pending_abort_error(wfx(_WF0,_WFX,WFE,_)) :- var(WFE), |
| 1668 | | is_wf_abort_pending(WFE). %print(got_abort_pending),nl. |
| 1669 | | % succeed once for every pending abort error in Waitflag store |
| 1670 | | pending_abort_error(wfx(_WF0,_WFX,WFE,_),Msg,Term,Span) :- var(WFE), |
| 1671 | | is_wf_abort_pending(WFE), |
| 1672 | | frozen(WFE,Goal), %print(goal(Goal)),nl, |
| 1673 | | pending_abort_error_aux(Goal,Msg,Term,Span). |
| 1674 | | |
| 1675 | | pending_abort_error_aux(kernel_waitflags:add_abort_error2(_,_ErrType,Msg,Term,_Result,_ResultValue,Span,_), Msg,Term,Span). |
| 1676 | | pending_abort_error_aux(add_abort_error2(_,_ErrType,Msg,Term,_Result,_ResultValue,Span,_), Msg,Term,Span). |
| 1677 | | pending_abort_error_aux(kernel_waitflags:mark_pending_abort_error2(_,Msg,Term,Span), Msg,Term,Span). |
| 1678 | | pending_abort_error_aux((A,B),Msg,Term,Span) :- |
| 1679 | | (pending_abort_error_aux(A,Msg,Term,Span) ; |
| 1680 | | pending_abort_error_aux(B,Msg,Term,Span) ). |
| 1681 | | |
| 1682 | | % explicitly mark that an abort error is pending |
| 1683 | | mark_pending_abort_error(wfx(_WF0,_WFX,WFE,_)) :- !, % print(mark_abort_pending(_WFX)),nl, |
| 1684 | | (var(WFE) -> put_wf_abort_pending(WFE) |
| 1685 | | ; true). |
| 1686 | | mark_pending_abort_error(no_wf_available). |
| 1687 | | |
| 1688 | | % explicitly mark that an abort error is pending with storing information |
| 1689 | | mark_pending_abort_error(wfx(_WF0,_WFX,WFE,_),Msg,Term,Span) :- |
| 1690 | | (var(WFE) -> put_wf_abort_pending(WFE), |
| 1691 | | mark_pending_abort_error2(WFE,Msg,Term,Span) |
| 1692 | | ; true). |
| 1693 | | mark_pending_abort_error(no_wf_available,_Msg,_Term,_Span). |
| 1694 | | |
| 1695 | | :- block mark_pending_abort_error2(-,?,?,?). |
| 1696 | | mark_pending_abort_error2(_,_,_,_). |
| 1697 | | % --------------------------------------------- |
| 1698 | | |
| 1699 | | |
| 1700 | | get_large_finite_wait_flag(Info,WFX,WF2) :- |
| 1701 | | large_finite_priority(P), |
| 1702 | | get_wait_flag(P,Info,WFX,WF2). |
| 1703 | | |
| 1704 | | get_enumeration_starting_wait_flag(Info,WFX,WF2) :- |
| 1705 | | last_finite_priority(P), |
| 1706 | | get_wait_flag(P,enumeration_starting(Info),WFX,WF2). |
| 1707 | | %get_enumeration_almost_finished_wait_flag(Info,WFX,WF2) :- |
| 1708 | | % tools:max_tagged_integer(P), % largest tagged value |
| 1709 | | % get_wait_flag(P,enumeration_starting(Info),WFX,WF2). |
| 1710 | | |
| 1711 | | |
| 1712 | | get_integer_enumeration_wait_flag(Info,WFX,WF2) :- |
| 1713 | | integer_priority(Prio), |
| 1714 | | get_wait_flag(Prio,Info,WFX,WF2). |
| 1715 | | |
| 1716 | | % A few hardcoded priorities |
| 1717 | | large_finite_priority(P) :- integer_priority(I), P is I-1000. |
| 1718 | | last_finite_priority(P) :- integer_priority(I), P is I-2. % Note: enumerate_integer_with_min_range_wf did set its priority to I-1 |
| 1719 | | %integer_priority(10000000). % old value |
| 1720 | | integer_priority(Prio) :- % priority for X : INTEGER enumerations |
| 1721 | | tools:max_tagged_integer(P), |
| 1722 | | Prio is P - 1024. |
| 1723 | | % note inf_type_prio sets some priorities such as seq(INTEGER) ... higher |
| 1724 | | |
| 1725 | | % priority for sets of infinite type (POW(INTEGER)...) |
| 1726 | | integer_pow2_priority(Prio) :- % was 10000010 |
| 1727 | | integer_priority(P), Prio is P+10. |
| 1728 | | |
| 1729 | | last_priority(P) :- % was 10000010 |
| 1730 | | tools:max_tagged_integer(P). |
| 1731 | | |
| 1732 | | % ensure that we do not exceed priority of type enumeration or use too big numbers |
| 1733 | | get_bounded_wait_flag(Prio,Info,WF,LWF) :- |
| 1734 | | get_bounded_priority(Prio,P), |
| 1735 | | get_wait_flag(P,Info,WF,LWF). |
| 1736 | | |
| 1737 | | get_bounded_priority(Prio,P) :- number(Prio), |
| 1738 | | Prio>268435452, % 268435455 is max_tagged_integer on 32 bit platforms |
| 1739 | | last_finite_priority(MAX), |
| 1740 | | Prio>MAX, |
| 1741 | | !, P=MAX. |
| 1742 | | get_bounded_priority(P,P). |
| 1743 | | |
| 1744 | | % ------------- |
| 1745 | | |
| 1746 | | % copy waitflags from one waitflag store to another; warning: can ground WF0 from outer store |
| 1747 | | % the assumption is that the outer store will be grounded/enumerated |
| 1748 | | % the inner store 1 will now point to the outer store 2 in case some co-routines still add waitflags |
| 1749 | | copy_waitflag_store(wfx(WF0,Store1,WFE1,_),wfx(WF0,Store2,WFE2,_Info2)) :- |
| 1750 | | %print(copy_wf(WF0,Store1,Store2,WFE1,WFE2)),nl, |
| 1751 | | my_get_wf_store_fdvars_atts(Store1,Heap,FDList1), |
| 1752 | | (FDList1 = [] -> true |
| 1753 | | ; my_get_fdvars_att(Store2,FDList2), |
| 1754 | | %append(FDList1,FDList2,NewFDList), % used to be like this |
| 1755 | | append_wf(FDList2,FDList1,NewFDList), % now we add inner FD variables to end |
| 1756 | | put_mutable_wf_fdvars_attr(Store2,NewFDList) |
| 1757 | | ), |
| 1758 | | avl_to_list(Heap,WF_List), |
| 1759 | | %print(copying(FDList1,WF_List)),nl, |
| 1760 | | my_get_wf_store_att(Store2,Heap2), |
| 1761 | | add_wf(WF_List,Heap2,NewHeap2), |
| 1762 | | put_mutable_wf_store_attr(Store2,NewHeap2), |
| 1763 | | set_mutable_ref(Store1,Store2), |
| 1764 | | % ensures that calls which add waitflags now get-redirected to waitflag store 2 |
| 1765 | | % get_ef from Store2 and add trigger to enumerate Store1? |
| 1766 | | %portray_waitflags(wfx(WF0,Store2,WFE2,Info2)), |
| 1767 | | WFE1=WFE2. |
| 1768 | | |
| 1769 | | append_wf([],FDL,FDL). |
| 1770 | | append_wf([H|T],FDL2,Res) :- |
| 1771 | | (ground(H) -> append_wf(T,FDL2,Res) ; Res=[H|RT], append_wf(T,FDL2,RT)). |
| 1772 | | |
| 1773 | | % Note: add_wf will construct multiple WF variables also for finite_priorities, |
| 1774 | | % get_waitflag_from_store will only keep multiple entries for infinite ones |
| 1775 | | add_wf([],Heap,Heap). |
| 1776 | | add_wf([Prio-wf(WF1,Info)|T],Heap,NewHeap) :- |
| 1777 | | % purpose: copy waitflag WFlag to WF store; if same priority exists it will be appended at end |
| 1778 | | P=Prio, |
| 1779 | | (avl_fetch(P,Heap,wf(WFs,_OldInfo)) |
| 1780 | | -> % priority waitflag(s) exist; add inner store WF1 at end |
| 1781 | | merge_waitflag_queues(WF1,WFs,MergedWFs), % TO DO: just unify WF 1 and 0.9 or smaller ? |
| 1782 | | avl_store(P,Heap,wf(MergedWFs,Info),Heap2) |
| 1783 | | ; % this priority does not yet exist in outer store |
| 1784 | | avl_store(P,Heap,wf(WF1,Info),Heap2) |
| 1785 | | ), |
| 1786 | | add_wf(T,Heap2,NewHeap). |
| 1787 | | |
| 1788 | | |
| 1789 | | % try and find an exact match for a waitflag info; this is linear in size of waitflag store ! |
| 1790 | | find_waitflag_info(wfx(_WF0,Store,_WFE1,_),Info,Prio,WF1) :- |
| 1791 | | my_get_wf_store_att(Store,Heap), |
| 1792 | | avl_member(Prio,Heap,wf(WF1,Info)). |
| 1793 | | |
| 1794 | | % dereference the waitflag store, see SICStus for SPRM-20503 |
| 1795 | | % should be called e.g., in WHILE loops of interpreter to prevent degradation of put_atts performance |
| 1796 | | deref_wf(wfx(WF0,S,EF,I),R) :- !, R=wfx(WF0,S2,EF,I), deref_store(S,S2). |
| 1797 | | deref_wf(WF,WF). |
| 1798 | | |
| 1799 | | % D is the dereferenced value of V. |
| 1800 | | % see email by SICStus for SPRM-20503; gets rid of variable chains; was useful for old Waitflag store with attributes |
| 1801 | | %deref(V,D) :- var(V), !, D = V. |
| 1802 | | %deref(X,X). |
| 1803 | | |
| 1804 | | % -------------------------- |
| 1805 | | % DEBUGGING UTILITIES: |
| 1806 | | |
| 1807 | | % you also need to comment in code above using it |
| 1808 | | /* |
| 1809 | | :- dynamic debug_kernel_waitflags/1. |
| 1810 | | set_debug_kernel_waitflags :- (debug_kernel_waitflags(_) -> true ; assertz(debug_kernel_waitflags(0))). |
| 1811 | | |
| 1812 | | % the counter allows to set trace points |
| 1813 | | get_debug_kernel_waitflags(Counter) :- retract(debug_kernel_waitflags(C)), C1 is C+1, |
| 1814 | | assertz(debug_kernel_waitflags(C1)), Counter=C1. |
| 1815 | | |
| 1816 | | get_debug_info(Info,Res) :- debug_kernel_waitflags(Counter),!, |
| 1817 | | (Counter==39 -> trace ; true), |
| 1818 | | Res=info(Counter,Info). |
| 1819 | | get_debug_info(Info,Info). |
| 1820 | | */ |
| 1821 | | |
| 1822 | | % check that a WF is grounded before EWF is grounded: |
| 1823 | | :- public check_grounding/3. %debugging predicate |
| 1824 | | check_grounding(WF,Info,LWF) :- get_enumeration_finished_wait_flag(WF,EWF), check_grounding_of_wf(WF,Info,LWF,EWF). |
| 1825 | | :- block check_grounding_of_wf(?,?,-,-). |
| 1826 | | check_grounding_of_wf(_,_,LWF,_) :- nonvar(LWF),!. |
| 1827 | | check_grounding_of_wf(WF,Info,LWF,_EWF) :- add_internal_error('Waitflag not grounded: ',check_grounding(WF,Info,LWF)), |
| 1828 | | portray_waitflags(WF),nl. |
| 1829 | | |
| 1830 | | % -------------------------- |
| 1831 | | |
| 1832 | | :- assert_must_succeed(( kernel_waitflags:test_waitflags(1) )). |
| 1833 | | :- assert_must_succeed(( kernel_waitflags:test_waitflags(2) )). |
| 1834 | | |
| 1835 | | test_waitflags(1) :- |
| 1836 | | init_wait_flags(Waitflags,[test_waitflags]), |
| 1837 | | get_wait_flag(10,Waitflags,WF1), |
| 1838 | | when(nonvar(WF1),print('WF1 - Prio 10\n')), |
| 1839 | | get_wait_flag(5,Waitflags,WF2), |
| 1840 | | when(nonvar(WF2),(print('WF2 - Prio 5\n'), |
| 1841 | | get_wait_flag(6,Waitflags,WF4), |
| 1842 | | when(nonvar(WF4),print('WF4 - Prio 6\n')), |
| 1843 | | get_wait_flag(2,Waitflags,WF5), |
| 1844 | | when(nonvar(WF5),print('WF5 - Prio2\n')))), |
| 1845 | | get_wait_flag(5,Waitflags,WF3), |
| 1846 | | when(nonvar(WF3),print('WF3 - Prio 5\n')), |
| 1847 | | ground_wait_flags(Waitflags),nl. |
| 1848 | | |
| 1849 | | test_waitflags(2) :- |
| 1850 | | init_wait_flags(Waitflags,[test_waitflags]), |
| 1851 | | get_wait_flag(10,Waitflags,WF1), |
| 1852 | | when(nonvar(WF1),print('WF1 Prio 10\n')), |
| 1853 | | get_wait_flag(5,Waitflags,WF2), |
| 1854 | | when(nonvar(WF2),(print('WF2 - Prio 5\n'), |
| 1855 | | get_wait_flag(6,Waitflags,WF4), |
| 1856 | | when(nonvar(WF4),print('WF4 - Prio 6\n')), |
| 1857 | | get_wait_flag(2,Waitflags,WF5), |
| 1858 | | when(nonvar(WF5),print('WF5 - Prio2\n')))), |
| 1859 | | get_wait_flag(5,Waitflags,WF3), |
| 1860 | | when(nonvar(WF3),print('WF3 - Prio 5\n')), |
| 1861 | | ground_wait_flags(Waitflags),nl. |
| 1862 | | |
| 1863 | | |
| 1864 | | /* |
| 1865 | | |
| 1866 | | bench_waitflags(N) :- |
| 1867 | | statistics(walltime,[Tot1,_]), |
| 1868 | | init_wait_flags(Waitflags), |
| 1869 | | getwf(N,Waitflags), |
| 1870 | | ground_wait_flags(Waitflags),nl,statistics(walltime,[Tot2,_]), Tot is Tot2-Tot1, |
| 1871 | | format('Waitflag test for size ~w : ~w ms walltime (wf=~w)]~n',[N,Tot,Waitflags]). |
| 1872 | | getwf(0,_). |
| 1873 | | getwf(N,Waitflags) :- N>0, N1 is N-1, get_wait_flag(N,bench(N),Waitflags,_), getwf(N1,Waitflags). |
| 1874 | | |
| 1875 | | % old attribute based: |
| 1876 | | | ?- kernel_waitflags:bench_waitflags(1000). |
| 1877 | | |
| 1878 | | Waitflag test for size 1000 : 37 ms walltime (wf=wfx(0,_205205,0,[]))] |
| 1879 | | yes |
| 1880 | | | ?- kernel_waitflags:bench_waitflags(10000). |
| 1881 | | |
| 1882 | | Waitflag test for size 10000 : 5859 ms walltime (wf=wfx(0,_2512071,0,[]))] |
| 1883 | | yes |
| 1884 | | |
| 1885 | | % new mutable based: |
| 1886 | | | ?- kernel_waitflags:bench_waitflags(1000). |
| 1887 | | |
| 1888 | | Waitflag test for size 1000 : 4 ms walltime (wf=wfx(0,$mutable(wfm_store(empty,[],[]),3008),0,[]))] |
| 1889 | | yes |
| 1890 | | | ?- kernel_waitflags:bench_waitflags(10000). |
| 1891 | | |
| 1892 | | Waitflag test for size 10000 : 24 ms walltime (wf=wfx(0,$mutable(wfm_store(empty,[],[]),30008),0,[]))] |
| 1893 | | yes |
| 1894 | | | ?- kernel_waitflags:bench_waitflags(100000). |
| 1895 | | |
| 1896 | | Waitflag test for size 100000 : 497 ms walltime (wf=wfx(0,$mutable(wfm_store(empty,[],[]),9),0,[]))] |
| 1897 | | yes |
| 1898 | | |
| 1899 | | */ |