1 % (c) 2009-2026 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(b_interpreter,
7 [b_test_boolean_expression/4, b_test_boolean_expression/6,
8 %b_test_boolean_expression_wf/3,
9 b_test_boolean_expression_cs/5,
10 b_test_boolean_expression_for_ground_state/4, b_test_boolean_expression_for_ground_state/5,
11 % b_det_test_boolean_expression/6,
12 b_not_test_boolean_expression/4, b_not_test_boolean_expression/6,
13 %b_not_test_boolean_expression_wf/3,
14 b_not_test_boolean_expression_cs/5,
15
16 b_convert_bool/5,
17 b_convert_bool_timeout/7,
18 b_compute_expression/5,
19
20 b_execute_top_level_statement/7,
21 b_execute_statement_nowf/5,
22
23 b_compute_expression_nowf/4, b_compute_expression_nowf/6, b_compute_expression_nowf/7,
24 b_try_compute_expression_no_wf/5,
25 b_compute_explicit_epression_no_wf/6, b_compute_explicit_epression_no_wf/7,
26
27 b_set_up_concrete_constants/2, b_partial_set_up_concrete_constants/1,
28 b_initialise_machine/4,
29
30 b_execute_top_level_operation_update/5, b_execute_top_level_operation_wf/8,
31
32 convert_list_of_expressions_into_set_wf/4,
33 %state_satisfies_negation_of_invariant/1,
34
35 b_state_violates_invariant/2,
36 state_violates_assertions/2,
37 analyse_invariant_for_state/1,
38
39 insert_before_substitution_variables/5, % add $0 values to a store
40
41 try_lookup_value_in_store_and_global_sets/3, lookup_value_in_store_and_global_sets_wf/7,
42 set_up_typed_localstate/6, set_up_typed_localstate2/8,
43 %set_up_localstate_for_let/7,
44
45 set_projection_on_static_assertions/1,
46
47 tcltk_unsatisfiable_components_exist/0,
48 tcltk_quick_describe_unsat_properties/2,
49
50 get_unsat_component_predicate/3,
51 properties_were_filtered/1, % true if PROPERTIES / axioms filtered due to prob-ignore pragmas
52 b_generate_for_all_list_domain_nolwf/8 % for predicate_evaluator
53 ]).
54
55 :- meta_predicate not_with_enum_warning_and_possible_delay(0,-,?,?,?).
56 :- meta_predicate not_with_enum_warning_delay(0,-,?,?,?,?).
57
58 %:- use_module('../extensions/profiler/profiler.pl').
59 %:- use_module('../extensions/profiler/profiler_te.pl').
60 %:- enable_profiling(b_test_boolean_expression/4).
61 %:- enable_profiling(b_test_boolean_expression_cs/5).
62
63 :- use_module(kernel_objects).
64 :- use_module(bsets_clp).
65 :- use_module(delay).
66
67
68 :- use_module(kernel_mappings).
69 :- use_module(b_global_sets).
70 :- use_module(store).
71 :- use_module(library(lists)).
72 :- use_module(library(ordsets)).
73 :- use_module(library(avl)).
74
75 :- use_module(b_global_sets).
76 :- use_module(bmachine).
77 :- use_module(b_enumerate, [b_enumerate_values_in_store/5,
78 b_tighter_enumerate_all_values/2, b_tighter_enumerate_values_in_ctxt/3]).
79 :- use_module(debug).
80 :- use_module(performance_messages).
81 :- use_module(self_check).
82 :- use_module(tools).
83
84 :- use_module(module_information,[module_info/2]).
85 :- module_info(group,interpreter).
86 :- module_info(description,'This module provides the basic interpreter for expressions, predicates and substitutions.').
87
88 :- use_module(preferences).
89 :- use_module(error_manager).
90 :- use_module(typechecker).
91 :- use_module(specfile,[state_corresponds_to_initialised_b_machine/2
92 ,state_corresponds_to_set_up_constants_only/2]).
93
94 :- use_module(bsyntaxtree).
95
96 :- use_module(translate).
97
98 :- use_module(kernel_waitflags).
99 :- use_module(kernel_reals).
100 :- use_module(kernel_records).
101
102 :- use_module(kodkodsrc(kodkod),[kodkod_request/5]).
103
104 :- use_module(custom_explicit_sets).
105 :- use_module(closures,[is_symbolic_closure/1,
106 mark_closure_as_symbolic/2, mark_closure_as_recursive/2, mark_closure/3]).
107
108 :- use_module(state_space).
109 :- use_module(b_interpreter_eventb).
110 :- use_module(tools_printing,[print_term_summary/1,print_functor/1]).
111 :- use_module(value_persistance,[load_partial_constants/3,lookup_cached_transitions/4]).
112 :- use_module(extrasrc(b_expression_sharing),[is_lazy_let_identifier/1]).
113 :- use_module(bool_pred,[negate/2]).
114 :- use_module(smt_solvers_interface(smt_solvers_interface),[smt_add_predicate/5]).
115
116 :- use_module(debug).
117 :- use_module(external_functions).
118
119 :- use_module(static_ordering,[sort_ids_by_usage/4,reorder_state/3]).
120 %:- use_module(bsyntaxtree,[predicate_has_ignore_pragma/1]).
121 :- use_module(tools_lists,[optimized_nth1/3]).
122 :- use_module(tools_meta, [safe_time_out/3]).
123
124 :- set_prolog_flag(double_quotes, codes).
125
126 /* ----------------------------------*/
127
128 /* For partial evaluation */
129
130 %:- use_module('~/cvs_root/cogen2/logen_source/runtime/logen_dispatcher.pl').
131
132 % new profiler
133 %:- use_module('../extensions/profiler/profiler.pl').
134 %:- use_module('../extensions/profiler/profiler_te.pl').
135 %:- enable_profiling_naming(b_interpreter:b_state_violates_invariant_aux/2,name).
136
137 %name(b_interpreter:b_state_violates_invariant_aux,_,INVERIANT).
138
139 %b_state_violates_invariant(ID,State) :-
140 % b_intepreter:b_state_violates_invariant_aux(ID,State).
141
142 % old profiler
143 :- use_module(runtime_profiler,[profile_single_call/3]).
144
145 % called by force_check_invariantKO and indirectly by model_checker (State was prepare_state_for_specfile_trans )
146 b_state_violates_invariant(ID,State) :-
147 b_state_violates_invariant_aux(ID,State).
148
149 b_state_violates_invariant_aux(ID,CurBState) :-
150 retract(specialized_inv(ID,BitSetMask)), % Note: when we assert this we checked that invariant holds in predecessor state
151 intersect_invs(BitSetMask,SPO), !,
152 (SPO = b(truth,_,_) -> fail
153 ; profile_single_call('INVARIANT-Specialized',ID,b_interpreter:b_state_violates_spec_invariant(ID,SPO,CurBState))).
154 b_state_violates_invariant_aux(ID,CurBState) :-
155 profile_single_call('INVARIANT',ID,b_interpreter:state_violates_invariant(ID,CurBState)).
156
157 b_state_violates_spec_invariant(ID,SPO,CurBState) :-
158 \+ check_invariant_predicate_with_time_out(ID,SPO,CurBState).
159
160 :- use_module(probsrc(bit_sets),[member_bitset/2]).
161 intersect_invs(invariant_preserved,Inv) :- !, Inv= b(truth,pred,[]).
162 intersect_invs(Mask,InvList) :- integer(Mask), !,
163 findall(nth1_invariant(Nr), member_bitset(Nr,Mask), InvList).
164 intersect_invs(M,Inv) :- !, add_internal_error('Illegal empty specialized inv list:', intersect_invs(M,Inv)),
165 Inv = b(falsity,pred,[]).
166
167
168 /* ----------------------------------*/
169
170 :- load_files(library(system), [when(compile_time), imports([environ/2])]).
171
172
173 state_satisfies_invariant_aux(ID,State) :-
174 check_invariant_with_time_out(ID,State). % version without partial evaluation
175
176
177 :- use_module(library(timeout)).
178
179 :- use_module(tools_printing,[format_with_colour_nl/4]).
180 :- use_module(probsrc(specfile),[prepare_state_for_specfile_trans/3]).
181 % called by prob_cli when invariant violation found:
182 % we no longer have access to the specialized_inv facts
183 analyse_invariant_for_state(ID) :-
184 b_invariant_number_list(InvList),
185 visited_expression(ID,State),
186 prepare_state_for_specfile_trans(State,ID,PreparedCurState),
187 maplist(check_invariant(ID,PreparedCurState),InvList).
188 check_invariant(ID,State,InvariantNr) :-
189 enter_new_error_scope(L,check_invariant),
190 check_invariant_predicate_with_time_out_res(InvariantNr,State,TimeOutRes),
191 (TimeOutRes=success -> true
192 ; InvariantNr = nth1_invariant(Nr),
193 b_nth1_invariant(Nr,Invariant,_UsedIds),
194 translate_bexpression_with_limit(Invariant,TS),
195 translate_span(Invariant,SpanStr),
196 (TimeOutRes=failure -> InvRes=false ; InvRes=unknown),
197 format_with_colour_nl(user_output,[red,bold],
198 '*** Invariant ~w ~w is ~w (in state with id ~w):~n ~w',[Nr,SpanStr,InvRes,ID,TS]),
199 % add_message(check_invariant,'Invariant false: ',Nr,TS),
200 (debug_mode(off) -> true
201 ; translate:print_bstate(State),nl
202 )
203 % TODO: pass check dot_file_prefix or similar to analyse_invariant_for_state and call:
204 % bvisual:get_tree_from_expr(Tree, Invariant, [], State),
205 % bvisual:write_dot_graph_to_file(Tree,'invariant.dot')
206 ), exit_error_scope(L,_ErrOcc,check_invariant).
207
208
209
210 check_invariant_with_time_out(ID,State) :-
211 %b_get_invariant_from_machine(Invariant),
212 b_invariant_number_list(InvList), % ensures operation caching can be applied
213 % TO DO: we could just get unproven invariants; unless we are in an initial state
214 check_invariant_predicate_with_time_out(ID,InvList,State).
215
216
217 check_invariant_predicate_with_time_out(ID,Invariant,State) :-
218 (check_invariant_predicate_with_time_out_res(Invariant,State,TimeOutRes)
219 -> check_time_out_res(TimeOutRes,ID)).
220
221 check_invariant_predicate_with_time_out_res(b(truth,_,_),_State,TimeOutRes) :- !, % only typing in invariant
222 TimeOutRes = success.
223 check_invariant_predicate_with_time_out_res(Invariant,State,TimeOutRes) :-
224 set_error_context(checking_invariant),
225 preferences:get_computed_preference(debug_time_out,DebugTimeOut),
226 call_cleanup(
227 (time_out_with_enum_warning_one_solution_no_new_error_scope(
228 b_interpreter:check_invariant_predicate_aux(Invariant,State ),
229 DebugTimeOut,TimeOutRes)
230 -> true
231 ; TimeOutRes = failure),
232 clear_error_context).
233
234 % process typed predicates, lists and special invariant(Nr) terms
235 check_invariant_predicate_aux(nth1_invariant(Nr),State) :- !,
236 ((get_preference(operation_reuse_setting,false) ;
237 get_preference(try_operation_reuse_for_invariants,false))
238 ? -> check_nth1_invariant(Nr,State)
239 ? ; \+ b_operation_cache:check_invariant_violated_cache(Nr,State) % will call check_nth1_invariant if necessary
240 % note : for performance it is important that the State is prepared but not expanded
241 % (e.g. it should be expanded_const_and_vars with the info field containing the packed state)
242 ).
243 check_invariant_predicate_aux([],_) :- !.
244 check_invariant_predicate_aux([H|T],State) :- !,
245 ? check_invariant_predicate_aux(H,State),
246 ? check_invariant_predicate_aux(T,State).
247 check_invariant_predicate_aux(Invariant,State) :-
248 b_test_boolean_expression_for_ground_state(Invariant,[],State,'INVARIANT',0).
249
250 % check the nth invariant
251 check_nth1_invariant(Nr,State) :-
252 if(b_nth1_invariant(Nr,Invariant,_UsedIds),
253 ? b_test_boolean_expression_for_ground_state(Invariant,[],State,'INVARIANT',Nr), % add Nr to call_stack
254 add_internal_error('Invariant does not exist:',Nr)).
255
256
257 check_time_out_res(time_out,ID) :- !,
258 format('**** TIMEOUT during invariant evaluation in state ~w!~n',[ID]),
259 assert_time_out_for_invariant(ID),
260 fail.
261 check_time_out_res(virtual_time_out(_WARNING),ID) :- !,
262 format('**** VIRTUAL TIMEOUT during invariant evaluation in state ~w!~n',[ID]),
263 assert_time_out_for_invariant(ID),
264 fail.
265 check_time_out_res(failure,_) :- !, fail.
266 check_time_out_res(_,_).
267
268 % b_test_boolean_expression_for_ground_state:
269 % idea: check each conjunct individually; avoids multiplication of choice points between conjuncts
270
271 :- use_module(specfile,[expand_const_and_vars_to_full_store/2]).
272 b_test_boolean_expression_for_ground_state(b(Expr,_,Infos),LS,S,PredKind) :-
273 ? b_test_boolean_expression_for_ground_state(b(Expr,_,Infos),LS,S,PredKind,0).
274 b_test_boolean_expression_for_ground_state(b(Expr,_,Infos),LS,S,PredKind,Nr) :-
275 expand_const_and_vars_to_full_store(S,FS), % ensure we have full store
276 ? b_test_boolean_expression_for_ground_state2(Expr,Infos,LS,FS,PredKind,Nr).
277
278 b_test_boolean_expression_for_ground_state1(b(Expr,_,Infos),LS,S,Kind,Nr) :- !,
279 ? b_test_boolean_expression_for_ground_state2(Expr,Infos,LS,S,Kind,Nr).
280
281 b_test_boolean_expression_for_ground_state2(conjunct(LHS,RHS),_,LocalState,State,Kind,Nr) :- !,
282 % usually LHS is the nested conjunct and RHS atomic:
283 %it would be better to swap LHS and RHS: but does not seem to buy anything
284 ? b_test_boolean_expression_for_ground_state1(LHS,LocalState,State,Kind,Nr),
285 !, % do we need this cut; it makes partial evaluation more tricky
286 ? b_test_boolean_expression_for_ground_state1(RHS,LocalState,State,Kind,Nr).
287 % TO DO: treate lazy_let_pred ?
288 b_test_boolean_expression_for_ground_state2(BE,Infos,LS,S,Kind,Nr) :-
289 ? b_test_boolean_expression_cs(b(BE,pred,Infos),LS,S,Kind,Nr).
290
291 state_violates_invariant(ID,State) :-
292 State \== root,
293 State \= concrete_constants(_), % machine not yet initialised (cf state_corresponds_to_initialised_b_machine)
294 \+(state_satisfies_invariant_aux(ID,State)).
295
296
297 % new profiler
298 %:- use_module('../extensions/profiler/profiler.pl').
299 %:- use_module('../extensions/profiler/profiler_te.pl').
300 %:- enable_profiling_naming(b_interpreter:state_violates_assertions_aux/2,name2).
301
302 %name2(b_interpreter:state_violates_assertions_aux,_,ASSERTIONS).
303
304 %state_violates_assertions(ID,State) :-
305 % b_interpreter:state_violates_assertions_aux(ID,State).
306
307 :- use_module(bmachine,[get_assertions_from_machine/2, b_machine_has_dynamic_assertions/0, b_machine_has_static_assertions/0]).
308 state_violates_assertions(ID,State) :-
309 profile_single_call('ASSERTIONS',ID,b_interpreter:state_violates_assertions_aux(ID,State)).
310 state_violates_assertions_aux(ID,State) :-
311 b_machine_has_dynamic_assertions,
312 state_corresponds_to_initialised_b_machine(State,BState), !,
313 \+(state_satisfies_assertions(ID,dynamic,BState)).
314 state_violates_assertions_aux(ID,State) :-
315 b_machine_has_static_assertions,
316 state_corresponds_to_set_up_constants_only(State,BState),
317 \+(state_satisfies_assertions(ID,static,BState)).
318 state_satisfies_assertions(ID,Type,State) :-
319 ( get_assertions_from_machine(Type,Ass) ->
320 set_error_context(checking_assertions),
321 %enter_new_error_scope(Level,checking_assertions),
322 preferences:get_computed_preference(debug_time_out,DebugTimeOut),
323 %print(checking_assertions(ID)),nl,
324 time_out_with_enum_warning_one_solution(
325 b_test_list_of_boolean_expression_for_ground_state(Ass,'ASSERTION ',[],State),
326 DebugTimeOut,TimeOutRes, clear_errors),
327 % TO DO: in case of a virtual time-out (cf UML-B/drone_2_error.eventb) we could try and continue with the next assertion
328 clear_error_context,
329 (nonvar(TimeOutRes),
330 (TimeOutRes == time_out, Kind='TIMEOUT' ; TimeOutRes = virtual_time_out(_), Kind = 'Virtual TIMEOUT')
331 -> format('~n*** ~w during assertion checking for state id ~w!~n',[Kind,ID]),
332 assert_time_out_for_assertions(ID)
333 ; true
334 )
335 ; true
336 ).
337
338
339
340 /* ----------------------------------*/
341 /* b_test_boolean_expression */
342 /* ----------------------------------*/
343
344
345 :- type variable_id_list +--> list(type(variable_id)).
346
347 :- type boolean_expression +--> call(bsyntaxtree:check_if_typed_predicate).
348
349 % used for testing ASSERTIONS on a fully ground state
350 b_test_list_of_boolean_expression_for_ground_state(List,PredKind,LS,S) :-
351 b_test_list_of_boolean_expression_aux(List,PredKind,1,LS,S).
352
353 b_test_list_of_boolean_expression_aux([],_,_,_,_).
354 b_test_list_of_boolean_expression_aux([B1|T],PredKind,Nr,LS,S) :- %nl,print(nr(PredKind,Nr)),nl,
355 ? (b_test_boolean_expression_for_ground_state1(B1,LS,S,PredKind,Nr)
356 -> N1 is Nr+1, b_test_list_of_boolean_expression_aux(T,PredKind,N1,LS,S)
357 ; silent_mode(off),
358 (critical_enumeration_warning_occured_in_error_scope -> Res='UNKNOWN'
359 ; abort_error_occured_in_error_scope -> Res ='NOT-WELL-DEFINED'
360 ; Res='false'),
361 ajoin([PredKind, Nr, ' is ', Res,': '],Msg),
362 add_message(b_interpreter,Msg,B1,B1), % TO DO: get just label/location?
363 fail).
364
365
366 :- use_module(b_interpreter_components).
367
368
369 :- assert_pre(b_interpreter:b_test_boolean_expression_cs(E,LS,S,_,_),
370 (bsyntaxtree:check_if_typed_predicate(E),type_check(LS,store),type_check(S,store) )).
371 :- assert_post(b_interpreter:b_test_boolean_expression_cs(_,_,_,_,_), true ).
372
373
374 % --------------------- BOOLEAN EXPRESSIONS ----------------------------
375
376 :- use_module(b_interpreter_check).
377 :- use_module(kernel_propagation, [do_not_enumerate_binary_boolean_operator/3]).
378
379 % a version where we can provide an initial call stack entry for context
380 b_test_boolean_expression_cs(E,LS,S,PredKind,Nr) :-
381 init_wait_flags_cs(E,PredKind,Nr,b_test_boolean_expression_cs,WF),
382 % TO DO: call b_trace_test_components ?
383 ? b_test_boolean_expression(E,LS,S,WF),
384 ? ground_wait_flags(WF).
385
386 init_wait_flags_cs(E,PredKind,Nr,PP,WF) :-
387 (PredKind=none -> init_wait_flags(WF,[PP])
388 ; get_texpr_pos(E,Pos),
389 CallStackEntry = prob_command_context(check_pred_command(PredKind,Nr),Pos),
390 init_wait_flags_and_push_call_stack(no_wf_available,CallStackEntry,WF)
391 ).
392
393
394 b_test_boolean_expression(b(Expr,_,Infos),LS,S,WF) :- !,
395 (b_interpreter_check:composed(Expr) -> empty_avl(Ai)
396 ; Ai = no_avl), % simple expression: no sharing is possible: no need to register expressions
397 ? b_test_boolean_expression2(Expr,Infos,LS,S,WF,Ai,_).
398 b_test_boolean_expression(E,LS,S,WF) :- % will generate error message
399 empty_avl(Ai), b_test_boolean_expression(E,LS,S,WF,Ai,_).
400
401 :- assert_pre(b_interpreter:b_test_boolean_expression(E,LS,S,WF),
402 (nonvar(E),bsyntaxtree:check_if_typed_predicate(E),type_check(LS,store),type_check(S,store),
403 type_check(WF,wait_flag))).
404 :- assert_post(b_interpreter:b_test_boolean_expression(_,_,_,WF), type_check(WF,wait_flag)).
405
406
407 %b_test_boolean_expression(Expr,_,_,_) :- print('test: '),translate:print_bexpr(Expr),nl,print(Expr),nl,fail. %%
408
409 :- load_files(library(system), [when(compile_time), imports([environ/2])]).
410 :- if(environ(prob_debug_watch_flag,true)).
411 b_test_boolean_expressiond(b(Expr,_,Infos),LS,S,WF,Ai,Ao) :- !,
412 b_test_boolean_expression2(Expr,Infos,LS,S,WF,Ai,Ao).
413 b_test_boolean_expression(Expr,LS,S,WF,Ai,Ao) :- !,
414 (waitflag0_is_set(WF)
415 -> debug:watch(300,b_interpreter:b_test_boolean_expressiond(Expr,LS,S,WF,Ai,Ao))
416 ; debug:watch_det(300,b_interpreter:b_test_boolean_expressiond(Expr,LS,S,WF,Ai,Ao)) ).
417 :- else.
418 b_test_boolean_expression(b(Expr,Type,Infos),LS,S,WF,Ai,Ao) :- !,
419 (preference(smt_supported_interpreter,true)
420 ? -> b_test_boolean_expression2(Expr,Infos,LS,S,WF,Ai,Ao),
421 get_wait_flag1(smt_call,WF,BeforeEnumWF),
422 gensym:gensym(smt_assertion_name,Symbol),
423 smt_add_predicate(BeforeEnumWF,b(Expr,Type,Infos),LS,S,Symbol)
424 ;
425 ? b_test_boolean_expression2(Expr,Infos,LS,S,WF,Ai,Ao)).
426 :- endif.
427 b_test_boolean_expression(E,LS,S,WF,Ai,Ao) :-
428 add_internal_error('Boolean expression not properly wrapped: ',
429 b_test_boolean_expression(E,LS,S,WF,Ai,Ao)),
430 b_test_boolean_expression2(E,[],LS,S,WF,Ai,Ao).
431
432
433 b_test_boolean_expression2(truth,_,_,_,_WF,Ai,Ao) :- !,Ai=Ao.
434 b_test_boolean_expression2(falsity,_,_,_,_WF,_Ai,_Ao) :- !,fail.
435 b_test_boolean_expression2(negation(BExpr),_,LocalState,State,WF,Ai,Ao) :- !,
436 ? b_not_test_boolean_expression(BExpr,LocalState,State,WF,Ai,Ao).
437 b_test_boolean_expression2(conjunct(LHS,RHS),_,LocalState,State,WF,Ai,Ao) :- !,
438 ? b_test_boolean_expression(LHS,LocalState,State,WF,Ai,Aii),
439 ? b_test_boolean_expression(RHS,LocalState,State,WF,Aii,Ao).
440 b_test_boolean_expression2(implication(LHS,RHS),Info,LocalState,State,WF,Ai,Ao) :-
441 %b_compiler:b_compile(LHS,[],LocalState,State,CLHS), % this slows down Cruise benchmark from 3.75 s to 4.3
442 !,
443 ? b_test_implication(LHS,RHS,Info,LocalState,State,WF,Ai,Ao).
444 b_test_boolean_expression2(equivalence(LHS,RHS),_,LocalState,State,WF,Ai,Ao) :- !,
445 ? b_test_equivalence(LHS,RHS,LocalState,State,WF,Ai,Ao).
446 b_test_boolean_expression2(disjunct(LHS,RHS),Info,LocalState,State,WF,Ai,Ao) :- !,
447 % TO DO: normalise disjunct first ?
448 copy_wf_start(WF,disjunct,CWF),
449 ? if(b_check_boolean_expression(LHS,LocalState,State,CWF,PredRes,Ai,Aii),
450 % we can check lhs
451 ? if(b_interpreter_check:b_check_boolean_expression0(pred_false,PredRes,RHS,LocalState,State,CWF,RR,Aii,Ao),
452 ( /* we can also check rhs */
453 ? b_interpreter_check:disjoin(PredRes,RR,pred_true,LHS,RHS,WF),
454 copy_wf_finish(WF,CWF)
455 ),
456 (
457 Ao=Aii,
458 copy_wf_finish(WF,CWF),
459 imply_test_boolean_expression(PredRes,pred_false,RHS,LocalState,State,WF,Aii),
460 perfmessagecall(choice_point,reification_of_disjunction_rhs_failed,translate:print_bexpr(RHS),Info),
461 enumerate_bool(PredRes,15,WF)
462 )
463 ),
464 % we cannot check lhs
465 if((always_well_defined(RHS),
466 b_check_boolean_expression(RHS,LocalState,State,CWF,PredRes,Ai,Aii)),
467 (
468 Ao=Aii,
469 copy_wf_finish(WF,CWF),
470 imply_test_boolean_expression(PredRes,pred_false,LHS,LocalState,State,WF,Aii),
471 perfmessagecall(choice_point,reification_of_disjunction_lhs_failed,translate:print_bexpr(LHS),Info),
472 enumerate_bool(PredRes,15,WF)
473 ),
474 % we cannot check neither lhs nor rhs:
475 (Ai=Ao,
476 get_priority_of_boolean_expression2(disjunct(LHS,RHS),StartPrio),
477 %get_wait_flag(Prio,disjunct,WF,WF2),
478 get_binary_choice_wait_flag_exp_backoff(StartPrio,disjunct,WF,WF2),
479 % be sure that e.g. for (x=2 or x=3) both branches will be tested once deterministic propagation is over
480 %print(prio(Prio)), print(' : '),print_bexpr(LHS), print(' or '), print_bexpr(RHS),nl,
481 perfmessagecall(choice_point,reification_of_disjunction_failed,translate:print_bexpr(b(disjunct(LHS,RHS),pred,Info)),Info),
482 b_test_disjunction(LHS,RHS,LocalState,State,WF,WF2,Ai)
483 )
484 )
485 ).
486 b_test_boolean_expression2(exists(Parameters,RHS),Infos,LocalState,State,WF,Ai,Ao) :- !,Ai=Ao,
487 ? b_test_exists(Parameters,RHS,Infos,LocalState,State,WF).
488 %b_test_boolean_expression2(forall(PARS,LHS,RHS),_Inf,LocalState,State,WF) :-
489 % PARS = [b(identifier(R1),integer,_),b(identifier(R2),integer,_)],
490 % LHS = b(conjunct(b(conjunct(MEM1,MEM2),pred,_I1),NEQ),pred,_I2),
491 % NEQ = b(not_equal(b(identifier(RR1),integer,_I3),b(identifier(RR2),integer,_I4)),pred,_I5),
492 % (RR1=R1, RR2=R2 ; RR1=R2, RR2=R1),
493 % MEM1 = b(member(b(identifier(RRR1),integer,_),b(SET,set(integer),_)),pred,_),
494 % MEM2 = b(member(b(identifier(RRR2),integer,_),b(SET,set(integer),_)),pred,_),
495 % (RRR1=R1, RRR2=R2 ; RRR1=R2, RRR2=R1),
496 % /* TO DO: check that RHS is symmetric ! */ /* TO DO : generalize symmetry breaking */
497 % !, % print(symmetry_breaking_forall(R1,R2)),nl,
498 % GT = b(less(b(identifier(R1),integer,_I3),b(identifier(R2),integer,_I4)),pred,_I5),
499 % NewLHS = b(conjunct(b(conjunct(MEM1,MEM2),pred,_I1),GT),pred,_I2),
500 % b_test_boolean_expression2(forall(PARS,NewLHS,RHS),_Inf,LocalState,State,WF).
501 b_test_boolean_expression2(forall(Parameters,LHS,RHS),Infos,LocalState,State,WF,Ai,Ao) :- !,Ai=Ao,
502 /* !ID.(LHS => RHS) */
503 ? b_for_all(Parameters,Infos,LHS,RHS,LocalState,State,WF).
504 b_test_boolean_expression2(let_predicate(Ids,AssignmentExprs,Pred),Infos,LocalState,State,WF,Ai,Ao) :- !,
505 Ai=Ao, % any expression inside the LET cannot be safely reused
506 (is_truth(Pred)
507 -> % useless let, only sense of computations below is in detecting WD errors
508 get_enumeration_starting_wait_flag(useless_let_predicate(Ids),WF,ESWF),
509 when(nonvar(ESWF),set_up_localstate_for_let(Ids,_,AssignmentExprs,LocalState,State,_LetState,WF))
510 ? ; set_up_localstate_for_let(Ids,ParaValues,AssignmentExprs,LocalState,State,LetState,WF),
511 opt_push_wait_flag_call_stack_quantifier_info(WF,let_quantifier,Ids,ParaValues,Infos,WF2),
512 ? b_test_boolean_expression(Pred,LetState,State,WF2)). % we could pass Ai in if Ids fresh
513
514 b_test_boolean_expression2(lazy_let_pred(Id,AssignmentExpr,Expr),_I,LocalState,State,WF,Ai,Ao) :- !,
515 add_lazy_let_id_and_expression(Id,AssignmentExpr,LocalState,State,NewLocalState,WF,Ai),
516 ? b_test_boolean_expression(Expr,NewLocalState,State,WF,Ai,Ao).
517 % we could use Ai,Ao version as lazy lets never interfere with each other and never invalidate existing expressions
518 b_test_boolean_expression2(lazy_lookup_pred(Id),_Info,LocalState,_State,WF,Ai,Ao) :- !, Ai=Ao,
519 lookup_value_for_existing_id_wf(Id,LocalState,(Trigger,Value),WF),
520 % should normally only occur in LocalState; value introduced by lazy_let
521 (Trigger,Value) = (pred_true,pred_true). % force evaluation
522 b_test_boolean_expression2(value(PredVal),_Info,_LocalState,_State,_WF,Ai,Ao) :- !,
523 % this can occur when lazy_lookup_pred gets compiled by b_compiler
524 is_pred_true(PredVal),Ai=Ao.
525 b_test_boolean_expression2(Pred,Info,LocalState,State,WF,Ai,Ao) :-
526 % TO DO: we could put some of the operators into the Ai store (comparison operators)
527 ? b_interpreter_check:register_predicate(Pred,Info,pred_true,Reused,Ai,Ao),
528 (Reused==true
529 -> %% print('REUSED: '), translate:print_bexpr(Pred),nl
530 true
531 ? ; b_test_atomic_boolean_expression2(Pred,Info,LocalState,State,WF)).
532
533 :- block is_pred_true(-).
534 is_pred_true(X) :- (X=pred_true -> true ; X=pred_false -> fail ; add_internal_error('Illegal call: ',is_pred_true(X)),fail).
535 :- block is_pred_false(-).
536 is_pred_false(X) :- (X=pred_false -> true ; X=pred_true -> fail ; add_internal_error('Illegal call: ',is_pred_false(X)),fail).
537
538
539 % we could simply call disjunct(NegLHS,RHS) ?
540 % A => B has more of a feeling of a passive constraint than A or B
541 % hence we use a lower priority here for enumerate_bool below and do not
542 % try to reify rhs if lhs reification failed (but maybe we should)
543 b_test_implication(LHS,RHS,_Info,LocalState,State,WF,Ai,Ao) :-
544 copy_wf_start(WF,implication,CWF),
545 ? if(b_check_boolean_expression(LHS,LocalState,State,CWF,PredRes,Ai,Aii),
546 %% print('checking => '), print_bexpr(LHS), print(' '), print(PredRes),nl,
547 %% The following improves constraint propagation; but can be tricky with undefinedness
548 if((var(PredRes),always_well_defined(RHS),
549 b_check_boolean_expression(RHS,LocalState,State,CWF,RHSPredRes,Aii,Ao)),
550 (/* also propagate from right to left */
551 ? b_interpreter_check:imply_true(PredRes,RHSPredRes),
552 perfmessage_bexpr(good(reify),'Fully reified implication with LHS: ',LHS),
553 ? copy_wf_finish(WF,CWF)
554 ),
555 ( Aii=Ao,
556 ? copy_wf_finish(WF,CWF),
557 ? imply_test_boolean_expression(PredRes,pred_true,RHS,LocalState,State,WF,Aii),
558 (nonvar(PredRes) -> true
559 ; performance_monitoring_on,
560 \+always_well_defined(RHS) -> perfmessage_bexpr(reify,'Cannot reify RHS of => due to WD condition, creating choice point:',RHS)
561 ; perfmessage_bexpr(reify,'Cannot reify RHS of =>, creating choice point:',RHS)
562 ),
563 enumerate_bool(PredRes,10000,WF) % lower priority than disjunction (15); we could use last_finite_priority ?
564 )
565 ),
566 ( Ai=Ao,
567 perfmessage_bexpr(reify,'Cannot reify LHS of =>, creating binary choice point:',LHS),
568 get_binary_choice_wait_flag(implication,WF,WF2),
569 block_test_implication(LHS,RHS,LocalState,State,WF,WF2)
570 )
571 ).
572
573 % ------------
574
575 :- discontiguous b_test_atomic_boolean_expression2/5.
576 %b_test_atomic_boolean_expression2(Expr,T,LocalState,State,WF) :- print(eval(Expr,T)),nl,fail.
577 b_test_atomic_boolean_expression2(partition(LHS,RHS),_,LocalState,State,WF) :- !,
578 b_compute_expression(LHS,LocalState,State,SV1,WF), %print(lhs(SV1)),nl,
579 l_compute_expression(RHS,LocalState,State,SV2,WF), % RHS is Prolog list of expressions
580 ? kernel_call_predicate(partition_wf(SV1,SV2,WF),kernel_objects,WF,partition(LHS,RHS)).
581 b_test_atomic_boolean_expression2(member(TElem,TSet),_,LocalState,State,WF) :- !,
582 ? b_test_member_expression(TElem,TSet,LocalState,State,WF).
583 b_test_atomic_boolean_expression2(not_member(TElem,TSet),Info,LocalState,State,WF) :- !,
584 get_texpr_expr(TSet,Set),
585 ? b_test_notmember_expression(Set,TElem,TSet,Info,LocalState,State,WF).
586 b_test_atomic_boolean_expression2(freetype_case(Freetype,Case,Expr),_,LocalState,State,WF) :-
587 !,equal_object_wf(Value,freeval(Freetype,Case,_),b_test_atomic_boolean_expression2,WF),
588 b_compute_expression(Expr,LocalState,State,Value,WF). % NOT COVERED (16)
589 b_test_atomic_boolean_expression2(finite(SetExpr),_,LocalState,State,WF) :-
590 !, b_compute_expression(SetExpr,LocalState,State,Value,WF),
591 kernel_call_predicate(is_finite_set_wf(Value,WF),kernel_objects,WF,finite(SetExpr)).
592 /* Extension for Kodkod */
593 b_test_atomic_boolean_expression2(kodkod(ProblemId,_),_,LocalState,State,WF) :-
594 !,get_wait_flag1(kodkod_call,WF,WF0),
595 kodkod_request(ProblemId,pos,LocalState,State,WF0). % NOT COVERED (17)
596 %b_test_atomic_boolean_expression2(equal(Arg1,Arg2),_,LocalState,State,WF) :- get_texpr_type(Arg1,integer),!,
597 % b_compute_expression(Arg1,LocalState,State,ExprRes,WF),
598 % b_compute_expression(Arg2,LocalState,State,ExprRes,WF). /* avoids one extra variable compared to code below + could fail earlier ; but problem as b_compute_expression still uses = in some places */
599
600 :- include(b_arithmetic_expressions).
601 %The following clause improves Nqueens performance by about 50 %; by avoiding intermediate variables
602 % TO DO: do the same for >, <, >= ...
603 b_test_atomic_boolean_expression2(equal(Arg1,Arg2),Info,LocalState,State,WF) :- !,
604 ? b_test_atomic_equal_boolean_expression(Arg1,Arg2,Info,LocalState,State,WF).
605 b_test_atomic_boolean_expression2(not_equal(Arg1,Arg2),Info,LocalState,State,WF) :- !,
606 ? b_test_atomic_not_equal_boolean_expression(Arg1,Arg2,Info,LocalState,State,WF).
607 b_test_atomic_boolean_expression2(less_equal(Arg1,Arg2),_Info,LocalState,State,WF) :-
608 %get_texpr_type(Arg1,integer), % type checker already checks this
609 preferences:preference(use_clpfd_solver,true),
610 !,
611 ? b_compute_arith_expression(Arg1,LocalState,State,CLPFD_Expr1,WF),
612 ? b_compute_arith_expression(Arg2,LocalState,State,CLPFD_Expr2,WF),
613 ? clpfd_interface:clpfd_leq_expr(CLPFD_Expr1,CLPFD_Expr2).
614 b_test_atomic_boolean_expression2(greater_equal(Arg1,Arg2),_Info,LocalState,State,WF) :-
615 %get_texpr_type(Arg1,integer), % type checker already checks this
616 preferences:preference(use_clpfd_solver,true),
617 !,
618 b_compute_arith_expression(Arg1,LocalState,State,CLPFD_Expr1,WF),
619 b_compute_arith_expression(Arg2,LocalState,State,CLPFD_Expr2,WF),
620 clpfd_interface:clpfd_leq_expr(CLPFD_Expr2,CLPFD_Expr1).
621 b_test_atomic_boolean_expression2(less(Arg1,Arg2),_Info,LocalState,State,WF) :-
622 %get_texpr_type(Arg1,integer), % type checker already checks this
623 preferences:preference(use_clpfd_solver,true),
624 !,
625 ? b_compute_arith_expression(Arg1,LocalState,State,CLPFD_Expr1,WF),
626 ? b_compute_arith_expression(Arg2,LocalState,State,CLPFD_Expr2,WF),
627 ? clpfd_interface:clpfd_lt_expr(CLPFD_Expr1,CLPFD_Expr2).
628 b_test_atomic_boolean_expression2(greater(Arg1,Arg2),_Info,LocalState,State,WF) :-
629 %get_texpr_type(Arg1,integer), % type checker already checks this
630 preferences:preference(use_clpfd_solver,true),
631 !,
632 ? b_compute_arith_expression(Arg1,LocalState,State,CLPFD_Expr1,WF),
633 b_compute_arith_expression(Arg2,LocalState,State,CLPFD_Expr2,WF),
634 clpfd_interface:clpfd_lt_expr(CLPFD_Expr2,CLPFD_Expr1).
635 b_test_atomic_boolean_expression2(external_pred_call(FunName,Args),Info,LocalState,State,WF) :-
636 !,
637 (do_not_evaluate_args(FunName) -> EvaluatedArgs=[]
638 ? ; b_compute_expressions(Args, LocalState,State, EvaluatedArgs, WF)),
639 push_wait_flag_call_stack_info(WF,external_call(FunName,EvaluatedArgs,Info),WF2),
640 ? call_external_predicate(FunName,Args,EvaluatedArgs,LocalState,State,pred_true,Info,WF2).
641 b_test_atomic_boolean_expression2(Expression,Info,LocalState,State,WF) :-
642 preferences:preference(use_clpfd_solver,false),
643 special_binary_predicate(Expression,Module:Kernel_predicate,Arg1,T1,Arg2,T2),
644 (nonmember(contains_wd_condition,Info) -> true ; preference(disprover_mode,true)),
645 !,
646 % print('Special call: '), print_bexpr(Expression),nl, print(Kernel_predicate),print(' : '),nl,
647 %(Arg1==list_of_expressions -> b_compute_expressions ... % no longer needed
648 b_compute_expression(Arg1,LocalState,State,SV1,WF),
649 b_compute_expression(Arg2,LocalState,State,SV2,WF),
650 KernelCall =.. [Kernel_predicate,SV1,T1,SV2,T2,WF],
651 kernel_call_predicate(KernelCall,Module,WF,Expression).
652 b_test_atomic_boolean_expression2(Expression,_,LocalState,State,WF) :-
653 functor(Expression,BOP,2),
654 kernel_mappings:binary_boolean_operator(BOP,Module:Kernel_predicate,WFEnabled),!,
655 arg(1,Expression,Arg1), arg(2,Expression,Arg2),
656 ? b_compute_expression(Arg1,LocalState,State,SV1,WF), % TODO: symbolic for some BOP: <:, <<: ?
657 (binary_boolean_operator_trivially_true(BOP,SV1)
658 -> check_well_defined(Arg2,LocalState,State,WF)
659 ? ; b_compute_expression(Arg2,LocalState,State,SV2,WF),
660 ( WFEnabled==yes ->
661 KernelCall =.. [Kernel_predicate,SV1,SV2,WF2],
662 (do_not_enumerate_binary_boolean_operator(BOP,Arg1,Arg2) % we assume: this is only true for WFEnabled predicates
663 -> add_wait_flag_info(WF,wfx_no_enumeration,WF2)
664 ; WF2=WF)
665 ; KernelCall =.. [Kernel_predicate,SV1,SV2], WF2=WF % note: WF2 still used in kernel_call_predicate
666 ),
667 ? kernel_call_predicate(KernelCall,Module,WF2,Expression)
668 ).
669 b_test_atomic_boolean_expression2(E,Info,_LS,_S,_WF) :-
670 add_internal_error('Uncovered boolean expression: ',b(E,pred,Info)),
671 print_functor(E),nl,
672 fail.
673
674
675 binary_boolean_operator_trivially_true(subset,X) :- X==[].
676
677 check_well_defined(Arg,_LocalState,_State,_WF) :-
678 always_well_defined(Arg),!.
679 check_well_defined(Arg,LocalState,State,WF) :-
680 b_compute_expression(Arg,LocalState,State,_,WF).
681
682 %:- use_module(specfile,[animation_minor_mode/1]).
683 :- use_module(b_machine_hierarchy,[abstract_constant/2, concrete_constant/2]).
684 b_test_atomic_equal_boolean_expression(Arg1,Arg2,_Info,LocalState,State,WF) :-
685 Arg1 = b(_,integer,_), preferences:preference(use_clpfd_solver,true),!,
686 (Arg2 = b(_,integer,_) -> true ; add_internal_error('Type error in AST, not wrapped integer: ',Arg2)),
687 ? b_test_arith_equal_boolean_expression(Arg1,Arg2,LocalState,State,WF).
688 b_test_atomic_equal_boolean_expression(Arg1,Arg2,Info,LocalState,State,WF) :-
689 Arg1 = b(_,real,_), use_clpfd_real_solver, do_not_double_check_solution,!,
690 (Arg2 = b(_,real,_) -> true ; add_internal_error('Type error in AST, not wrapped real: ',Arg2)),
691 b_test_real_arith_equal_boolean_expression(Arg1,Arg2,Info,LocalState,State,WF).
692 b_test_atomic_equal_boolean_expression(Arg1,Arg2,Info,LocalState,State,WF) :-
693 ? member(prob_annotation('LAMBDA-EQUALITY'),Info),
694 \+ simple_expression(Arg2),
695 is_lambda_result_id(Arg1), %get_texpr_id(Arg1,'_lambda_result_'), % ensure we have not renamed it to was_lambda_result ?
696 !, % this is an equality for the result of a lambda abstraction; only evaluate at the end
697 b_compute_expression(Arg1,LocalState,State,SV1,WF), % this is the lambda result identifier _lambda_result_
698 %get_enumeration_finished_wait_flag(WF,EWF),
699 %get_wait_flag(10000,lambda_result,WF,EWF),
700 % compute deterministic parts of Arg2 in wf0 phase: avoid computing this stuff over again
701 %print('DELAY: '), translate:print_bexpr(Arg2),nl,
702 ? copy_wf01e_wait_flags(WF,WF2), b_compute_expression(Arg2,LocalState,State,SV2,WF2),
703 get_last_wait_flag(lambda_result,WF,EWF),
704 ground_value_check(SV2,G2),
705 ? when((nonvar(G2);nonvar(SV1);nonvar(EWF)),b_lambda_result_equal_boolean_expression(SV1,SV2,WF,EWF,WF2)).
706 b_test_atomic_equal_boolean_expression(Arg1,Arg2,Info,LocalState,State,WF) :-
707 (LocalState = []
708 -> true % only check if we are at the outer level
709 % (not inside a quantifier,...) or if we have CSE introduzed lazy_lets:
710 ; preferences:preference(use_common_subexpression_elimination,true)
711 % TO DO: check that we have only added @nr to local state from lazy_let; ADD INFO FIELD
712 ),
713 get_texpr_type(Arg1,Type1), is_set_type(Type1,SetType1),
714 % previously we required SetType1 = couple(_,_)
715 get_texpr_id(Arg1,ID),
716 % we could check: \+ get_texpr_id(Arg2,_), we do not need to treat simple equations like ID=ID2; unless for memo?
717 ? (abstract_constant(ID,_) % check if ABSTRACT_CONSTANT
718 -> Kind=abstract,
719 ? kernel_objects:max_cardinality(Type1,MaxCard1),
720 (number(MaxCard1) % check that type is large enough to warrant recursive or symbolic treatment
721 -> (MaxCard1>100 -> true ; constant_variable_marked_as_memo(ID))
722 ; true)
723 ; %fail,
724 ? concrete_constant(ID,_)
725 -> Kind=concrete,
726 (constant_variable_marked_as_expand(ID)
727 -> true % note: we also check for expand annotation in store (expand_closure_value),
728 % but it is useful to expand ID already here to ease checking PROPERTIES
729 ; constant_variable_marked_as_memo(ID))
730 %; b_is_unused_constant(ID) -> ABSTRACT=true % TO DO: check if ID not used somewhere else in Properties ??!!
731 ),
732 % in future: we may do size change analysis, or something like that to check that we have properly defined
733 % recursive function
734 debug_format(19,'Equation defining ~w constant: ~w~n',[Kind,ID]),
735 !,
736 (constant_variable_marked_as_expand(ID) -> SymArg2 = Arg2 ; mark_bexpr_as_symbolic(Arg2,SymArg2)),
737 ? b_add_constant_definition(Kind,ID,Info,Arg1,SetType1,SymArg2,LocalState,State,WF).
738 b_test_atomic_equal_boolean_expression(Arg1,Arg2,Info,LocalState,State,WF) :-
739 constants_profiling_on,
740 get_texpr_id(Arg1,ID),b_is_constant(ID), !,
741 % Note: does not yet keep track of arithmetic equalities above
742 b_compute_expression(Arg1,LocalState,State,SV1,WF),
743 push_constant_def_equality_call_stack(WF,ID,Info,WF2),
744 start_profile(ID,T1),
745 b_compute_expression(Arg2,LocalState,State,SV2,WF2),
746 get_waitflags_phase(WF,Phase),
747 stop_constant_profile(SV2,Phase,ID,[],T1), % normal constant, not symbolic, memoized or recursive
748 start_propagation_profile(ID,T2,CstL1),
749 kernel_call_predicate_equal_object_optimized(SV1,SV2,WF),
750 stop_propagation_profile(SV2,ID,T2,CstL1).
751 b_test_atomic_equal_boolean_expression(Arg1,Arg2,_Info,LocalState,State,WF) :-
752 ? b_compute_expression(Arg1,LocalState,State,SV1,WF),
753 ? b_compute_expression(Arg2,LocalState,State,SV2,WF),
754 ? kernel_call_predicate_equal_object_optimized(SV1,SV2,WF).
755
756
757
758 % treat equality ID = Symbolic Function (or relation/set)
759 b_add_constant_definition(Kind,ID,Info,Arg1,SetType1,SymArg2,LocalState,State,WF) :-
760 % observe CTRL-C: e.g., in data validation models these abstract functions can be very large and costly to compute
761 ? observe_user_interrupt_signal(computing_value_for_abstract_constant(ID),SymArg2,
762 b_add_constant_definition_aux(Kind,ID,Info,Arg1,SetType1,SymArg2,LocalState,State,WF)).
763
764 :- use_module(runtime_profiler,[start_profile/2,
765 stop_constant_profile/5, constants_profiling_on/0]).
766 b_add_constant_definition_aux(Kind,ID,_Info,Arg1,SetType1,SymArg2,LocalState,State,WF) :-
767 preference(use_function_memoization,MemoPref), % true, false or default
768 MemoPref \= false, % turned off
769 ( MemoPref = true, Kind=abstract ;
770 constant_variable_marked_as_memo(ID)), % description(memo) as info field using @desc memo pragma; see
771 !,
772 start_profile(ID,T1),
773 b_compute_expression(Arg1,LocalState,State,SV1,WF), % the identifier
774 (SymArg2 = b(recursive_let(TID,Body),_,_)
775 -> get_texpr_id(TID,RecID),
776 b_compute_expression(Body,[bind(RecID,RedIDVal)|LocalState],State,SV2,WF),
777 RecValue='$recursion_value'(RedIDVal), IDInfo = [recursive_memo]
778 ; b_compute_expression(SymArg2,LocalState,State,SV2,WF),
779 RecValue='$no_recursion', IDInfo = [memoized]
780 ),
781 get_waitflags_phase(WF,Phase), stop_constant_profile(SV2,Phase,ID,IDInfo,T1),
782 (nonvar(SV2), SV2 \= closure(_,_,_)
783 -> % value fully computed; no need to memoize
784 debug_println(19,not_memoizing(ID)),
785 kernel_call_predicate_equal_object_optimized(SV1,SV2,WF)
786 ; (nonvar(SV2) -> mark_closure_as_symbolic(SV2,SV3) ; SV3=SV2),
787 memoization:register_memoization_function(ID,SV3,SetType1,RecValue,MEMOID,SV4),
788 debug_println(19,marking_for_memoization(ID,MEMOID)),
789 kernel_call_predicate_equal_object_optimized(SV1,SV4,WF)
790 ).
791 b_add_constant_definition_aux(_Kind,ID,Info,Arg1,_,SymArg2,LocalState,State,WF) :-
792 start_profile(ID,T1),
793 b_compute_expression(Arg1,LocalState,State,SV1,WF), % the identifier ID
794 push_constant_def_equality_call_stack(WF,ID,Info,WF2),
795 ? b_compute_expression(SymArg2,LocalState,State,SV2,WF2),
796 (constant_variable_marked_as_expand(ID)
797 -> IDInfo = [marked_as_expand],
798 b_expand_compute_comprehension_set(SV2,Info,SV3,WF2)
799 ; definitely_expand_this_explicit_set(SV2) % check for a few patterns which should definitely be expanded;
800 % in case user puts a set accidentally into the ABSTRACT_CONSTANTS section
801 -> IDInfo = [automatic_expand],
802 b_expand_compute_comprehension_set(SV2,Info,SV3,WF2)
803 ; var(SV2) -> IDInfo = [], SV3=SV2
804 ; IDInfo = [], % it is from ABSTRACT_CONSTANTS, but this info is already stored
805 mark_closure_as_symbolic(SV2,SV3)
806 ),
807 get_waitflags_phase(WF,Phase), stop_constant_profile(SV3,Phase,ID,IDInfo,T1),
808 start_propagation_profile(ID,T2,CstL1),
809 ? kernel_call_predicate_equal_object_optimized(SV1,SV3,WF),
810 % profile propagation time and what constants are grounded
811 stop_propagation_profile(SV3,ID,T2,CstL1).
812
813 push_constant_def_equality_call_stack(WF,ID,Pos,WF2) :-
814 ((constants_profiling_on ; get_preference(provide_trace_information,true))
815 -> push_wait_flag_call_stack_info(WF,
816 id_equality_evaluation(ID,constant,Pos),WF2)
817 ; WF2=WF).
818
819 start_propagation_profile(ID,T1,CstL1) :-
820 (constants_profiling_on -> findall(Cst1,det_solution_for_constant_was_stored(Cst1),CstL1) ; CstL1=[]),
821 start_profile(ID,T1).
822 stop_propagation_profile(SV3,ID,T1,CstL1) :-
823 (constants_profiling_on
824 -> findall(Cst2,det_solution_for_constant_was_stored(Cst2),L2),
825 append(CstL1,New,L2), debug_format(9,'Propagation of value for ~w instantiated ~w~n',[ID,New]),
826 IDInfo2 = [instantiates(New)]
827 ; IDInfo2 = []),
828 stop_constant_profile(SV3,propagate_value,ID,IDInfo2,T1).
829
830 % treat not(Arg1 = Arg2) predicates
831 b_test_atomic_not_equal_boolean_expression(Arg1,Arg2,_Info,LocalState,State,WF) :-
832 get_texpr_type(Arg1,boolean),!, % special treatment : not_equal_object has no type information
833 b_compute_expression(Arg1,LocalState,State,B1,WF),
834 b_compute_expression(Arg2,LocalState,State,B2,WF),
835 negate(B1,B2). % from bool_pred
836 b_test_atomic_not_equal_boolean_expression(Arg1,Arg2,_Info,LocalState,State,WF) :-
837 get_texpr_type(Arg1,integer),
838 preferences:preference(use_clpfd_solver,true),
839 !,
840 % Note: calling b_compute_arith_expression will also instantiate a variable to at least the int(_) skeleton; thereby enabling propagation
841 % this is potentially better than calling the default versions of the predicates, which may wait until the int(_) skeleton is set up before propagation
842 ? b_compute_arith_expression(Arg1,LocalState,State,CLPFD_Expr1,WF),
843 ? b_compute_arith_expression(Arg2,LocalState,State,CLPFD_Expr2,WF),
844 clpfd_interface:clpfd_neq_expr(CLPFD_Expr1,CLPFD_Expr2).
845 b_test_atomic_not_equal_boolean_expression(Arg1,Arg2,_Info,LocalState,State,WF) :-
846 ? b_compute_expression_symbolic(Arg1,LocalState,State,SV1,WF),
847 ? b_compute_expression_symbolic(Arg2,LocalState,State,SV2,WF),
848 ? kernel_call_predicate_not_equal_object(SV1,SV2,WF,not_equal(Arg1,Arg2)).
849 % Note: symbolic case occurs for symbolic abstract constants f when using DOUBLE_EVALUATION
850 % in the evaluation view which are defined by f = %x... when checking f /=
851
852 % a version of b_compute_expression which does not try to expand comprehension sets
853 % TODO: deal with other constructs which merit symbolic treatment; union of comprehension sets, ...
854 % (see line 147 in AMASS_mchs/oriented_abscissa.mch)
855 b_compute_expression_symbolic(Arg,LocalState,State,Val,WF) :-
856 (Arg = b(comprehension_set(PP,CC),_,InfoCS) % second arg is a comprehension set;
857 -> % write(symbolic(PP)),nl,
858 ? b_compute_comprehension_set_symbolic(PP,CC,InfoCS,LocalState,State,Val,WF)
859 ? ; b_compute_expression(Arg,LocalState,State,Val,WF)
860 ).
861 % ditto for already de-constructed b/3 expression:
862 b_compute_expression2_symbolic(comprehension_set(PP,CC),_,InfoCS,LocalState,State,Val,WF) :- !,
863 b_compute_comprehension_set_symbolic(PP,CC,InfoCS,LocalState,State,Val,WF).
864 b_compute_expression2_symbolic(Arg,Type,Info,LocalState,State,Val,WF) :-
865 b_compute_expression2(Arg,Type,Info,LocalState,State,Val,WF).
866
867 simple_expression(b(A,_,_)) :- simple_expression_aux(A).
868 simple_expression_aux(boolean_true).
869 simple_expression_aux(boolean_false).
870 simple_expression_aux(empty_set).
871 simple_expression_aux(empty_sequence).
872 simple_expression_aux(integer(_)).
873 simple_expression_aux(max_int).
874 simple_expression_aux(min_int).
875 simple_expression_aux(string(_)).
876 simple_expression_aux(value(_)).
877
878
879 is_lambda_result_id(b(identifier('_lambda_result_'),_,_)).
880 % at the moment we only detect those identifiers; the info field is currently not updated for _was_lambda_result_
881 % and not available in other treatmens of _lambda_result_ (in b_enumerate)
882 %is_lambda_result_id(b(identifier(X),_,Info)) :-
883 % memberchk(lambda_result,Info).
884 % (X=='_lambda_result_' -> (memberchk(lambda_result,Info) -> true ; format('~n*** _lambda_result_ without info: ~w~n~N',[Info])) ; memberchk(lambda_result,Info)).
885
886 %:- block b_lambda_result_equal_boolean_expression(-,?,?, -,?). % we now use when above
887 % only compute lambda result when finished finding domain element, i.e., _EWF is grounded
888 b_lambda_result_equal_boolean_expression(SV1,SV2,WF,EWF,WF2) :-
889 ? kernel_call_predicate_equal_object_optimized(SV1,SV2,WF),
890 % print(' LAMBDA : '), print((SV1,_EWF)),nl,
891 % the inner waitflags are for evaluating the lambda_result Expression; unless there is a WD issue this should
892 % never fail; we can delay the enumeration as much as possible
893 % NOTE: even if SV2 is ground, Arg2 may not be (e.g., if Arg2 = prj2(..,..)(NotGr,Ground))
894 ? blocking_ground_copied_wait_flags(WF2,EWF). % without when we will ground WF0 which is shared with outer WF-store
895 :- block blocking_ground_copied_wait_flags(?,-).
896 blocking_ground_copied_wait_flags(WF2,_) :-
897 ? ground_constraintprop_wait_flags(WF2). % do not ground EF flag, as shared with outer WF and WF2 is copied
898
899 % TO DO: add avl_set+closure expansion
900 %b_test_member_expression(Expr,El,_Set,_LocalState,_State,_WF) :-
901 % print('test member: '),print_bexpr(Expr),nl,fail.
902 b_test_member_expression(TElem,b(Set,Type,Info),LocalState,State,WF) :-
903 ? b_test_member_expression2(Set,Type,Info,TElem,LocalState,State,WF).
904
905 % new profiler
906 %:- use_module('../extensions/profiler/profiler.pl').
907 %:- use_module('../extensions/profiler/profiler_te.pl').
908 %:- enable_profiling(b_test_member_expression2/7).
909
910 % old profiler
911 %:- use_module(covsrc(hit_profiler)).
912
913 b_test_member_expression2(comprehension_set(Par,Cond),_Type,_Info,El,LocalState,State,WF) :-
914 % used to call in next clause below: b_generate_closure_if_necessary(Par,Cond,LocalState,State,SetValue,WF) /* will not expand closure */
915 /* optimized case for dealing with comprehension_set ; however, does not seem to buy anything over older version with b_generate_closure_if_necessary in test 1079 */
916 /* new version buys about 6 % for {x| x:1..400000 & x:{n|n >= 9000 & n<= 600000 & n mod 100 = 0}} (Sep 3 2014) */
917 set_up_typed_localstate(Par,ValueList,_TypedVals,LocalState,NewLocalState,positive),
918 !,
919 convert_list_into_pairs(ValueList,ElementVal),
920 b_compute_expression(El,LocalState,State,ElementVal,WF),
921 b_test_boolean_expression(Cond,NewLocalState,State,WF).
922 b_test_member_expression2(SymbolicSetConstant,_Type,_Info,El,LocalState,State,WF) :-
923 %hit_profiler:add_profile_hit(SymbolicSetConstant),
924 cst_in_boolean_type(SymbolicSetConstant,Module:Kernel_predicate),!, % two cases : string_set and integer_set
925 b_compute_expression(El,LocalState,State,ElValue,WF),
926 functor(KernelCall,Kernel_predicate,2),
927 arg(1,KernelCall,ElValue),
928 arg(2,KernelCall,WF),
929 % print_message(cst_in_boolean_type_call(KernelCall)),
930 kernel_call_predicate(KernelCall,Module,WF,SymbolicSetConstant). % should be member(... SymbolicSetConstant)
931 b_test_member_expression2(Expression,_Type,Info,El,LocalState,State,WF) :-
932 functor(Expression,BOP,2),
933 binary_in_boolean_type(BOP,Module:Kernel_predicate),!,
934 b_compute_expression(El,LocalState,State,ElValue,WF),
935 arg(1,Expression,Arg1),arg(2,Expression,Arg2),
936 (binary_in_definitely_true(BOP,ElValue)
937 -> % no need to compute arguments; unless required for WD:
938 check_well_defined(Arg1,LocalState,State,WF),
939 check_well_defined(Arg2,LocalState,State,WF)
940 ; b_compute_expression(Arg1,LocalState,State,SV1,WF),
941 ? b_compute_expression(Arg2,LocalState,State,SV2,WF),
942 opt_push_wait_flag_call_stack_info(WF,b_operator_call(member,[ElValue,b_operator(BOP,[SV1,SV2])],Info),WF2),
943 % for constant profiling: we could catch partial/total_fun checks here translate:print_bexpr(El),nl,translate:print_bexpr(b(Expression,_Type,Info)),nl,nl,
944 ? binary_in_kernel_call(Module,Kernel_predicate,ElValue,SV1,SV2,WF2,Expression)
945 ).
946 b_test_member_expression2(Expression,_Type,Info,El,LocalState,State,WF) :-
947 functor(Expression,UnOP,1),
948 unary_in_boolean_type(UnOP,Module:Kernel_predicate),!,
949 b_compute_expression(El,LocalState,State,ElValue,WF),
950 arg(1,Expression,Arg1),
951 (unary_in_definitely_true(UnOP,ElValue)
952 -> % no need to compute arguments; unless required for WD:
953 check_well_defined(Arg1,LocalState,State,WF)
954 ? ; b_compute_expression(Arg1,LocalState,State,SV1,WF),
955 opt_push_wait_flag_call_stack_info(WF,b_operator_call(member,[ElValue,b_operator(UnOP,[SV1])],Info),WF2),
956 ? unary_in_kernel_call(Module,Kernel_predicate,ElValue,SV1,WF2,Expression)
957 ).
958 b_test_member_expression2(SetExpression,Type,Info,El,LocalState,State,WF) :-
959 ? b_compute_expression2(SetExpression,Type,Info,LocalState,State,SetValue,WF),
960 (always_well_defined_or_disprover_mode(El)
961 -> SetValue \== [] % if we have the empty set: check_element will always fail
962 ; true % we could check SetValue \== [] if find_abort_values=false ??
963 ),
964 ? b_compute_expression(El,LocalState,State,Element,WF),
965 Span = El, % Info is quite often the empty list
966 (not_invertible(El) % then no sense in setting up member constraint f(...) : SetValue ;
967 % we cannot used the info anyway; but we could enumerate
968 -> % we wait until Element is fully known before doing the check
969 ground_value_check(Element,GrEl),
970 ? when(nonvar(GrEl),kernel_call_predicate_check_element_of_wf(Element,SetValue,WF,Span))
971 ? ; kernel_call_predicate_check_element_of_wf(Element,SetValue,WF,Span)).
972
973 :- use_module(external_functions,[external_fun_can_be_inverted/1]).
974 not_invertible(b(E,_,_)) :- not_inv_aux(E).
975 not_inv_aux(external_function_call(FunName,_Args)) :- \+ external_fun_can_be_inverted(FunName).
976 % TO DO: capture other cases like function applications
977 % TO DO: also do this in b_interpreter_check ?
978 % TO DO: We should compute this information in ast_cleanup; e.g., what if we do STRING_TO_INT(s)+1 : SET
979
980 % TO DO: >>> 2:{x,v} --> special case for set_extension([b(identifier(x),integer,[nodeid(none)]),b(identifier(v),integer,[nodeid(none)])]) --> 2=x or 2=v --> evaluate [x,v] -> sort and then use list member (or should b_ast_cleanup do this) ?
981
982 :- use_module(kernel_lists,[not_element_of_list_wf/3]).
983 b_test_notmember_expression(set_extension(Ex),El,_Set,_,LocalState,State,WF) :- !,
984 b_compute_expressions(Ex,LocalState,State,ExValueList,WF),
985 b_compute_expression(El,LocalState,State,ElementVal,WF),
986 not_element_of_list_wf(ElementVal,ExValueList,WF).
987 b_test_notmember_expression(SymbolicSetCst,El,_Set,_,LocalState,State,WF) :-
988 kernel_mappings:cst_not_in_boolean_type(SymbolicSetCst,Module:Kernel_predicate),!,
989 b_compute_expression(El,LocalState,State,ElValue,WF),
990 functor(KernelCall,Kernel_predicate,1),
991 arg(1,KernelCall,ElValue),
992 % debug_print(cst_not_in_boolean_type(9,KernelCall)),
993 kernel_call_predicate(KernelCall,Module,WF,SymbolicSetCst).
994 b_test_notmember_expression(Expression,El,_Set,Info,LocalState,State,WF) :-
995 functor(Expression,BOP,2),
996 kernel_mappings:binary_not_in_boolean_type(BOP,Module:Kernel_predicate),!,
997 b_compute_expression(El,LocalState,State,ElValue,WF),
998 \+ binary_in_definitely_true(BOP,ElValue),
999 arg(1,Expression,Arg1),arg(2,Expression,Arg2),
1000 b_compute_expression(Arg1,LocalState,State,SV1,WF),
1001 b_compute_expression(Arg2,LocalState,State,SV2,WF),
1002 % KernelCall =.. [Kernel_predicate,ElValue,SV1,SV2,WF],
1003 opt_push_wait_flag_call_stack_info(WF,b_operator_call(not_member,[ElValue,b_operator(BOP,[SV1,SV2])],Info),WF2),
1004 ? kernel_call_predicate3(Kernel_predicate,ElValue,SV1,SV2,Module,WF2,Expression).
1005 b_test_notmember_expression(Expression,El,_Set,Info,LocalState,State,WF) :-
1006 functor(Expression,UnOP,1),
1007 unary_not_in_boolean_type(UnOP,Module:Kernel_predicate),!,
1008 b_compute_expression(El,LocalState,State,ElValue,WF),
1009 \+ unary_in_definitely_true(UnOP,ElValue),
1010 arg(1,Expression,Arg1),
1011 b_compute_expression(Arg1,LocalState,State,SV1,WF),
1012 %KernelCall =.. [Kernel_predicate,ElValue,SV1,WF],
1013 %kernel_call_predicate(KernelCall,Module,WF,Expression).
1014 opt_push_wait_flag_call_stack_info(WF,b_operator_call(not_member,[ElValue,b_operator(UnOP,[SV1])],Info),WF2),
1015 kernel_call_predicate2(Kernel_predicate,ElValue,SV1,Module,WF2,Expression).
1016 b_test_notmember_expression(Expr,Elem,Set,_Info,LocalState,State,WF) :-
1017 (Expr=comprehension_set(Par,Cond)
1018 -> b_generate_closure_if_necessary(Par,Cond,LocalState,State,SetValue,WF) /* will not expand closure */
1019 ; b_compute_expression(Set,LocalState,State,SetValue,WF)
1020 ),
1021 (SetValue == []
1022 -> /* nothing can be member of empty set */
1023 check_well_defined(Elem,LocalState,State,WF)
1024 % we could disable this check if find_abort_values=true
1025 ; b_compute_expression(Elem,LocalState,State,ElemValue,WF),
1026 %kernel_call_predicate2(not_element_of_wf,ElemValue,SetValue,kernel_objects,WF,Expr)
1027 %kernel_call_predicate(not_element_of_wf(ElemValue,SetValue,WF),kernel_objects,WF,Expr)
1028 kernel_call_predicate_not_element_of_wf(ElemValue,SetValue,WF)
1029 ).
1030
1031 :- block block_test_implication(?,?,?,?,?,-).
1032 block_test_implication(LHS,RHS,LocalState,State,WF,_WF2) :-
1033 ? b_test_inner_boolean_expression(LHS,LocalState,State,WF),
1034 b_test_inner_boolean_expression(RHS,LocalState,State,WF).
1035 block_test_implication(LHS,_RHS,LocalState,State,WF,_WF2) :-
1036 b_not_test_inner_boolean_expression(LHS,LocalState,State,WF).
1037
1038
1039 b_test_equivalence(LHS,RHS,LocalState,State,WF,Ai,Ao) :-
1040 copy_wf_start(WF,equivalence,CWF),
1041 if(b_check_boolean_expression(LHS,LocalState,State,CWF,PredRes,Ai,Aii),
1042 ? (b_check_test_equivalence(PredRes,LHS,RHS,LocalState,State,CWF,Aii,Ao),
1043 copy_wf_finish(WF,CWF)),
1044 (% check LHS fails, We could check if RHS can be checked with b_check_boolean_expression
1045 Ai=Ao, get_binary_choice_wait_flag(equivalence,WF,WF2),
1046 b_enum_test_equivalence(LHS,RHS,LocalState,State,WF,WF2,Ai))).
1047 b_not_test_equivalence(LHS,RHS,LocalState,State,WF,Ai,Ao) :-
1048 copy_wf_start(WF,not_equivalence,CWF),
1049 if(b_check_boolean_expression(LHS,LocalState,State,CWF,PredRes,Ai,Aii),
1050 (negate(PredRes,NegPredRes), % from bool_pred
1051 ? b_check_test_equivalence(NegPredRes,LHS,RHS,LocalState,State,CWF,Aii,Ao),
1052 copy_wf_finish(WF,CWF)),
1053 (% check LHS fails, We could check if RHS can be checked with b_check_boolean_expression
1054 Ai=Ao, get_binary_choice_wait_flag(not_equivalence,WF,WF2),
1055 b_enum_not_test_equivalence(LHS,RHS,LocalState,State,WF,WF2,Ai))).
1056 b_check_test_equivalence(PredRes,LHS,RHS,LocalState,State,WF,Aii,Ao) :-
1057 % print('checking <=> '), print_bexpr(LHS), print(' '), print(PredRes),nl,
1058 ? (var(PredRes),b_check_boolean_expression(RHS,LocalState,State,WF,PredRes2,Aii,Ao) % TO DO <---- REPLACE CUT
1059 -> /* also propagate from right to left */
1060 ? equiv_bidrectional_test_boolean_expression(PredRes,PredRes2,LHS,RHS,LocalState,State,WF)
1061 ; Aii=Ao,
1062 ? equiv_test_boolean_expression(PredRes,pred_true,RHS,LocalState,State,WF,Aii)
1063 ). % should we also add a binary choice flag ?? what about a=2 <=> b/=3 ??
1064
1065 :- block b_enum_test_equivalence(?,?,?,?,?,-,?).
1066 b_enum_test_equivalence(LHS,RHS,LocalState,State,WF,_WF2,Ai) :-
1067 b_test_boolean_expression(LHS,LocalState,State,WF,Ai,Aii), % TO DO: we could call b_test_inner_boolean_expression with Ai
1068 b_test_boolean_expression(RHS,LocalState,State,WF,Aii,_).
1069 b_enum_test_equivalence(LHS,RHS,LocalState,State,WF,_WF2,Ai) :-
1070 b_not_test_boolean_expression(LHS,LocalState,State,WF,Ai,Aii),
1071 b_not_test_boolean_expression(RHS,LocalState,State,WF,Aii,_).
1072
1073 %enumerate_bool(X,WF) :- !.
1074 enumerate_bool(X,Prio,WF) :- (nonvar(X) -> true /* already set */
1075 ; get_wait_flag0(WF,WF0),
1076 enumerate_bool0(X,Prio,WF,WF0)).
1077
1078 :- block enumerate_bool0(?,?,?,-).
1079 enumerate_bool0(X,Prio,WF,_) :- (nonvar(X) -> true /* already set */
1080 ; %print(enum_bool(X)), translate:print_bexpr(LHS),nl,
1081 % get_binary_choice_wait_flag(enumerate_bool,WF,WF2),
1082 get_wait_flag(Prio,enumerate_bool,WF,WF2), % what priority should we use ?? give time for other enumerators to decide the lhs of the disjunct; actions_cbtc is slower to setup with low priority
1083 enumerate_bool_aux(X,WF2)).
1084 :- block enumerate_bool_aux(-,-).
1085 %enumerate_bool_aux(P,WF) :- var(P),print(forcing_bool(P,WF)),nl,fail. %
1086 enumerate_bool_aux(pred_true,_).
1087 enumerate_bool_aux(pred_false,_).
1088
1089 :- block b_test_disjunction(?,?,?,?,?,-,?).
1090 b_test_disjunction(LHS,_RHS,LocalState,State,WF,_WF2,Ai) :-
1091 ? b_test_boolean_expression(LHS,LocalState,State,WF,Ai,_).
1092 b_test_disjunction(LHS,RHS,LocalState,State,WF,_WF2,Ai) :-
1093 ? b_not_test_boolean_expression(LHS,LocalState,State,WF,Ai,Aii),
1094 ? b_test_boolean_expression(RHS,LocalState,State,WF,Aii,_).
1095
1096 :- block b_not_test_conjunction(?,?,?,?,?,-,?).
1097 b_not_test_conjunction(LHS,_RHS,LocalState,State,WF,_WF2,Ai) :-
1098 ? b_not_test_boolean_expression(LHS,LocalState,State,WF,Ai,_).
1099 b_not_test_conjunction(LHS,RHS,LocalState,State,WF,_WF2,Ai) :-
1100 ? b_test_boolean_expression(LHS,LocalState,State,WF,Ai,Aii),
1101 ? b_not_test_boolean_expression(RHS,LocalState,State,WF,Aii,_).
1102
1103 :- block b_enum_not_test_equivalence(?,?,?,?,?,-,?).
1104 b_enum_not_test_equivalence(LHS,RHS,LocalState,State,WF,_WF2,Ai) :-
1105 b_test_boolean_expression(LHS,LocalState,State,WF,Ai,Aii), % we could call b_test_inner_boolean_expression with Ai
1106 b_not_test_boolean_expression(RHS,LocalState,State,WF,Aii,_).
1107 b_enum_not_test_equivalence(LHS,RHS,LocalState,State,WF,_WF2,Ai) :-
1108 b_not_test_boolean_expression(LHS,LocalState,State,WF,Ai,Aii),
1109 b_test_boolean_expression(RHS,LocalState,State,WF,Aii,_).
1110
1111
1112
1113 /* --------------------------------------*/
1114 /* b_not_test_boolean_expression */
1115 /* --------------------------------------*/
1116
1117 b_not_test_list_of_boolean_expression([],_,_,_WF).
1118 b_not_test_list_of_boolean_expression([B1|T],LS,S,WF) :-
1119 b_not_test_boolean_expression(B1,LS,S,WF),
1120 b_not_test_list_of_boolean_expression(T,LS,S,WF).
1121
1122 :- assert_pre(b_interpreter:b_not_test_boolean_expression_cs(E,LS,S,_,_),
1123 (bsyntaxtree:check_if_typed_predicate(E),type_check(LS,store),type_check(S,store))).
1124 :- assert_post(b_interpreter:b_not_test_boolean_expression_cs(_,_,_,_,_), true).
1125
1126
1127 % a version where we can provide an initial call stack entry for context
1128 b_not_test_boolean_expression_cs(E,LS,S,PredKind,Nr) :-
1129 init_wait_flags_cs(E,PredKind,Nr,b_not_test_boolean_expression_cs,WF), % TODO: we could register negation info
1130 % TO DO: call b_trace_test_components ?
1131 ? b_not_test_boolean_expression(E,LS,S,WF),
1132 ? ground_wait_flags(WF).
1133
1134 b_not_test_boolean_expression(E,LS,S,WF) :-
1135 ? empty_avl(Ai), b_not_test_boolean_expression(E,LS,S,WF,Ai,_).
1136
1137 :- assert_pre(b_interpreter:b_not_test_boolean_expression(E,LS,S,WF),
1138 (type_check(E,boolean_expression),type_check(LS,store),type_check(S,store), type_check(WF,wait_flag))).
1139 :- assert_post(b_interpreter:b_not_test_boolean_expression(_,_,_,_), true).
1140
1141 :- if(environ(prob_debug_watch_flag,true)).
1142 b_not_test_boolean_expression(b(Expr,_,Infos),LS,S,WF,Ai,Ao) :- !,
1143 (waitflag0_is_set(WF)
1144 -> debug:watch(400,b_interpreter:b_not_test_boolean_expression2(Expr,Infos,LS,S,WF,Ai,Ao))
1145 ; debug:watch_det(400,b_interpreter:b_not_test_boolean_expression2(Expr,Infos,LS,S,WF,Ai,Ao)) ).
1146 :- else.
1147 b_not_test_boolean_expression(b(Expr,Type,Infos),LS,S,WF,Ai,Ao) :- !,
1148 (preference(smt_supported_interpreter,true)
1149 -> b_not_test_boolean_expression2(Expr,Infos,LS,S,WF,Ai,Ao),create_negation(b(Expr,Type,Infos),Neg),
1150 get_wait_flag1(smt_call,WF,BeforeEnumWF),
1151 gensym:gensym(smt_assertion_name,Symbol),
1152 smt_add_predicate(BeforeEnumWF,Neg,LS,S,Symbol)
1153 ? ; b_not_test_boolean_expression2(Expr,Infos,LS,S,WF,Ai,Ao)).
1154 :- endif.
1155 b_not_test_boolean_expression(E,LS,S,WF,Ai,Ao) :-
1156 add_internal_error('Boolean (not) expression not properly wrapped: ',
1157 b_not_test_boolean_expression(E,LS,S,WF,Ai,Ao)),
1158 b_not_test_boolean_expression2(E,[],LS,S,WF,Ai,Ao).
1159
1160 b_not_test_boolean_expression2(truth,_,_,_,_WF,_Ai,_Ao) :- !,fail.
1161 b_not_test_boolean_expression2(falsity,_,_,_,_WF,Ai,Ao) :- !,Ai=Ao. % NOT COVERED (2)
1162 b_not_test_boolean_expression2(negation(BExpr),_,LocalState,State,WF,Ai,Ao) :- !,
1163 ? b_test_boolean_expression(BExpr,LocalState,State,WF,Ai,Ao).
1164 % following makes test 349 fail:
1165 %b_not_test_boolean_expression2(conjunct(LHS,RHS),Infos,LocalState,State,WF,Ai,Ao) :- !,
1166 % nl, print(' NOT: '),translate:print_bexpr(b(conjunct(LHS,RHS),pred,Infos)),nl,
1167 % create_negation(LHS,NegLHS), % TO DO: avoid this construction by generalising code for disjunct
1168 % create_negation(RHS,NegRHS),
1169 % b_test_boolean_expression2(disjunct(NegLHS,NegRHS),Infos,LocalState,State,WF,Ai,Ao).
1170 b_not_test_boolean_expression2(conjunct(LHS,RHS),Infos,LocalState,State,WF,Ai,Ao) :- !,
1171 b(conjunct(LHS,RHS),pred,Infos) = Conj,
1172 copy_wf_start(WF,not_conjunct,CWF),
1173 ? if(b_check_boolean_expression(Conj,LocalState,State,CWF,PredRes,Ai,Ao),
1174 (PredRes=pred_false,
1175 ? copy_wf_finish(WF,CWF)
1176 ),
1177 ? if(b_check_boolean_expression(LHS,LocalState,State,CWF,LHSPredRes,Ai,Ao), % some redundant work with call above: TODO: avoid !
1178 (copy_wf_finish(WF,CWF),
1179 get_last_wait_flag(not_conjunct_rhs,WF,WF2), % before starting to enumerate infinite types: better try both possibilities:
1180 ? b_not_test_conjunction_rhs(LHSPredRes,RHS,LocalState,State,WF,Ai,WF2)
1181 ),
1182 (Ai=Ao,
1183 get_priority_of_boolean_expression2(disjunct(LHS,RHS),StartPrio),
1184 %get_wait_flag(Prio,not_conjunct,WF,WF2),
1185 get_binary_choice_wait_flag_exp_backoff(StartPrio,not_conjunct,WF,WF2),
1186 % TO DO: we could check if LHS or RHS are registered in Ai as pred_true/pred_false ??
1187 b_not_test_conjunction(LHS,RHS,LocalState,State,WF,WF2,Ai))
1188 )
1189 ).
1190
1191 b_not_test_boolean_expression2(implication(LHS,RHS),_,LocalState,State,WF,Ai,Ao) :- !,
1192 b_test_boolean_expression(LHS,LocalState,State,WF,Ai,Aii),
1193 ? b_not_test_boolean_expression(RHS,LocalState,State,WF,Aii,Ao).
1194 b_not_test_boolean_expression2(equivalence(LHS,RHS),_,LocalState,State,WF,Ai,Ao) :- !,
1195 ? b_not_test_equivalence(LHS,RHS,LocalState,State,WF,Ai,Ao).
1196 b_not_test_boolean_expression2(disjunct(LHS,RHS),_,LocalState,State,WF,Ai,Ao) :- !,
1197 ? b_not_test_boolean_expression(LHS,LocalState,State,WF,Ai,Aii),
1198 ? b_not_test_boolean_expression(RHS,LocalState,State,WF,Aii,Ao).
1199 b_not_test_boolean_expression2(lazy_let_pred(Id,AssignmentExpr,Expr),_I,LocalState,State,WF,Ai,Ao) :- !,
1200 add_lazy_let_id_and_expression(Id,AssignmentExpr,LocalState,State,NewLocalState,WF,Ai),
1201 b_not_test_boolean_expression(Expr,NewLocalState,State,WF,Ai,Ao). % we could use Ai,Ao version as lazy lets never interfere with each other and never invalidate existing expressions
1202 b_not_test_boolean_expression2(lazy_lookup_pred(Id),_Info,LocalState,_State,WF,Ai,Ao) :- !, Ai=Ao,
1203 lookup_value_for_existing_id_wf(Id,LocalState,(Trigger,Value),WF), % should normally only occur in LocalState; value introduced by lazy_let
1204 (Trigger,Value) = (pred_true,pred_false). % force evaluation
1205 b_not_test_boolean_expression2(value(PredVal),_Info,_LocalState,_State,_WF,Ai,Ao) :- !, % this can occur when lazy_lookup_pred gets compiled by b_compiler
1206 is_pred_false(PredVal),Ai=Ao.
1207 b_not_test_boolean_expression2(Expr,Info,LocalState,State,WF,Ai,Ao) :-
1208 % TO DO: we could put some of the operators into the Ai store (comparison operators)
1209 ? b_not_test_atomic_boolean_expression2(Expr,Info,LocalState,State,WF,Ai,Ao).
1210
1211 % Other boolean expressions, not involving boolean connectives
1212 b_not_test_atomic_boolean_expression2(exists(Parameters,RHS),Infos,LocalState,State,WF,Ai,Ao) :- !,
1213 /* #ID.(RHS) */
1214 Ai=Ao,
1215 ? b_not_test_exists(Parameters,RHS,Infos,LocalState,State,compile,WF).
1216 b_not_test_atomic_boolean_expression2(forall(Parameters,LHS,RHS),Infos,LocalState,State,WF,Ai,Ao) :- !,
1217 /* !ID.(LHS => RHS) */
1218 Ai=Ao,
1219 safe_create_texpr(negation(RHS),pred,Negation),
1220 conjunct_predicates_with_pos_info(LHS,Negation,Condition),
1221 % conjunct_predicates merges the used_ids Info in Condition
1222 ? b_test_exists(Parameters,Condition,Infos,LocalState,State,WF).
1223 /* TODO(DP, 2.8.2008): Extension for Z: a let-statement as predicate */
1224 b_not_test_atomic_boolean_expression2(let_predicate(Ids,AssignmentExprs,Pred),Infos,LocalState,State,WF,Ai,Ao) :-
1225 !,Ai=Ao, % any expression inside the LET cannot be safely reused
1226 ? set_up_localstate_for_let(Ids,ParaValues,AssignmentExprs,LocalState,State,LetState,WF),
1227 opt_push_wait_flag_call_stack_quantifier_info(WF,let_quantifier,Ids,ParaValues,Infos,WF2),
1228 ? b_not_test_boolean_expression(Pred,LetState,State,WF2). % NOT COVERED (10)
1229 /* TODO(DP, 2.8.2008): */
1230 b_not_test_atomic_boolean_expression2(freetype_case(Freetype,Case,Expr),_,LocalState,State,WF,Ai,Ao) :-
1231 !,Ai=Ao,b_compute_expression(Expr,LocalState,State,freeval(Freetype,RealCase,_),WF),
1232 dif(RealCase,Case). % NOT COVERED (11)
1233 b_not_test_atomic_boolean_expression2(finite(SetExpr),_,LocalState,State,WF,Ai,Ao) :-
1234 !, Ai=Ao,b_compute_expression(SetExpr,LocalState,State,Value,WF),
1235 kernel_call_predicate(is_infinite_set_wf(Value,WF),kernel_objects,WF,finite(SetExpr)).
1236 /* Extension for Kodkod */
1237 b_not_test_atomic_boolean_expression2(kodkod(ProblemId,_),_,LocalState,State,WF,Ai,Ao) :-
1238 !,Ai=Ao,get_wait_flag1(kodkod_negative_call,WF,WF0),
1239 kodkod_request(ProblemId,neg,LocalState,State,WF0). % NOT COVERED (12)
1240 b_not_test_atomic_boolean_expression2(partition(LHS,RHS),Info,LocalState,State,WF,Ai,Ao) :- !,
1241 b_interpreter_check:register_predicate(partition(LHS,RHS),Info,pred_false,Reused,Ai,Ao),
1242 (Reused==true -> true
1243 ; b_compute_expression(LHS,LocalState,State,SV1,WF),
1244 l_compute_expression(RHS,LocalState,State,SV2,WF), % RHS is Prolog list of expressions
1245 kernel_call_predicate(not_partition_wf(SV1,SV2,WF),kernel_objects,WF,partition(LHS,RHS))
1246 ).
1247 b_not_test_atomic_boolean_expression2(external_pred_call(FunName,Args),Info,LocalState,State,WF,Ai,Ao) :-
1248 !, Ai=Ao,
1249 (do_not_evaluate_args(FunName) -> EvaluatedArgs=[]
1250 ; b_compute_expressions(Args, LocalState,State, EvaluatedArgs, WF)),
1251 push_wait_flag_call_stack_info(WF,external_call(FunName,EvaluatedArgs,Info),WF2),
1252 call_external_predicate(FunName,Args,EvaluatedArgs,LocalState,State,pred_false,Info,WF2).
1253 b_not_test_atomic_boolean_expression2(Pred,Info,LocalState,State,WF,Ai,Ao) :-
1254 b_interpreter_check:register_predicate(Pred,Info,pred_false,Reused,Ai,Ao),
1255 (Reused==true
1256 -> %% print('REUSED (not): '), translate:print_bexpr(Pred),nl,
1257 true
1258 ? ; b_not_test_atomic_boolean_expression3(Pred,Info,LocalState,State,WF)).
1259 b_not_test_atomic_boolean_expression3(Expression,Info,LocalState,State,WF) :-
1260 functor(Expression,BOP,2),
1261 ? kernel_mappings:negate_binary_boolean_operator(BOP,NBOP),
1262 arg(1,Expression,Arg1),arg(2,Expression,Arg2),!,
1263 NExpression =.. [NBOP,Arg1,Arg2],
1264 ? b_test_atomic_boolean_expression2(NExpression,Info,LocalState,State,WF).
1265 b_not_test_atomic_boolean_expression3(Expression,Info,LocalState,State,WF) :-
1266 functor(Expression,BOP,2),
1267 kernel_mappings:negate_binary_boolean_operator_swap(BOP,NBOP),
1268 arg(1,Expression,Arg1),arg(2,Expression,Arg2),!,
1269 NExpression =.. [NBOP,Arg2,Arg1],
1270 b_test_atomic_boolean_expression2(NExpression,Info,LocalState,State,WF).
1271 b_not_test_atomic_boolean_expression3(E,_,_,_,_WF) :-
1272 add_internal_error('Uncovered boolean expression (not): ',E),
1273 print_functor(E),nl,fail.
1274
1275
1276 % test RHS of not-conjunction depending on outcome of LHS
1277 :- block b_not_test_conjunction_rhs(-,?,?,?,?,?,-).
1278 b_not_test_conjunction_rhs(pred_false,_RHS,_LocalState,_State,_WF,_Ai,_LWF).
1279 b_not_test_conjunction_rhs(pred_true,RHS,LocalState,State,WF,Ai,_LWF) :-
1280 ? b_not_test_boolean_expression(RHS,LocalState,State,WF,Ai,_).
1281
1282 /* -----------------------------*/
1283 /* b_compute_expression */
1284 /* -----------------------------*/
1285
1286
1287
1288 :- assert_must_succeed((b_interpreter:b_compute_expression(b(pow_subset(
1289 b(identifier(nm),set(integer),[])),set(set(integer)),[]),
1290 [], [bind(nm,[])],R,_WF),
1291 nonvar(R), custom_explicit_sets:expand_custom_set_to_list(R,[[]]))).
1292 :- assert_must_succeed((b_interpreter:b_compute_expression(b(pow_subset(
1293 b(identifier(nm),set(boolean),[])),set(set(boolean)),[]),[],
1294 [bind(nm,[pred_false /* bool_false */])],R,_WF),
1295 nonvar(R), custom_explicit_sets:expand_custom_set_to_list(R,ER),
1296 kernel_objects:equal_object(ER,[[pred_false /* bool_false */],[]]))).
1297
1298 :- assert_pre(b_interpreter:b_compute_expression(Exp,LS,State,_Val,WF),
1299 (nonvar(Exp),
1300 bsyntaxtree:check_if_typed_expression(Exp),
1301 type_check(LS,store),type_check(State,store), type_check(WF,wait_flag))).
1302 :- assert_post(b_interpreter:b_compute_expression(_E,_LS,_State,Val,WF),
1303 (b_interpreter:value_type(Val), type_check(WF,wait_flag))). %, nonvar(Val)
1304
1305 b_compute_expression_nowf(E,LS,S,R) :-
1306 b_compute_expression_nowf(E,LS,S,R,none,0).
1307
1308 b_compute_expression_nowf(E,LS,S,R,FormulaKind,Nr) :-
1309 get_texpr_info(E,Info),
1310 ? b_compute_expression_nowf(E,LS,S,R,FormulaKind,Nr,Info).
1311 b_compute_expression_nowf(E,LS,S,R,FormulaKind,Nr,Span) :-
1312 ? b_compute_expression_no_wf8(E,LS,S,R,FormulaKind,Nr,[],Span).
1313
1314 % a variation where we try to compute the expression; enumeration warnings are possible
1315 b_try_compute_expression_no_wf(E,LS,S,R,FormulaKind) :-
1316 get_texpr_info(E,Info),
1317 b_compute_expression_no_wf8(E,LS,S,R,FormulaKind,0,[wfx_no_enumeration_warnings],Info).
1318
1319 % a variation where we tell ProB to expect non-symbolic / explicit values
1320 b_compute_explicit_epression_no_wf(E,LS,S,R,FormulaKind,Nr) :-
1321 get_texpr_info(E,Info),
1322 ? b_compute_explicit_epression_no_wf(E,LS,S,R,FormulaKind,Nr,Info).
1323 b_compute_explicit_epression_no_wf(E,LS,S,R,FormulaKind,Nr,Span) :-
1324 ? b_compute_expression_no_wf8(E,LS,S,R,FormulaKind,Nr,[expect_explicit_value],Span).
1325 % WFInfos = [], [expect_explicit_value] or [wfx_no_enumeration_warnings]
1326 b_compute_expression_no_wf8(E,LS,S,R,FormulaKind,Nr,WFInfos,Span) :-
1327 %add_message(b_compute_expression,'Called Version wo WFLAGS: ', b_compute_expression(E,LS,S,R)),
1328 (FormulaKind = none
1329 -> init_wait_flags(WF,WFInfos)
1330 ; CallStackEntry = prob_command_context(eval_expr_command(FormulaKind,Nr),Span),
1331 init_wait_flags_and_push_call_stack(no_wf_available,CallStackEntry,WFInfos,WF)
1332 ),
1333 ? b_compute_expression(E,LS,S,R,WF),
1334 ? ground_wait_flags(WF), % this will add abort errors and fail before enumerating the result:
1335 init_wait_flags(WF2,[b_compute_expression_nowf2]),
1336 get_texpr_type(E,Type),
1337 b_enumerate:b_tighter_enumerate_single_value(R,Type,Span,b_compute_expression_nowf,WF2), %should rarely be necessary
1338 % a non-ground result only occurs when WD error appears and in this case ground_wait_flags will fail after
1339 % adding the abort error (and thus no value is returned)
1340 % exceptions are test 1066 with a complicated set comprehension used in a function application
1341 % test 1861 relies on two phase enumeration
1342 ground_wait_flags(WF2).
1343
1344 l_compute_expression([],_LS,_S,[],_WF).
1345 l_compute_expression([H|T],LS,S,[CH|CT],WF) :-
1346 b_compute_expression(H,LS,S,CH,WF),
1347 l_compute_expression(T,LS,S,CT,WF).
1348
1349 :- if(environ(prob_debug_watch_flag,true)).
1350 b_compute_expressiond(b(Expr,Type,Info),LS,S,R,WF) :- !,
1351 ((ground(Type), Type \== pred, Type \== subst) -> true
1352 ; add_error_wf(b_compute_expression,'Expression has illegal type: ',b(Expr,Type,Info),Info,WF)),
1353 check_value(R,b(Expr,Type,Info)),
1354 b_compute_expression2(Expr,Type,Info,LS,S,R,WF).
1355 :- block check_value(-,?).
1356 check_value(pred_true,_) :- !. check_value(pred_false,_) :- !.
1357 check_value(string(_),_) :- !.
1358 check_value([],_) :- !.
1359 check_value([H|T],E) :- !, check_value(H,E), check_value(T,E).
1360 check_value((A,B),E) :- !, check_value(A,E), check_value(B,E).
1361 check_value(fd(N,T),E) :- !, (nonvar(T) -> check_fd(N,T,E) ; check_err(fd(N,T),E)).
1362 check_value(global_set(GS),E) :- !,(nonvar(GS) -> true ; check_err(global_set(GS),E)).
1363 check_value(avl_set(AS),E) :- !,((nonvar(AS),AS=node(_,_,_,_,_)) -> true ; check_err(global_set(AS),E)).
1364 check_value(int(X),E) :- !,check_int(X,E).
1365 check_value(closure(P,T,B),E) :- !,
1366 (ground(P),ground(T),nonvar(B)
1367 -> (same_length(P,T) -> bsyntaxtree:check_ast(B) ; check_err(closure_not_same_length(P,T)))
1368 ; check_err(closure(P,T,B),E)).
1369 check_value(rec(_),_) :- !. %TODO: check
1370 check_value(X,E) :- check_err(uncovered(X),E).
1371 % TO DO: add records + more thorough checking of global_set and closures and avl_sets
1372 :- block check_int(-,?).
1373 check_int(X,E) :- (number(X) -> true ; check_err(int(X),E)).
1374 :- block check_fd(-,?,?).
1375 check_fd(X,T,E) :- (number(X),b_get_fd_type_bounds(T,Low,Up),X>=Low,X=<Up -> true ; check_err(fd(X,T),E)).
1376
1377 check_err(V,E) :- add_internal_error('Illegal value when computing expression: ',V:E).
1378 b_compute_expression(E,LS,S,R,WF) :- !,
1379 (waitflag0_is_set(WF)
1380 -> debug:watch(100,b_interpreter:b_compute_expressiond(E,LS,S,R,WF))
1381 ; debug:watch_det(100,b_interpreter:b_compute_expressiond(E,LS,S,R,WF))).
1382 :- else.
1383 b_compute_expression(b(Expr,Type,Info),LS,S,R,WF) :- !,
1384 ((ground(Type), Type \== pred, Type \== subst) -> true
1385 ; Type==pred -> add_internal_error_wf(b_interpreter,'Expected expression, not predicate: ',b(Expr,Type,Info),Info,WF)
1386 ; Type==subst -> add_internal_error_wf(b_interpreter,'Expected expression, not substitution: ',b(Expr,Type,Info),Info,WF)
1387 ; add_internal_error_wf(b_interpreter,'Expression has non-ground type: ',b(Expr,Type,Info),Info,WF)
1388 ),
1389 ? b_compute_expression2(Expr,Type,Info,LS,S,R,WF).
1390 :- endif.
1391 b_compute_expression(Expr,LS,S,R,WF) :-
1392 add_internal_error('Expression not properly wrapped: ',b_compute_expression(Expr,LS,S,R,WF)),
1393 b_compute_expression2(Expr,unknown,[],LS,S,R,WF).
1394
1395
1396 :- use_module(bsyntaxtree,[get_texpr_set_type/2]).
1397
1398 %:- use_module(b_global_sets,[b_type2_set/2]).
1399 %b_compute_expression2(V,T,I,LS,S,R,_WF) :- nonvar(R), print('result_instantiated: '(R:V)),nl,fail.
1400 ?b_compute_expression2(value(Val),_T,_I,_LS,_S,V,WF) :- !, equal_object_wf(Val,V,WF). %Val=V.
1401 b_compute_expression2(boolean_true,_T,_I,_LState,_State,Res,_WF) :- !, Res = pred_true /* bool_true */. % for simple types we can use ordinary unification
1402 b_compute_expression2(boolean_false,_T,_I,_LState,_State,Res,_WF) :- !, Res = pred_false /* bool_false */.
1403 b_compute_expression2(integer_set(NSET),_T,_I,_LState,_State,Res,WF) :- !, equal_object_wf(Res,global_set(NSET),WF). %Res = global_set(NSET).
1404 b_compute_expression2(bool_set,_T,_I,_LState,_State,Res,WF) :- !, % b_type2_set(bool,Res).
1405 equal_object_wf(Res,avl_set(node(pred_false,true,1,empty,node(pred_true,true,0,empty,empty))),WF).
1406 % was equal_object(Res,[pred_true /* bool_true */,pred_false /* bool_false */]) % changing this to avl used to break test 800 Bosch Deadlock v9; probably because of identity closure detection instantiation
1407 b_compute_expression2(float_set,_T,_I,_LState,_State,Res,WF) :- !, equal_object_wf(Res,global_set('FLOAT'),WF).
1408 b_compute_expression2(real_set,_T,_I,_LState,_State,Res,WF) :- !, equal_object_wf(Res,global_set('REAL'),WF).
1409 b_compute_expression2(string_set,_T,_I,_LState,_State,Res,WF) :- !, equal_object_wf(Res,global_set('STRING'),WF).
1410 % was all_strings(Res). %% NOT COVERED (6)
1411 b_compute_expression2(string(S),_T,_I,_LState,_State,Res,_WF) :- !,
1412 % TODO(ML,26.8.2008): Check if we should use a different functor for syntax tree vs data
1413 Res = string(S).
1414 b_compute_expression2(typeset,Type,_I,_LState,_State,Res,WF) :- !,
1415 is_set_type(Type,ElType), % we could generate global_set('STRING'),... for certain types
1416 equal_object_wf(Res,closure('_zzzz_unary',[ElType],b(truth,pred,[])),WF).
1417 b_compute_expression2(empty_set,_T,_I,_LState,_State,Res,_WF) :- !, empty_set(Res).
1418 b_compute_expression2(empty_sequence,_T,_I,_LState,_State,Res,_WF) :- !, empty_sequence(Res).
1419 b_compute_expression2(event_b_identity,EType,_I,_LState,_State,Res,WF) :-
1420 get_set_type(EType,couple(Type,Type)),!,
1421 event_b_identity_for_type(Type,Res,WF).
1422 b_compute_expression2(integer(Val),_T,_I,_LocalState,_State,Res,_WF) :- !, Res = int(Val).
1423 b_compute_expression2(max_int,_T,_I,_LS,_S,Res,_WF) :-
1424 preferences:get_preference(maxint,CVal),!, Res = int(CVal).
1425 b_compute_expression2(min_int,_T,_I,_LS,_S,Res,_WF) :-
1426 preferences:get_preference(minint,CVal),!, Res = int(CVal).
1427 b_compute_expression2(identifier(Id),Type,Info,LocalState,State,Res,WF) :- !,
1428 lookup_value_in_store_and_global_sets_wf(Id,Type,LocalState,State,Value,Info,WF),
1429 equal_object_wf(Res,Value,WF).
1430 b_compute_expression2(lazy_lookup_expr(Id),_Type,_Info,LocalState,_State,Res,WF) :- !,
1431 lookup_value_for_existing_id_wf(Id,LocalState,(Trigger,Value),WF), % should normally only occur in LocalState; value introduced by lazy_let
1432 Trigger = pred_true, % force evaluation
1433 equal_object_wf(Res,Value,WF).
1434 b_compute_expression2(lazy_let_expr(Id,AssignmentExpr,Expr),_T,_I,LocalState,State,Value,WF) :-
1435 !,
1436 add_lazy_let_id_and_expression(Id,AssignmentExpr,LocalState,State,NewLocalState,WF),
1437 %Trigger = pred_true, % expressions cannot be delayed !? (TO DO: more refined check)
1438 %block_lazy_compute_expression(Trigger,_,AssignmentExpr,LocalState,State,IdValue,WF,Ai),
1439 b_compute_expression(Expr,NewLocalState,State,Value,WF).
1440 b_compute_expression2(real(Atom),_T,_I,_LocalState,_State,Res,_WF) :- !, construct_real(Atom,Res).
1441 b_compute_expression2(rec(Fields),_T,_I,LocalState,State,Record,WF) :- !,
1442 ? l_compute_field(Fields,LocalState,State,FieldValues,WF),
1443 ? construct_record_wf(FieldValues,Record,WF).
1444 b_compute_expression2(record_field(RecEx,Name),_T,_I,LocalState,State,Value,WF) :- !,
1445 ? b_compute_expression(RecEx,LocalState,State,RecValue,WF),
1446 access_record_wf(RecValue,Name,Value,WF).
1447 b_compute_expression2(freetype_set(Id),_T,_I,_LState,_State,Val,_WF) :- !, Val=freetype(Id). %% NOT COVERED (17)
1448 b_compute_expression2(function(Function,FunArg),Type,Info,LocalState,State,Res,WF) :- !,
1449 ? b_compute_expression_function(Function,FunArg,Type,Info,LocalState,State,Res,WF).
1450 b_compute_expression2(card(b(Arg1,Type,Info)),integer,OuterInfo,LocalState,State,Card,WF) :- !,
1451 ? b_compute_card(Arg1,Type,Info,OuterInfo,LocalState,State,Card,WF).
1452 b_compute_expression2(max(b(Arg1,Type,Info)),integer,_I,LocalState,State,Max,WF) :- !,
1453 b_compute_max(Arg1,Type,Info,LocalState,State,Max,WF).
1454 b_compute_expression2(min(b(Arg1,Type,Info)),integer,_I,LocalState,State,Min,WF) :- !,
1455 ? b_compute_min(Arg1,Type,Info,LocalState,State,Min,WF).
1456 b_compute_expression2(set_extension(Ex),Type,_I,LocalState,State,Res,WF) :- !,
1457 ? b_compute_expressions(Ex,LocalState,State,ExValue,WF),
1458 kernel_call(b_interpreter:convert_list_of_expressions_into_set_wf(ExValue,ValueSet,Type,WF),ExValue,WF, set_extension(Ex)),
1459 ? equal_object_wf(Res,ValueSet,WF).
1460 %kernel_call_convert_list_of_expressions_into_set_wf(ExValue,ValueSet,Type, WF).
1461 %b_compute_expression('ListTermes'(ListOfEx),LocalState,State,ValueSet,WF) :- !,
1462 % /* convert list of expressions of CASE statement into set of elements */
1463 % b_compute_expression(ListOfEx,LocalState,State,Value,WF),
1464 % init_wait_flags(WF),convert_list_of_expressions_into_set_wf(Value,ValueSet,set(any),WF),ground_wait_flags(WF).
1465 b_compute_expression2(sequence_extension(Ex),_T,_I,LocalState,State,ValueSeq,WF) :- !,
1466 ? b_compute_expressions(Ex,LocalState,State,Value,WF),
1467 kernel_call(b_interpreter:convert_list_of_expressions_into_sequence(Value,ValueSeq),Value,WF,sequence_extension(Ex)).
1468 b_compute_expression2(convert_bool(PRED),_T,_I,LocalState,State,Val,WF) :- !, /* B bool(.) operator */
1469 ? b_convert_bool(PRED,LocalState,State,WF,Val).
1470 b_compute_expression2(couple(El1,El2),_T,_I,LocalState,State,Result,WF) :- !, Result = (Val1,Val2),
1471 ? b_compute_expression(El1,LocalState,State,Val1,WF),
1472 ? b_compute_expression(El2,LocalState,State,Val2,WF).
1473 b_compute_expression2(comprehension_set(Parameters,Condition),_T,Info,LocalState,State,Result,WF) :- !,
1474 ? b_compute_comprehension_set(Parameters,Condition,Info,LocalState,State,Result,WF).
1475 b_compute_expression2(recursive_let(TId,TSet),OrigType,OrigInfo,LocalState,State,Result,WF) :- !,
1476 % LET TId = TSet in TSet
1477 ( get_texpr_expr(TSet,comprehension_set(Parameters,Condition)) ->
1478 true % if the argument TSet is a comprehension set,
1479 % we just add a recursive parameter
1480 ; get_texpr_set_type(TSet,Type) ->
1481 % if not, we construct a new comprehension set {x | x:TSet}
1482 unique_typed_id("_tmparg_",Type,TArg),
1483 Parameters=[TArg],
1484 safe_create_texpr(member(TArg,TSet),pred,Condition)
1485 ;
1486 add_internal_error('Expected set as argument to recursive_let',
1487 b_compute_expression2(recursive_let(TId,TSet),OrigType,OrigInfo,LocalState,State,Result,WF)),fail
1488 ),
1489 % Generate closure where the references to the recursion are kept
1490 % add recursion ID to parameters to prevent removal of references during compilation
1491 generate_recursive_closure(TId,recursion,[TId|Parameters],Condition,LocalState,State,Closure1,WF),
1492 % add_message(b_interpreter,'Recursive Let for: ',TId,TId),
1493 % remove recursion ID from parameters after compilation
1494 Closure1=closure([_|P],[_|T],Cond),RClosure=closure(P,T,Cond),
1495 % Generate closure where the references to the recursion are kept
1496 generate_recursive_closure(TId,RClosure,Parameters,Condition,LocalState,State,Result,WF).
1497 b_compute_expression2(general_sum(Ids,Condition,Expression),Type,Info,LocalState,State,SumResult,WF) :- !,
1498 b_general_sum_or_mul(Ids,Condition,Expression,Type,Info,LocalState,State,SumResult,WF,sum).
1499 b_compute_expression2(general_product(Ids,Condition,Expression),Type,Info,LocalState,State,MulResult,WF) :- !,
1500 b_general_sum_or_mul(Ids,Condition,Expression,Type,Info,LocalState,State,MulResult,WF,mul).
1501 /* Begin: Extensions for Z */
1502 b_compute_expression2(if_then_else(If,Then,Else),T,_I,LocalState,State,Value,WF) :- !,
1503 opt_push_wait_flag_call_stack_info(WF,b_expr_call(if_test,If),WF2),
1504 ? b_try_check_boolean_expression_wf(If,LocalState,State,WF2,PredRes),
1505 (var(PredRes), can_get_full_fd_value(T), preferences:preference(use_clpfd_solver,true),
1506 always_well_defined(Then), always_well_defined(Else)
1507 % Note: always_well_defined_or_disprover_mode probably not ok, as we evaluate the expressions unconditionally
1508 -> b_clpfd_if_then_else(PredRes,T,Then,Else,LocalState,State,Value,WF)
1509 ? ; b_compute_if_then_else(PredRes,Then,Else,LocalState,State,Value,WF)
1510 ).
1511 b_compute_expression2(let_expression_global(Ids,AssignmentExprs,Expr),_T,_Info,LocalState,State,Value,WF) :-
1512 % created by bcompiler for operation_call_in_expr
1513 % store variables globally (not in LocalState) to be visible to subsidiary operation_calls
1514 !, set_up_localstate_for_global_let(Ids,AssignmentExprs,LocalState,State,LetState,WF),
1515 b_compute_expression(Expr,LocalState,LetState,Value,WF).
1516 b_compute_expression2(let_expression(Ids,AssignmentExprs,Expr),_T,_I,LocalState,State,Value,WF) :-
1517 ? !, set_up_localstate_for_let(Ids,_ParaValues,AssignmentExprs,LocalState,State,LetState,WF),
1518 ? b_compute_expression(Expr,LetState,State,Value,WF). %% NOT COVERED (30)
1519 b_compute_expression2(freetype_constructor(Id,Case,Expr),_T,_I,LocalState,State,FreeValue,WF) :-
1520 !, FreeValue = freeval(Id,Case,Value),
1521 b_compute_expression(Expr,LocalState,State,Value,WF). %% NOT COVERED (32)
1522 b_compute_expression2(freetype_destructor(Id,Case,Expr),_T,Info,LocalState,State,Value,WF) :-
1523 !, b_compute_expression(Expr,LocalState,State,freeval(Id,VCase,VValue),WF),
1524 check_freetype_case(Id,Case,VCase,VValue,Value,Info,WF).
1525 /* End: Extensions for Z */
1526 b_compute_expression2(assertion_expression(Cond,ErrMsg,Expr),T,Info,LocalState,State,Value,WF) :- !,
1527 opt_push_wait_flag_call_stack_info(WF,
1528 span_predicate(b(assertion_expression(Cond,ErrMsg,b(value(string('')),string,[])),T,Info),LocalState,State),WF2),
1529 % should we use another term for call stack?
1530 (get_preference(disprover_mode,true) -> PredRes = pred_true ; true), % in Disprover mode we know Cond must be true
1531 ? b_try_check_boolean_expression_no_enum_wf(Cond,LocalState,State,WF2,PredRes), % DO NOT ENUM, unless we cannot reify
1532 % does not make sense to enumerate PredRes as with pred_false we get no value anyway
1533 % however, we may get pending co-routines if Cond cannot be reified
1534 ( PredRes==pred_false ->
1535 b_compute_assertion_expr(PredRes,Cond,ErrMsg,Expr,LocalState,State,Value,WF2) % will add WD error
1536 ; member(prob_annotation(strong_check_with_delay),Info) % delay computing Expr until we are sure Cond is true
1537 -> b_compute_assertion_expr(PredRes,Cond,ErrMsg,Expr,LocalState,State,Value,WF2)
1538 ? ; b_compute_expression(Expr,LocalState,State,Value,WF),
1539 add_wd_error_if_false(PredRes,ErrMsg,Cond,span_predicate(Cond,LocalState,State),WF2)
1540 ).
1541 b_compute_expression2(multiplication(Arg1,Arg2),integer,Info,LocalState,State,Value,WF) :-
1542 same_texpr(Arg1,Arg2), !, % is less useful when CLPFD is already turned on, calls square(Arg1,Value,WF)
1543 b_compute_expression(Arg1,LocalState,State,SV1,WF),
1544 unary_kernel_call(kernel_objects,square,SV1,Value,WF,multiplication(Arg1,Arg1),integer,Info).
1545 b_compute_expression2(image(Relation,Set),_EType,Info,LocalState,State,Value,WF) :-
1546 special_operator_for_image(Relation,Kind,Args),
1547 % we have closure1(Rel)[Set] or similar -> avoid computing full closure
1548 !,
1549 opt_push_wait_flag_call_stack_info(WF,b_operator_call(image,[Relation,SV],Info),WF2),
1550 ? b_compute_expression(Set,LocalState,State,SV,WF2),
1551 ? b_compute_expressions(Args,LocalState,State,EArgs,WF2),
1552 ? kernel_call(bsets_clp:image_for_special_operator(Kind,EArgs,SV,Value,WF2),[SV|EArgs],WF2,image(Relation,Set)).
1553 b_compute_expression2(external_function_call(FunName,Args),EType,Info,LocalState,State,Value,WF) :-
1554 !,
1555 ? b_compute_expressions(Args, LocalState,State, EvaluatedArgs, WF),
1556 push_wait_flag_call_stack_info(WF,external_call(FunName,EvaluatedArgs,Info),WF2),
1557 ? call_external_function(FunName,Args,EvaluatedArgs,Value,EType,Info,WF2).
1558 b_compute_expression2(Expression,EType,Info,LocalState,State,Res,WF) :-
1559 is_set_type(EType,Type),
1560 /* avoid evaluating certain expensive expressions:
1561 convert them into symbolic closures and expand only if really required */
1562 functor(Expression,UnOp,1),
1563 symbolic_closure_unary_operator(UnOp),
1564 /* TO DO: UNFOLD THIS OR WRAP in CONSTRUCTOR */
1565 arg(1,Expression,BType),
1566 !, %preferences:get_preference(convert_types_into_closures,true),!,
1567 % print_message(delayed_un_op(UnOp,BType)),
1568 ? b_compute_expression(BType,LocalState,State,ArgValue,WF),
1569 ( do_not_keep_symbolic_unary(UnOp,ArgValue),
1570 unary_function(UnOp,Module,KernelFunction) ->
1571 /* special treatment for empty set or other situations: no need to keep symbolic */
1572 ? unary_kernel_call(Module,KernelFunction,ArgValue,Res,WF,Expression,EType,Info)
1573 ;
1574 get_texpr_type(BType,ArgType),
1575 create_texpr(value(ArgValue),ArgType,[],TValue),
1576 ClosureSetExpression =.. [UnOp,TValue],
1577 construct_member_closure('_zzzz_unary',Type,Info,ClosureSetExpression,Value),
1578 ? ((unop_to_be_marked_as_symbolic(UnOp,ArgValue) ; member(prob_annotation('SYMBOLIC'),Info)) ->
1579 mark_closure_as_symbolic(Value,SValue),
1580 equal_object_wf(Res,SValue,WF)
1581 ; equal_object_wf(Res,Value,WF))
1582
1583 ).
1584 b_compute_expression2(Expression,EType,Info,LocalState,State,Res,WF) :-
1585 is_set_type(EType,Type),
1586 /* avoid evaluating certain expensive expressions:
1587 convert them into symbolic closures and expand only if really required */
1588 functor(Expression,BinOp,2),
1589 arg(1,Expression,BType1),
1590 arg(2,Expression,BType2),
1591 kernel_mappings:symbolic_closure_binary_operator(BinOp),
1592 !,
1593 %preferences:get_preference(convert_types_into_closures,true),!,
1594 ? b_compute_expression(BType1,LocalState,State,ArgValue1,WF),
1595 (binary_arg1_determines_value(BinOp,ArgValue1,DetResult)
1596 -> /* print(det(BinOp,ArgValue1)),nl, */
1597 equal_object_wf(Res,DetResult,b_compute_expression2(BinOp),WF)
1598 ; b_compute_expression(BType2,LocalState,State,ArgValue2,WF),
1599 % print_message(delayed_bin_op(BinOp,ArgValue1,ArgValue2)),
1600 (is_definitely_empty(BinOp,ArgValue1,ArgValue2)
1601 -> empty_set(Res)
1602 ; if(do_not_keep_symbolic(BinOp,ArgValue1,ArgValue2,ERes,WF),
1603 % then:
1604 equal_object_wf(Res,ERes,b_compute_expression2(BinOp),WF),
1605 % else:
1606 (get_texpr_type(BType1,TypeArg1), create_texpr(value(ArgValue1),TypeArg1,[],TArg1),
1607 get_texpr_type(BType2,TypeArg2), create_texpr(value(ArgValue2),TypeArg2,[],TArg2),
1608 ClosureSetExpression =.. [BinOp,TArg1,TArg2],
1609 construct_member_closure('_zzzz_unary',Type,Info,ClosureSetExpression,Value),
1610 % print('Constructed Symbolic Closure : '), translate:print_bvalue(Value),nl,
1611 ? (binop_to_be_marked_as_symbolic(BinOp,ArgValue1,ArgValue2) ->
1612 mark_closure_as_symbolic(Value,SValue),
1613 equal_object_wf(Res,SValue,WF)
1614 ? ; equal_object_wf(Res,Value,WF))
1615 )
1616 ) % if
1617 )
1618 ).
1619 b_compute_expression2(Expression,Type,Info,LocalState,State,Value,WF) :-
1620 functor(Expression,Op,1),
1621 unary_function(Op,Module,KernelFunction),
1622 arg(1,Expression,Arg1),!,
1623 %opt_push_wait_flag_call_stack_info(WF,b_operator_arg_evaluation(Op,1,[SV1],Arg1),WF1),
1624 ? b_compute_expression(Arg1,LocalState,State,SV1,WF),
1625 ? unary_kernel_call(Module,KernelFunction,SV1,Value,WF,Expression,Type,Info).
1626 b_compute_expression2(Expression,Type,Info,LocalState,State,Value,WF) :-
1627 functor(Expression,Op,2),
1628 binary_function(Op,Module,KernelFunction),
1629 arg(1,Expression,Arg1),
1630 arg(2,Expression,Arg2),!,
1631 %opt_push_wait_flag_call_stack_info(WF,b_operator_arg_evaluation(Op,1,[SV1,_],Arg1),WF1),
1632 ? b_compute_expression(Arg1,LocalState,State,SV1,WF),
1633 (binary_arg1_determines_value(Op,SV1,Result) % we could disable this if find_abort_values=true or if SV1 not guaranteed to be wd
1634 ->
1635 equal_object_wf(Value,Result,b_compute_expression2(Op),WF)
1636 ? ; b_compute_expression(Arg2,LocalState,State,SV2,WF),
1637 ? binary_kernel_call(Module,KernelFunction,SV1,SV2,Value,WF,Expression,Type,Info)
1638 ).
1639 b_compute_expression2(operation_call_in_expr(Operation,Parameters),_T,Info,LocalState,State,Value,WF) :-
1640 !, def_get_texpr_id(Operation,op(OperationName)),
1641 % TODO: check that this is a query operation; probably done in type checker
1642 b_execute_operation_in_expression(OperationName,LocalState,State,Parameters,Value,Info,WF).
1643 b_compute_expression2(E,T,Info,_L,_S,_R,_WF) :-
1644 (T==pred -> add_internal_error('Uncovered expression; looks like a predicate in the wrong place: ',b(E,T,Info))
1645 ; T==subst -> add_internal_error('Uncovered expression; looks like a substitution in the wrong place: ',b(E,T,Info))
1646 ; requires_cleanup_pre(E) -> add_internal_error('Non-cleaned up ambiguous expression: ',b(E,T,Info))
1647 ; add_internal_error('Uncovered expression: ',b(E,T,Info))
1648 ),
1649 print_functor(E), print(' : '), print(T),nl,fail.
1650
1651 requires_cleanup_pre(mult_or_cart(_,_)).
1652 requires_cleanup_pre(minus_or_set_subtract(_,_)).
1653
1654 make_couplise([A],R) :- !,R=A.
1655 make_couplise([A,B],R) :- !,R=(A,B).
1656 make_couplise([A,B|Rest],Result) :- !,
1657 make_couplise([(A,B)|Rest],Result).
1658 make_couplise(A,_) :- add_internal_error('Illegal operation call result:',A),fail.
1659
1660 % ---
1661
1662
1663 % check if a symbolic_closure_unary_operator result should be marked with prob_annotation(SYMBOLIC)
1664 % because direct sub-args are marked SYMBOLIC
1665 unop_to_be_marked_as_symbolic(UnOp,Value) :- nonvar(Value),
1666 ? to_be_marked_as_symbolic_aux(UnOp,Value).
1667 to_be_marked_as_symbolic_aux(struct,rec(Fields)) :- !,
1668 ? member(field(_,SymbolicClosure),Fields),
1669 ? is_symbolic_closure(SymbolicClosure).
1670 %to_be_marked_as_symbolic_aux(pow_subset,SymbolicClosure) :- is_symbolic_closure(SymbolicClosure).
1671 %to_be_marked_as_symbolic_aux(pow1_subset,SymbolicClosure) :- is_symbolic_closure(SymbolicClosure).
1672 ?to_be_marked_as_symbolic_aux(_,SymbolicClosure) :- is_symbolic_closure(SymbolicClosure).
1673
1674 % check if a symbolic_closure_binary_operator result should be marked with prob_annotation(SYMBOLIC)
1675 % because direct sub-args are marked SYMBOLIC
1676 binop_to_be_marked_as_symbolic(interval,_,_) :- !, fail.
1677 %binop_to_be_marked_as_symbolic(overwrite,_,_) :- !, true. % TO DO: fix by detecting infinite <+ closures
1678 ?binop_to_be_marked_as_symbolic(set_subtraction,ArgVal1,_) :- !, is_symbolic_closure(ArgVal1).
1679 binop_to_be_marked_as_symbolic(intersection,ArgVal1,ArgVal2) :-
1680 ? (finite_reasonably_sized_set(ArgVal1) ; finite_reasonably_sized_set(ArgVal2)), !,
1681 fail. % intersection is finite and reasonably sized
1682 ?binop_to_be_marked_as_symbolic(_,ArgVal1,_) :- is_symbolic_closure(ArgVal1).
1683 ?binop_to_be_marked_as_symbolic(_,_,ArgVal2) :- is_symbolic_closure(ArgVal2).
1684 % ---
1685
1686 % check if we have a finite known set that can be reasonably represented
1687 % see small_known_set/1 is kernel_mappings
1688 finite_reasonably_sized_set(AVL) :- nonvar(AVL), AVL=avl_set(_). % already expanded; so it can be represented in memory
1689 finite_reasonably_sized_set(Closure) :- nonvar(Closure),
1690 custom_explicit_sets:is_interval_closure(Closure,From,To), integer(From), integer(To),
1691 1+To-From < 250000. % what value should we use here?
1692
1693 lazy_compute_expression(TRIGGER,AssignmentExpr,LocalState,State,IdValue,WF,Ai) :-
1694 get_enumeration_finished_wait_flag(WF,F),
1695 block_lazy_compute_expression(TRIGGER,F,AssignmentExpr,LocalState,State,IdValue,WF,Ai).
1696
1697 :- block block_lazy_compute_expression(-,-,?,?,?, ?,?,?).
1698 block_lazy_compute_expression(TRIGGER,_F,_AssignmentExpr,_LocalState,_State,_IdValue,_WF,_Ai) :-
1699 var(TRIGGER),!.
1700 block_lazy_compute_expression(pred_true,_,AssignmentExpr,LocalState,State,IdValue,WF,Ai) :-
1701 AssignmentExpr = b(Expr,Type,Infos),
1702 (Type \== pred -> b_compute_expression2(Expr,Type,Infos,LocalState,State,IdValue,WF)
1703 ; IdValue == pred_true -> b_test_boolean_expression2(Expr,Infos,LocalState,State,WF,Ai,_)
1704 ; IdValue == pred_false -> b_not_test_boolean_expression2(Expr,Infos,LocalState,State,WF,Ai,_)
1705 ; b_check_boolean_expression(AssignmentExpr,LocalState,State,WF,PredVal,Ai,_) -> IdValue = PredVal
1706 ; % reification of check_boolean_expression failed:
1707 b_try_check_failed(AssignmentExpr,LocalState,State,'$ENUMERATION',WF,IdValue,'$GENERATE_ON_DEMAND')
1708 ).
1709 block_lazy_compute_expression(pred_false,_,_AssignmentExpr,_LocalState,_State,[],_WF,_Ai). % maybe generate any value ??
1710
1711 % ---
1712
1713 :- block add_wd_error_if_false(-,?,?,?,?).
1714 add_wd_error_if_false(pred_true,_,_,_,_).
1715 add_wd_error_if_false(pred_false,ErrMsg,Cond,Span,WF) :-
1716 translate_bexpression_with_limit(Cond,100,CS),
1717 %(Span=span_predicate(P,LS,State) -> tcltk_interface:write_dot_file_for_pred_expr_and_state(P, LS, State,'/tmp/prob_wd_error.dot') ; true),
1718 add_wd_error_span(ErrMsg,CS,Span,WF).
1719
1720 :- block b_compute_assertion_expr(-,?,?,?,?,?,?,?).
1721 b_compute_assertion_expr(pred_false,Cond,ErrMsg,_Expr,LocalState,State,_Value,WF) :-
1722 translate_bexpression_with_limit(Cond,100,CS),
1723 add_wd_error_span(ErrMsg,CS,span_predicate(Cond,LocalState,State),WF).
1724 b_compute_assertion_expr(pred_true,_Cond,_ErrMsg,Expr,LocalState,State,Value,WF) :-
1725 b_compute_expression(Expr,LocalState,State,Value,WF).
1726
1727 % ---
1728
1729
1730 :- use_module(kernel_tools,[ground_value/1]).
1731 % compute function application:
1732 b_compute_expression_function(Function,FunArg,Type,Info,LocalState,State,Res,WF) :-
1733 preferences:preference(find_abort_values,false), % below we do not check, e.g., if set extension is really a function
1734 is_extension_function(Function,FInfo,ExFun), !,
1735 /* a set extension applied to an argument: in some cases we can can first evaluate the argument,
1736 and then avoid having to compute the set_extension for all non-matching args */
1737 opt_push_wait_flag_call_stack_info(WF,function_call(Function,ArgValue,Info),WF2), % only push call_stack in TRACE_INFO mode
1738 b_compute_expression(FunArg,LocalState,State,ArgValue,WF2),
1739 % TO DO : should we only do this if ArgValue is known ?? otherwise the standard treatment is better ??
1740 % Note: b_compiler has a special rule to not remove this optimisation
1741 Span = span_predicate(b(function(Function,FunArg),Type,Info),LocalState,State),
1742 ((memberchk(contains_wd_condition,FInfo) ; % relevant for test 1302; but machine seems to contain real WD error
1743 preferences:preference(use_clpfd_solver,false) ;
1744 ground_value(ArgValue))
1745 -> b_apply_function_set_extension(ExFun,ArgValue,LocalState,State,Res,WF2,Span)
1746 ; /* the standard treatment can infer information about the result,... in clpfd_mode */
1747 b_compute_expression(Function,LocalState,State,FValue,WF),
1748 get_texpr_type(Function,FunctionType),
1749 kernel_call_apply_to(FValue,ArgValue,Res,FunctionType,Span,WF2)).
1750 %b_compute_expression_function(b(comprehension_set(Parameters,Condition),_,SInfo),Arg,Type,Info,LocalState,State,Value,WF) :- !,
1751 % b_compute_comprehension_set_symbolic(Parameters,Condition,SInfo,LocalState,State,FValue,WF),
1752 % b_compute_expression(Arg,LocalState,State,ArgValue,WF),
1753 % Span = span_predicate(b(function(Function,Arg),Type,Info),LocalState,State),
1754 % get_texpr_type(Function,FunctionType),
1755 % kernel_call_apply_to(FValue,ArgValue,Value,FunctionType,Span,WF).
1756 b_compute_expression_function(Function,FunArg,_Type,Info,LocalState,State,Value,WF) :-
1757 special_operator_for_image(Function,Kind,Args),!, % detect e.g. iterate(rel,k)(x) or closure1
1758 opt_push_wait_flag_call_stack_info(WF,function_call(Function,ArgValue,Info),WF2),
1759 b_compute_expression(FunArg,LocalState,State,ArgValue,WF2),
1760 b_compute_expressions(Args,LocalState,State,EArgs,WF2),
1761 kernel_call(bsets_clp:apply_fun_for_special_operator(Kind,EArgs,ArgValue,Value,WF2,Info),
1762 [ArgValue|EArgs],WF2,function(Function,FunArg)).
1763 b_compute_expression_function(Function,Arg,Type,Info,LocalState,State,Value,WF) :-
1764 opt_push_wait_flag_call_stack_info(WF,function_call(Function,ArgValue,Info),WF2),
1765 ? b_compute_expression(Function,LocalState,State,FValue,WF2),
1766 ? b_compute_expression(Arg,LocalState,State,ArgValue,WF2),
1767 Span = span_predicate(b(function(Function,Arg),Type,Info),LocalState,State),
1768 get_texpr_type(Function,FunctionType),
1769 % TODO: do we still need the span predicate when we have the function_call call_stack infos?
1770 ? kernel_call_apply_to(FValue,ArgValue,Value,FunctionType,Span,WF2).
1771
1772
1773 :- use_module(bsyntaxtree,[get_set_type/2,is_set_type/2]).
1774 :- use_module(kernel_cardinality_attr,[finite_cardinality_as_int_with_type_wf/5]).
1775 b_compute_card(Arg1,Type,Info,OuterInfo,LocalState,State,Card,WF) :-
1776 ? b_compute_card2(Arg1,Type,Info,OuterInfo,LocalState,State,Card,WF),
1777 % maybe we should move this code below inside kernel_objects ??
1778 (ground(Card) -> true
1779 ; get_set_type(Type,SetElType), % TO DO: only needed for cardinality_of_set_extension_list
1780 ? kernel_objects:max_cardinality(SetElType,MaxCard), % this could be precomputed statically
1781 (number(MaxCard) -> kernel_objects:in_nat_range(Card,int(0),int(MaxCard))
1782 ; kernel_objects:greater_than_equal(Card,int(0)) % not sure this is required
1783 )
1784 ).
1785 b_compute_card2(set_extension(Ex),_,_,_,LocalState,State,Card,WF) :- !,
1786 b_compute_expressions(Ex,LocalState,State,ExValue,WF),
1787 kernel_objects:cardinality_of_set_extension_list(ExValue,Card,WF).
1788 b_compute_card2(range(F),_,_,_,LocalState,State,Card,WF) :- !,
1789 b_compute_expression(F,LocalState,State,SV1,WF),
1790 kernel_objects:cardinality_of_range(SV1,Card,WF).
1791 b_compute_card2(comprehension_set(Parameters,Condition),Type,Info,OuterInfo,LocalState,State,Card,WF) :- !,
1792 get_set_type(Type,SetElType),
1793 % ensure that we keep the closure and don't expand it:
1794 ? b_compute_comprehension_set_symbolic(Parameters,Condition,Info,LocalState,State,SV1,WF),
1795 ? kernel_mappings:must_succ_kernel_call(
1796 kernel_cardinality_attr:finite_cardinality_as_int_with_type_wf(SV1,SetElType,OuterInfo,Card,WF),SV1,WF,card).
1797 % TO DO: treat comprehension set + things like card({x|x>1 & x<2**e & x mod 2 = 0}) = 0
1798 b_compute_card2(Arg1,Type,Info,OuterInfo,LocalState,State,Card,WF) :-
1799 get_set_type(Type,SetElType),
1800 b_compute_expression2(Arg1,Type,Info,LocalState,State,SV1,WF),
1801 ? kernel_mappings:must_succ_kernel_call(
1802 kernel_cardinality_attr:finite_cardinality_as_int_with_type_wf(SV1,SetElType,OuterInfo,Card,WF),SV1,WF,card).
1803
1804 b_compute_max(set_extension(Ex),_,Info,LocalState,State,Max,WF) :- !,
1805 b_compute_expressions(Ex,LocalState,State,ExValue,WF),
1806 kernel_objects:maximum_of_set_extension_list(ExValue,Max,Info,WF).
1807 b_compute_max(Arg1,Type,Info,LocalState,State,Max,WF) :-
1808 b_compute_expression2_symbolic(Arg1,Type,Info,LocalState,State,SV1,WF),
1809 kernel_mappings:must_succ_kernel_call(kernel_objects:maximum_of_set(SV1,Max,Info,WF),SV1,WF,max).
1810
1811 b_compute_min(set_extension(Ex),_,Info,LocalState,State,Min,WF) :- !,
1812 b_compute_expressions(Ex,LocalState,State,ExValue,WF),
1813 kernel_objects:minimum_of_set_extension_list(ExValue,Min,Info,WF).
1814 /* doesnot really buy a lot: */
1815 /*b_compute_min(union(Arg1,Arg2),_,Info,LocalState,State,Min,WF) :-
1816 Arg1 = b(set_extension(Ex),Type1,Info1),
1817 !,
1818 b_compute_min(set_extension(Ex),Type1,Info1,LocalState,State,Min1,WF),
1819 b_compute_expression(Arg2,LocalState,State,SV2,WF),
1820 b_compute_min2(SV2,Min1,Min,Info,WF).
1821 :- block b_compute_min2(-,?,?,?,?).
1822 b_compute_min2([],Min1,Res,_,_WF) :- !, Res=Min1.
1823 b_compute_min2(SV1,Min1,Res,Info,WF) :-
1824 kernel_mappings:must_succ_kernel_call(kernel_objects:minimum_of_set(SV1,Min2,Info,WF),SV1,WF,min),
1825 min(Min1,Min2,Res).
1826 min(int(A),int(B),int(Res)) :- kernel_objects:minimum(A,B,Res). */
1827 b_compute_min(Arg1,Type,Info,LocalState,State,Min,WF) :-
1828 b_compute_expression2_symbolic(Arg1,Type,Info,LocalState,State,SV1,WF),
1829 ? kernel_mappings:must_succ_kernel_call(kernel_objects:minimum_of_set(SV1,Min,Info,WF),SV1,WF,min).
1830
1831 generate_recursive_closure(TRecId,RecValue,Parameters,Condition,LocalState,State,Result,WF) :-
1832 get_texpr_id(TRecId,RecId),
1833 add_var_to_localstate(RecId,RecValue,LocalState,State1),
1834 debug_println(9,generating_recursive_closure(RecId,Parameters)),
1835 b_generate_rec_closure_aux(RecId,Parameters,Condition,State1,State,RClosure1,WF),
1836 mark_closure_as_recursive(RClosure1,RClosure2),
1837 mark_closure(RClosure2,[recursive(TRecId)],Result),
1838 ( debug_mode(off) -> true
1839 ; ground_value(Result) -> true
1840 ; term_variables(Result,TV),
1841 add_message(b_interpreter,'non-ground closure generated: ',TV:Result,Condition)
1842 ).
1843 % a variation of b_generate_closure
1844 b_generate_rec_closure_aux(RecId,Parameters,Condition,LocalState,State,Result,WF) :-
1845 split_names_and_types(Parameters,Names,Types),
1846 construct_closure(Names,Types,ClosurePred,Result),
1847 % now add RecId to parameters to prevent looking up recursive calls
1848 b_compiler:b_compile(Condition,[RecId|Names],LocalState,State,ClosurePred,WF).
1849
1850 % check if a freetype value has the expected case, if not
1851 % generate a WD-error
1852 check_freetype_case(Id,Case,VCase,Inner,Value,Info,WF) :-
1853 get_enumeration_finished_wait_flag(WF,F),
1854 check_freetype_case2(Id,Case,VCase,Inner,Value,Info,F,WF).
1855 :- block check_freetype_case2(?,?,-,?,?,?,-,?).
1856 check_freetype_case2(Id,Case,VCase,Inner,Value,Info,_F,WF) :-
1857 ( nonvar(VCase) ->
1858 ( Case=VCase -> equal_object_wf(Inner,Value,check_freetype_case2,WF)
1859 ;
1860 ajoin(['cannot apply destructor for data type ',Id,
1861 ', expected constructor ',Case,', but got: '],Msg),
1862 add_wd_error_set_result(Msg,VCase,Inner,Value,Info,WF))
1863 ; % the computation has finished without value,
1864 true). % just drop the check
1865
1866 % check if we have a set_extension argument representing an explicit function
1867 % {a |-> f1, b |-> f2, ...} or [f1,f2]
1868 is_extension_function(b(A,_,Info),Info,C) :- is_extension_function_aux(A,C).
1869 is_extension_function_aux(set_extension(Ex),CaseList) :- is_set_extension_function(Ex,CaseList).
1870 is_extension_function_aux(sequence_extension(Ex),CaseList) :- is_sequence_extension_function(Ex,1,CaseList).
1871 is_set_extension_function([],[]).
1872 is_set_extension_function([b(Couple,TC,_)|T],[case(A,B)|ST]) :- is_couple(Couple,TC,A,B),
1873 is_set_extension_function(T,ST).
1874 is_sequence_extension_function([],_,[]).
1875 is_sequence_extension_function([B|T],Nr,[case(b(value(int(Nr)),integer,[]),B)|ST]) :- N1 is Nr+1,
1876 is_sequence_extension_function(T,N1,ST).
1877
1878 is_couple(couple(A,B),_,A,B).
1879 is_couple(value((VA,VB)),couple(TA,TB), b(value(VA),TA,[]), b(value(VB),TB,[])).
1880
1881 :- use_module(kernel_equality,[equality_objects_wf/4]).
1882 b_apply_function_set_extension([],FunArgVal,_LocalState,_State,_Res,WF,Span) :-
1883 add_wd_error_span('Function applied outside of domain (#8): ','@fun'(FunArgVal,[]),Span,WF).
1884 b_apply_function_set_extension([case(A,B)|T],FunArgVal,LocalState,State,Res,WF,Span) :-
1885 b_compute_expression(A,LocalState,State,AVal,WF),
1886 equality_objects_wf(AVal,FunArgVal,EqRes,WF),
1887 % TO DO: if Res is known, we can call equality_objects(BVal,Res,ResEqRes)
1888 ? b_apply_function_set_extension_aux(EqRes,B,T,FunArgVal,LocalState,State,Res,WF,Span).
1889
1890 :- block b_apply_function_set_extension_aux(-,?,?,?, ?,?,?,?,?).
1891 b_apply_function_set_extension_aux(pred_true,B,_T,_FunArgVal,LocalState,State,Res,WF,_Span) :-
1892 b_compute_expression(B,LocalState,State,BVal,WF), %print(value(BVal)),nl,
1893 ? equal_object_wf(BVal,Res,b_apply_function_set_extension_aux,WF).
1894 b_apply_function_set_extension_aux(pred_false,_B,T,FunArgVal,LocalState,State,Res,WF,Span) :-
1895 ? b_apply_function_set_extension(T,FunArgVal,LocalState,State,Res,WF,Span).
1896
1897
1898 % --------------------- SIGMA & PI ------------------------
1899 :- use_module(bsyntaxtree,[is_membership_or_equality/3,same_id/3]).
1900 /* first clause: try to do a specific treatment for formulas of the form SIGMA(ID).(ID:SET|EXPR) */
1901 /* Advantage: will not delay as long before computing comprehension_set SET ; see test 1312 */
1902 b_general_sum_or_mul([TID],Condition,Expression,Type,_Info,LocalState,State,SumResult,WF,SUMorMUL) :-
1903 is_membership_or_equality(Condition,MID,SET),
1904 same_id(TID,MID,_),!,
1905 b_compute_expression(SET,LocalState,State,SETResult,WF),
1906 b_general_sum_or_mul_over_set([TID],SETResult,Expression,Type,LocalState,State,SumResult,WF,SUMorMUL).
1907 b_general_sum_or_mul(Ids,Condition,Expression,Type,Info,LocalState,State,SumMulResult,WF,SUMorMUL) :-
1908 b_compute_comprehension_set(Ids,Condition,Info,LocalState,State,SETResult,WF),
1909 (var(SETResult) -> perfmessagecall(sigma_pi_not_expanded_or_reified(SUMorMUL),
1910 translate:print_bexpr(Condition),Condition) ; true),
1911 b_general_sum_or_mul_over_set(Ids,SETResult,Expression,Type,LocalState,State,SumMulResult,WF,SUMorMUL).
1912
1913
1914 :- block b_general_sum_or_mul_over_set(?,-, ?,?,?,?, ?,?,?).
1915 b_general_sum_or_mul_over_set([TID],SETResult,Expression,Type,_LS,_S,SumResult,WF,SUMorMUL) :-
1916 Type=integer, % TO DO: also for real
1917 get_texpr_id(Expression,ID), % check if we just sum the elements of the list SIGMA(x).(x:S|x)
1918 get_texpr_id(TID,ID),
1919 ? sum_or_mul_of_explicit_set(SETResult,SUMorMUL,R),!,
1920 equal_object_wf(SumResult,R,b_general_sum_or_mul_over_set,WF).
1921 b_general_sum_or_mul_over_set(IDs,SETResult,Expression,Type,LocalState,State,SumResult,WF,SUMorMUL) :-
1922 expand_custom_set_to_list_wf(SETResult,ESETResult,_Done,b_general_sum_or_mul_over_set,WF),
1923 b_sum_or_mul_over_list(ESETResult,IDs,Expression,Type,LocalState,State,SumResult,WF,SUMorMUL).
1924
1925 b_sum_or_mul_over_list(L,IDs,Expr,Type,LS,State,Result,WF,SUMorMUL) :-
1926 get_acc_base(SUMorMUL,Type,Acc),
1927 (Type = integer -> get_wait_flag0(WF,WF0) ; true), % for real: delay until values known
1928 b_sum_or_mul_over_list_acc(L,IDs,Expr,Type,LS,State,Acc,Result,WF,SUMorMUL,WF0).
1929
1930 :- block b_sum_or_mul_over_list_acc(-, ?, ?,?,?,?,?, ?,?,?,?).
1931 % better if list is fully known: no constraint propagation performed during computation !
1932 % for example: SIGMA(x).(x:{-1} \/ 1..30000|x+1) goes down from 2050 ms to 1210 ms
1933 b_sum_or_mul_over_list_acc([],_,_,Type,_,_,Acc,Result,_WF,_SUMorMUL,_) :-
1934 get_acc_result(Type,Acc,Result).
1935 b_sum_or_mul_over_list_acc([H|T],IDs,Expr,Type,LocalState,State,Acc,Result,WF,SUMorMUL,WF0) :-
1936 add_typed_vars_to_localstate(IDs,H,LocalState,NewLocalState),
1937 b_compute_expression(Expr,NewLocalState,State,HExprVal,WF),
1938 b_sum_or_mul_over_list_acc2(HExprVal,T,IDs,Expr,Type,LocalState,State,Acc,Result,WF,SUMorMUL,WF0).
1939
1940 :- block b_sum_or_mul_over_list_acc2(?,-, ?, ?,?,?,?,?, ?,?,?,?),
1941 b_sum_or_mul_over_list_acc2(?,?, ?, ?,?,?,?,-, ?,?,?,-),
1942 b_sum_or_mul_over_list_acc2(-,?, ?, ?,?,?,?,?, ?,?,?,-). % wait until T nonvar and either Acc & HExprVal known or WF0 set
1943 % purpose: try and remain in non-CLPFD mode as long as possible to avoid overflows,... (see eg. test 1642, 1708)
1944 b_sum_or_mul_over_list_acc2(HExprVal,T,IDs,Expr,Type,LocalState,State,Acc, Result,WF,SUMorMUL,WF0) :-
1945 (nonvar(T),nonvar(Acc),ground(HExprVal)
1946 -> % we can continue computing the system without constraint propagation; is faster
1947 get_value(Type,HExprVal,HVal),
1948 compose_acc(SUMorMUL,Acc,HVal,NewAcc),
1949 b_sum_or_mul_over_list_acc(T,IDs,Expr,Type,LocalState,State,NewAcc,Result,WF,SUMorMUL,WF0)
1950 ; T==[], number(Acc), get_acc_base(SUMorMUL,Type,Acc) ->
1951 /* we have just a single element left and no operator has to be applied -> no need for clpfd treatment */
1952 equal_object_wf(HExprVal,Result,b_sum_or_mul_over_list_acc)
1953 ; Type=real, \+ use_clpfd_real_solver ->
1954 when(ground(HExprVal),
1955 b_sum_or_mul_over_list_acc2(HExprVal,T,IDs,Expr,Type,LocalState,State,Acc, Result,WF,SUMorMUL,WF0))
1956 ? ; init_clp_sum_or_mul(Type,SUMorMUL,STKind) ->
1957 init_clp_acc(STKind,HExprVal,Acc,CLPAccumulator,WF),
1958 b_sum_or_mul_over_list_clp(T,IDs,Expr,LocalState,State,CLPAccumulator,Result,WF,STKind)
1959 ).
1960
1961 % add set comprehension solution ValueForTypedIDs as individual values for every TypedIDs to LocalState
1962 add_typed_vars_to_localstate(TypedIDs,ValueForTypedIDs,LocalState,NewLocalState) :-
1963 (flatten_pairs(TypedIDs,ValueForTypedIDs,ValAsList),
1964 add_typed_vars_to_localstate_aux(TypedIDs,ValAsList,LocalState,R)
1965 -> NewLocalState = R
1966 ; add_internal_error('Call failed: ',add_typed_vars_to_localstate(TypedIDs,ValueForTypedIDs,LocalState,NewLocalState)),
1967 fail
1968 ).
1969 % set comprehension results for {a,b,c|P} are nested like this ((a,b),c)
1970 % first argument only used for length (to know how deep the pairs are nested)
1971 flatten_pairs(L,Pairs,FlatList) :- flatten_pairs(L,Pairs,FlatList,[]).
1972 flatten_pairs([_],A) --> !, [A].
1973 flatten_pairs([_|T],(A,B)) --> flatten_pairs(T,A) ,[B].
1974 add_typed_vars_to_localstate_aux([],_,LS,LS).
1975 add_typed_vars_to_localstate_aux([TID],[H],LocalState,NewLocalState) :- !,
1976 get_texpr_id(TID,ID), get_texpr_type(TID,TYPE),
1977 add_typed_var_to_localstate(ID,H,TYPE,LocalState,NewLocalState).
1978 add_typed_vars_to_localstate_aux([TID1|Ids],[H1|Hs],LocalState,NewLocalState) :- !,
1979 get_texpr_id(TID1,ID1), get_texpr_type(TID1,TYPE),
1980 add_typed_var_to_localstate(ID1,H1,TYPE,LocalState,LS1),
1981 add_typed_vars_to_localstate_aux(Ids,Hs,LS1,NewLocalState).
1982
1983
1984 :- block b_sum_or_mul_over_list_clp(-, ?, ?,?,?, ?, ?,?,?).
1985 b_sum_or_mul_over_list_clp([],_, _,_,_, Acc, Result,_WF,SUMorMUL) :-
1986 finalise_clp(SUMorMUL,Acc,Result).
1987 b_sum_or_mul_over_list_clp([H|T],IDs,Expr,LocalState,State,Acc, Result,WF,SUMorMUL) :-
1988 add_typed_vars_to_localstate(IDs,H,LocalState,NewLocalState),
1989 b_compute_expression(Expr,NewLocalState,State,HExprVal,WF),
1990 compose_clp(SUMorMUL,HExprVal,Acc,NewAcc,WF),
1991 b_sum_or_mul_over_list_clp(T,IDs,Expr,LocalState,State,NewAcc,Result,WF,SUMorMUL).
1992
1993 get_acc_base(sum,integer,R) :- !, R=0.
1994 get_acc_base(sum,real,0.0).
1995 get_acc_base(mul,integer,R) :- !, R=1.
1996 get_acc_base(mul,real,1.0).
1997 get_acc_result(integer,Nr,int(Nr)).
1998 get_acc_result(real,Nr,Real) :- is_real(Real,Nr).
1999 get_value(integer,int(Val),Val) :- !.
2000 get_value(real,Real,Nr) :- is_real(Real,Nr).
2001
2002 compose_acc(sum,A,B,C) :- C is A+B.
2003 compose_acc(mul,A,B,C) :- C is A*B.
2004 % init flag to encode both type and PI/SIGMA
2005 init_clp_sum_or_mul(integer,sum,sum_integer).
2006 init_clp_sum_or_mul(real,sum,sum_real).
2007 init_clp_sum_or_mul(integer,mul,mul_integer).
2008 init_clp_sum_or_mul(real,mul,mul_real).
2009
2010 init_clp_acc(sum_integer,int(A),AccNr,NewAcc,_) :- !, (AccNr==0 -> NewAcc=[A] ; NewAcc=[A,AccNr]). % A always not ground
2011 init_clp_acc(mul_integer,A,AccNr,NewAcc,_) :- !, times(A,int(AccNr),NewAcc).
2012 init_clp_acc(SUMorMUL,A,AccNr,NewAcc,WF) :- is_real(B,AccNr), compose_clp(SUMorMUL,A,B,NewAcc,WF).
2013
2014 compose_clp(sum_integer,int(A),Acc,NewAcc,_) :- NewAcc = [A|Acc].
2015 compose_clp(sum_real,A,B,C,WF) :- real_addition_wf(A,B,C,WF).
2016 compose_clp(mul_integer,A,B,C,_) :- times(A,B,C).
2017 compose_clp(mul_real,A,B,C,WF) :- real_multiplication_wf(A,B,C,WF).
2018 :- use_module(clpfd_interface,[clpfd_sum/2]).
2019 finalise_clp(sum_integer,Acc,BResult) :- !, BResult = int(Result),
2020 clpfd_sum(Acc,Result). % using clpfd_sum can be much more efficient: no intermediate variables set up
2021 % there is no clpfd_sum for reals in SICStus at the moment
2022 finalise_clp(_,Acc,Acc). % just copy accumulator
2023
2024 /* for if-then-else in Z: compute Then or Else,
2025 depending on the outcome of the predicate */
2026 :- block b_compute_if_then_else(-,?,?,?,?,?,?).
2027 b_compute_if_then_else(pred_true,Then,_Else,LocalState,State,Value,WF) :-
2028 opt_push_wait_flag_call_stack_info(WF,b_expr_call(if_then_body,Then),WF2),
2029 ? b_compute_expression(Then,LocalState,State,Value,WF2).
2030 b_compute_if_then_else(pred_false,_Then,Else,LocalState,State,Value,WF) :-
2031 opt_push_wait_flag_call_stack_info(WF,b_expr_call(if_else_body,Else),WF2),
2032 ? b_compute_expression(Else,LocalState,State,Value,WF2).
2033
2034 :- use_module(clpfd_interface,[clpfd_if_then_else/4]).
2035 % a more sophisticated treatment, can also work backwards forcing PredRes
2036 % examples:
2037 % x = IF a<10 THEN 0 ELSE 5 END & x:6..10 & a:1..23
2038 % see must_fail_clpfd_det 132 and 133
2039 % problematic if Else contains recursion; but then we should have WD condition
2040 b_clpfd_if_then_else(PredRes,Type,Then,Else,LocalState,State,Value,WF) :-
2041 get_wait_flag0(WF,WF0),
2042 b_clpfd_if_then_else_block(PredRes,WF0,Type,Then,Else,LocalState,State,Value,WF).
2043 :- block b_clpfd_if_then_else_block(-,-,?,?,?,?,?,?,?).
2044 b_clpfd_if_then_else_block(PredRes,_,Type,Then,Else,LocalState,State,Value,WF) :- var(PredRes),!,
2045 get_full_fd_value(Type,Value,FDValue),
2046 b_compute_expression(Then,LocalState,State,ThenValue,WF),
2047 get_full_fd_value(Type,ThenValue,FDThenValue),
2048 b_compute_expression(Else,LocalState,State,ElseValue,WF),
2049 get_full_fd_value(Type,ElseValue,FDElseValue),
2050 % TO DO: catch CLPFD overflow and use equality_objects
2051 clpfd_if_then_else(PredRes,FDThenValue,FDElseValue,FDValue).
2052 b_clpfd_if_then_else_block(pred_true,_,_Type,Then,_Else,LocalState,State,Value,WF) :-
2053 b_compute_expression(Then,LocalState,State,Value,WF).
2054 b_clpfd_if_then_else_block(pred_false,_,_Type,_Then,Else,LocalState,State,Value,WF) :-
2055 b_compute_expression(Else,LocalState,State,Value,WF).
2056
2057 :- use_module(b_global_sets,[get_global_type_value/3]).
2058 % try and get full_fd_value; true if full value can be translated to CLP(FD) value
2059 get_full_fd_value(global(T),FY,X) :- get_global_type_value(FY,T,X).
2060 get_full_fd_value(integer,int(X),X).
2061 get_full_fd_value(boolean,B,FD) :- kernel_equality:prop_eq_01(B,FD).
2062 % record with single field ?
2063
2064 can_get_full_fd_value(global(_)).
2065 can_get_full_fd_value(integer).
2066 can_get_full_fd_value(boolean).
2067
2068 % a slightly improved version over set_up_localstate (not sure it is really much faster):
2069 add_lazy_let_id_to_local_state(b(identifier(ID),_,_),Trigger,IdValue,LocalState,NewState) :-
2070 % should we delete any old occurence of ID in LocalState?
2071 NewState = [bind(ID,(Trigger,IdValue))|LocalState].
2072
2073 add_lazy_let_id_and_expression(Id,IdExpr,LocalState,InState,NewLocalState,WF) :-
2074 empty_avl(Ai),
2075 add_lazy_let_id_and_expression(Id,IdExpr,LocalState,InState,NewLocalState,WF,Ai).
2076 add_lazy_let_id_and_expression(Id,IdExpr,LocalState,InState,NewLocalState,WF,Ai) :-
2077 add_lazy_let_id_to_local_state(Id,Trigger,IdValue,LocalState,NewLocalState),
2078 lazy_compute_expression(Trigger,IdExpr,LocalState,InState,IdValue,WF,Ai).
2079
2080 /* for let-statements in Z and now in B: expand localstate by new variables and assign
2081 values to them ;
2082 now Expressions are evaluated in state *with* the new identifiers !
2083 */
2084 %set_up_localstate_for_let_no_reuse(Ids,Exprs,LocalState,State,LetState,WF) :-
2085 % set_up_localstate(Ids,Vars,LocalState,LetState),
2086 % compute_let_expressions(Exprs,Vars,LocalState,State,WF).
2087 set_up_localstate_for_let(Ids,Vars,Exprs,LocalState,State,LetState,WF) :-
2088 set_up_localstate(Ids,Vars,LocalState,LetState),
2089 %external_functions:observe_variables(Ids,Vars),
2090 ? compute_let_expressions(Exprs,Vars,LetState,State,WF).
2091 compute_let_expressions([],[],_,_,_).
2092 compute_let_expressions([Expr|RestExprs],[Var|RestVars],LocalState,State,WF) :-
2093 ? b_compute_expression(Expr,LocalState,State,Value,WF),
2094 equal_object_optimized(Var,Value,compute_let_expressions),
2095 ? compute_let_expressions(RestExprs,RestVars,LocalState,State,WF).
2096
2097 set_up_localstate_for_global_let(Ids,Exprs,LocalState,State,LetState,WF) :-
2098 set_up_localstate(Ids,Vars,State,LetState),
2099 compute_let_expressions(Exprs,Vars,LocalState,LetState,WF).
2100
2101
2102 l_compute_field([],_LS,_S,[],_WF).
2103 l_compute_field([Field|T],LS,S,[FVal|CT],WF) :-
2104 ? b_compute_field(Field,LS,S,FVal,WF),
2105 ? l_compute_field(T,LS,S,CT,WF).
2106
2107 b_compute_field(field(Name,TypeOrVal),LocalState,State,field(Name,TypeOrFieldValue),WF) :-
2108 ? b_compute_expression(TypeOrVal,LocalState,State,TypeOrFieldValue,WF).
2109
2110
2111
2112 :- use_module(b_compiler).
2113
2114 /* :- type bsets_closure +--> closure(list(type(variable_id)),
2115 list(type(basic_type_descriptor)),type(boolean_expression)). */
2116
2117 :- assert_pre(b_interpreter:b_compute_comprehension_set(Parameters,Cond,_Info,LS,State,_R,_WF),
2118 (ground_check(Parameters),
2119 bsyntaxtree:check_if_typed_predicate(Cond),type_check(LS,store),type_check(State,store)) ).
2120
2121 :- assert_post(b_interpreter:b_compute_comprehension_set(_P,_C,_Info,_LS,_State,Val,_WF),
2122 (b_interpreter:value_type(Val))). %, nonvar(Val)
2123
2124
2125 b_compute_comprehension_set_symbolic(Parameters,Condition,Info,LocalState,State,Result,WF) :-
2126 % a version which never expands the generated closure
2127 ? b_generate_closure_if_necessary(Parameters,Condition,LocalState,State,CResult,WF),
2128 ? (member(prob_annotation('SYMBOLIC'),Info)
2129 -> mark_closure_as_symbolic(CResult,CRS),
2130 equal_object_wf(CRS,Result,b_compute_comprehension_set_symbolic,WF)
2131 ; equal_object_wf(CResult,Result,b_compute_comprehension_set_symbolic,WF)
2132 ).
2133
2134 % we could catch Parameters = [TID], Condition = b(member(b(identifier(ID),_TYPE,_),SET)
2135 b_compute_comprehension_set(Parameters,Condition,Info,LocalState,State,Result,WF) :-
2136 ? b_generate_closure_if_necessary(Parameters,Condition,LocalState,State,CResult,WF),
2137 ? b_compute_comprehension_set_aux(CResult,Info,Result,WF).
2138
2139 :- use_module(clpfd_interface,[catch_clpfd_overflow_call2/2]).
2140 b_compute_comprehension_set_aux(CResult,_,Result,WF) :-
2141 (var(CResult) ; \+ functor(CResult,closure,3) ),!,
2142 equal_object_wf(CResult,Result,b_compute_comprehension_set_aux,WF).
2143 b_compute_comprehension_set_aux(CResult,Info,Result,WF) :-
2144 ? member(prob_annotation('SYMBOLIC'),Info),!,
2145 mark_closure_as_symbolic(CResult,CRS),
2146 equal_object_wf(CRS,Result,b_compute_comprehension_set_aux,WF).
2147 b_compute_comprehension_set_aux(CResult,Info,Result,WF) :-
2148 (preferences:get_preference(convert_comprehension_sets_into_closures,true)
2149 -> \+ definitely_expand_this_explicit_set(CResult)
2150 ; dont_expand_symbolic_explicit_set(CResult), % Note: also detects FORCE annotation
2151 perfmessage_wf(symbolic,'Keeping comprehension-set symbolic (use FORCE to override this or increase SYMBOLIC_LIMIT)','',Info,WF)
2152 ),!,
2153 ? equal_object_wf(CResult,Result,b_compute_comprehension_set_aux,WF).
2154 b_compute_comprehension_set_aux(CResult,Info,Result,WF) :-
2155 b_expand_compute_comprehension_set(CResult,Info,Result,WF).
2156
2157 b_expand_compute_comprehension_set(CResult,Info,Result,WF) :-
2158 % using just get_wait_flag1(b_compute_comprehension_set,WF,WF0), makes many benchmarks faster ; but e.g., test 268 fails; maybe we sholud pre-compute bexpr_variables ? and pass this to expand_only_custom_closure_global
2159 (preferences:preference(use_smt_mode,false)
2160 -> get_wait_flag(1000,b_compute_comprehension_set,WF,WF0) % ideally we should say WF0 = _ ; but for some benchmarks Rule_DB_SIGAREA_0024_ori.mch this is important to avoid expanding closures before other stuff fails
2161 % only in SMT mode can there be any benefit in expanding a non-ground closure (when it is a lambda closure)
2162 % => hence delay expansion longer, possibly detecting enumeration warnings while expanding
2163 % TO DO: for lambda closures with known domain: expand earlier !
2164 ; get_wait_flag(2,b_compute_comprehension_set,WF,WF0)),
2165 kernel_objects:mark_as_to_be_computed(Result), % avoid that we instantiate this set (e.g., in check_element_of_wf: we will get a full description of the set later; see test 1353
2166 (var(WF0),var(Result) -> ground_value_check(CResult,CGr) ; true),
2167 block_compute_comprehension_set_aux(CResult,Info,Result,WF,WF0,CGr).
2168
2169 :- block block_compute_comprehension_set_aux(?,?,-,?,-,-).
2170 block_compute_comprehension_set_aux(CResult,Info,Result,WF,_WF0,_CGr) :-
2171 (
2172 nonvar(Result)
2173 ? -> equal_object_wf(CResult,Result,WF) % this may expand CResult or do other tests;
2174 % like emptyness test or symbolic equality;
2175 % if Result=[_|_] then the closure needs to be expanded anyhow, so need to try and keep symbolic
2176 ;
2177 add_wait_flag_info(WF,wfx_no_enumeration_warnings,WF2), % do not show enum warnings
2178 ? catch_clpfd_overflow_call2(
2179 on_enumeration_warning_with_continue(
2180 expand_only_custom_closure_global(CResult,Expansion,check_no_inf,WF2),
2181 % check_no_inf: we know it is not definitely infinite; and we do not want warnings for virtual time-outs
2182 % an enumeration warning occured in the expansion scope: keep closure symbolic after all
2183 % NOTE: for this detection to work it is better to delay until the body is ground (CGr)
2184 % and not use a priority too low for WF0, otherwise Expansion will be var and enum warning may occur later
2185 b_compute_comprehension_set_sym_msg(CResult,Info,Result,WF) % Backup Call in case of enum warning
2186 ,
2187 equal_object_wf(Result,Expansion,WF) % TrueContinuation
2188 % instantiating Result can trigger other code which fails and confuses on_enumeration_warning
2189 ),
2190 b_compute_comprehension_set_sym(CResult,Result,WF)
2191 ) % catch_clpfd_overflow_call2
2192 ).
2193
2194 b_compute_comprehension_set_sym_msg(CResult,Info,Result,WF) :- CResult = closure(P,_T,B),
2195 silent_mode(off),
2196 show_enumeration_warnings(WF),
2197 % TO DO: should we check that this closure has not been constructed by ProB, e.g., for UNION ??
2198 % e.g., P = ['__RANGE_LAMBDA__'] what about '_zzzz_unary', '_zzzz_binary', '_prj_arg1__', ...
2199 % also: what if the enumeration warning has a pending_abort_error
2200 !,
2201 Msg = 'Keeping comprehension-set symbolic (you may want to use the /*@symbolic*/ pragma to prevent this message, unless it was due to a WD-Error), identifiers: ',
2202 (contains_info_pos(Info) -> Span=Info ; Span=B),
2203 add_message(b_compute_comprehension_set,Msg,P,Span),
2204 b_compute_comprehension_set_sym(CResult,Result,WF).
2205 b_compute_comprehension_set_sym_msg(CResult,_,Result,WF) :-
2206 b_compute_comprehension_set_sym(CResult,Result,WF).
2207
2208
2209 b_compute_comprehension_set_sym(CResult,Result,WF) :-
2210 mark_closure_as_symbolic(CResult,CRS), % prevent doing the same mistake again
2211 equal_object_wf(Result,CRS,b_compute_comprehension_set_sym,WF).
2212
2213
2214 :- use_module(closures,[construct_closure_if_necessary/4]).
2215 b_generate_forall_closure(Parameters,Condition,LocalState,State,Result,WF) :-
2216 split_names_and_types(Parameters,Names,Types),
2217 construct_closure(Names,Types,ClosurePred1,Result),
2218 (LocalState==[],State==[]
2219 -> ClosurePred = Condition % no lookups can be performed anyway; no need to compile
2220 ; b_compiler:b_compile(Condition,Names,LocalState,State,ClosurePred,WF) ),
2221 add_texpr_infos(ClosurePred,[quantifier_kind(forall)],ClosurePred1). % info for call_stack
2222
2223
2224
2225 b_generate_closure_if_necessary(Parameters,Condition,LocalState,State,Result,WF) :-
2226 split_names_and_types(Parameters,Names,Types),
2227 ? b_compiler:b_compile(Condition,Names,LocalState,State,ClosurePred,WF),
2228 %print('COMPILED: '),translate:print_bexpr(ClosurePred),nl,
2229 construct_closure_if_necessary(Names,Types,ClosurePred,Result).
2230
2231
2232 :- public convert_list_of_expressions_into_sequence/2.
2233 convert_list_of_expressions_into_sequence(List,SeqValue) :-
2234 convert_list_of_expressions_into_sequence(List,1,Seq),
2235 ? equal_object_optimized(Seq,SeqValue,convert_list_of_expressions_into_sequence).
2236
2237 convert_list_of_expressions_into_sequence([],_,[]).
2238 convert_list_of_expressions_into_sequence([H|T],Cur,[(int(Cur),H)|ConvT]) :-
2239 C1 is Cur+1,
2240 convert_list_of_expressions_into_sequence(T,C1,ConvT).
2241
2242 convert_list_of_expressions_into_set_wf(ListOfElements,Set,Type,WF) :-
2243 list_of_expressions_is_ground(ListOfElements,Ground,OrderedListOfElements),
2244 ? convert_list_of_expressions_into_set1(Ground,OrderedListOfElements,Set,Type,WF).
2245 convert_list_of_expressions_into_set1(true,ListOfElements,Set,_Type,WF) :- %var(Set),
2246 ? \+ (ListOfElements = [H|_], is_symbolic_closure(H)), % list contains symbolic closures, do not try to expand to avl
2247 % see should_be_converted_to_avl_from_lists ?
2248 !, construct_avl_from_lists_wf(ListOfElements,AVLSet,WF),
2249 ? equal_object_wf(AVLSet,Set,convert_list_of_expressions_into_set1,WF).
2250 convert_list_of_expressions_into_set1(_,Seq,Set,Type,WF) :-
2251 ? kernel_objects:max_cardinality(Type,TypeMaxCard),
2252 ? convert_list_of_expressions_into_set2(Seq,1,[],Set,TypeMaxCard,WF).
2253
2254 % TO DO: sort elements : ground elements first
2255 convert_list_of_expressions_into_set2([],_,Set,Res,_,WF) :-
2256 ? equal_object_wf(Set,Res,convert_list_of_expressions_into_set2,WF).
2257 convert_list_of_expressions_into_set2([H|T],MaxSze,SetSoFar,OutSet,TypeMaxCard,WF) :-
2258 %kernel_objects:basic_type_set(Type,IntSet,MaxSze),
2259 check_set_lists_bounded(IntSet,TypeMaxCard,MaxSze),
2260 % TO DO: optimize; avoid traversing or typing elements over and over again
2261 % maybe add a max. sze argument to add_element
2262 add_element_wf(H,SetSoFar,IntSet,WF), % print(add_el(H,SetSoFar,IntSet)),nl,
2263 % TO DO: check if H in OutSet and keep track of which elements have already been covered in OutSet
2264 %check_element_of_wf(H,OutSet,WF), makes tests 114, 115, 118-120, 1063 fail ! % we could also call lazy_try_check_element_of if this turns out to be too expensive
2265 ? kernel_objects:lazy_try_check_element_of(H,OutSet,WF),
2266 M1 is MaxSze+1,
2267 ? convert_list_of_expressions_into_set2(T,M1,IntSet,OutSet,TypeMaxCard,WF).
2268
2269
2270 :- use_module(inf_arith).
2271
2272 % check that a set does not exceed a certain bound (to prevent infinite
2273 % or overeager enumeration of sets); Warning: will not check custom_explicit_set sizes
2274 check_set_lists_bounded(Set,TypeMaxCard,Bound) :-
2275 inf_arith:infmin(TypeMaxCard,Bound,Card),
2276 (is_inf_or_overflow_card(Card) -> true
2277 ; Card<1 -> empty_set(Set)
2278 ; check_set_bounded_aux(Set,Card)).
2279
2280 :- block check_set_bounded_aux(-,?).
2281 check_set_bounded_aux(CustomSet,_) :- is_custom_explicit_set(CustomSet,check_set_bounded_aux),!.
2282 check_set_bounded_aux([],_).
2283 check_set_bounded_aux([_|T],Card) :-
2284 C1 is Card-1,
2285 (C1=0 -> empty_set(T) ; check_set_bounded_aux(T,C1)).
2286
2287
2288
2289 % check if the list can be converted into AVL form; if not: re-order list so that ground elements are present first
2290 list_of_expressions_is_ground([],true,[]).
2291 list_of_expressions_is_ground([E|T],Ground,ResList) :-
2292 (should_be_converted_to_avl(E) -> ResList=[E|RT], list_of_expressions_is_ground(T,Ground,RT)
2293 ; Ground=false,
2294 bring_ground_elements_forward(T,[E],ResList)
2295 ).
2296
2297 bring_ground_elements_forward([],Acc,Acc).
2298 bring_ground_elements_forward([H|T],Acc,Res) :-
2299 (should_be_converted_to_avl(H) -> Res=[H|RT], bring_ground_elements_forward(T,Acc,RT)
2300 ; bring_ground_elements_forward(T,[H|Acc],Res)).
2301
2302 :- use_module(kernel_card_arithmetic,[is_inf_or_overflow_card/1, safe_mul/3]).
2303 % compute cardinality of a list of parameters, such as for forall
2304 parameter_list_cardinality([],1).
2305 parameter_list_cardinality([b(identifier(_),BasicType,_)|T],Res) :-
2306 ? parameter_list_cardinality(T,TCard),
2307 (is_inf_or_overflow_card(TCard) -> Res=TCard
2308 ? ; kernel_objects:max_cardinality(BasicType,Card),
2309 safe_mul(Card,TCard,Res)
2310 ).
2311 % see also basic_type_list_cardinality, now moved to custom_explicit_sets
2312
2313 b_for_all(Parameters,Infos,LHS,RHS,LocalState,State,WF) :-
2314 get_wait_flag1(for_all(Parameters),WF,LWF), % hack: give total_function,... priority to set up domain/range
2315 ? b_for_all_aux(LWF,Parameters,Infos,LHS,RHS,LocalState,State,WF).
2316
2317 :- block b_for_all_aux(-,?,?,?,?,?,?,?).
2318 b_for_all_aux(_,Parameters,Infos,LHS,RHS,LocalState,State,WF) :-
2319 split_names_and_types(Parameters,Names,Types),
2320 ? b_compile(LHS,Names,LocalState,State,CLHS,WF),
2321 ? b_compile(RHS,Names,LocalState,State,CRHS,WF),
2322 ? b_for_all_aux2(Parameters,Names,Types,Infos,CLHS,CRHS,WF).
2323
2324 :- use_module(kernel_tools,[ground_bexpr/1, ground_bexpr_check/2]).
2325 b_for_all_aux2(_,_,_,_,LHS,RHS,_) :-
2326 (is_falsity(LHS) ; is_truth(RHS)),
2327 !. % quantifier always true
2328 b_for_all_aux2(Parameters,CParameters,CParameterTypes,Infos,LHS,RHS,WF) :-
2329 ground_bexpr(LHS),
2330 ? \+ obvious_enumeration(LHS,CParameters), % if we have an obvious (small) enumeration in the LHS it is often
2331 % better simply to enumerate and check the RHS for every instance
2332 ground_bexpr(RHS), %print(not_exists_forall(Parameters,LHS,RHS)),nl,
2333 !,
2334 b_for_all_find_counter_example(Parameters,CParameters,CParameterTypes,Infos,LHS,RHS,WF).
2335 b_for_all_aux2(Parameters,CParameters,CParameterTypes,Infos,LHS,RHS,WF) :-
2336 ? parameter_list_cardinality(Parameters,ParCard),
2337 peel_implications(Parameters,ParCard,LHS,RHS, LHS2,RHS2),
2338 ? b_for_all_aux3(Parameters,ParCard,CParameters,CParameterTypes,Infos,LHS2,RHS2,WF).
2339
2340 b_for_all_aux3(Parameters,ParCard,CParameters,CParameterTypes,Infos,LHS,RHS,WF) :-
2341 %large_domain(Parameters,ParCard,LHS),
2342 is_infinite_or_very_large_explicit_set(closure(CParameters,CParameterTypes,LHS),10000000),
2343 % the domain is so large that we cannot possibly check all instances
2344 % in this case: we prefer to look for a counter example in the hope that the constraint solver can narrow down the search by combining LHS and not(RHS)
2345 !,
2346 perfmessage(forall,'Large forall domain: ',ParCard,Infos),
2347 ground_bexpr_check(LHS,LG),
2348 ground_bexpr_check(RHS,RG),
2349 when((nonvar(LG),nonvar(RG)),
2350 b_for_all_find_counter_example(Parameters,CParameters,CParameterTypes,Infos,LHS,RHS,WF)
2351 ).
2352 b_for_all_aux3(Parameters,ParCard,_CP,_,Infos,LHS,RHS,WF) :-
2353 if(expand_forall_quantifier(Parameters,LHS,RHS,Infos,WF,ReificationVariable),
2354 (
2355 perfmessage(good(forall),'Reified forall by expanding into conjunction: ',LHS),
2356 ReificationVariable=pred_true),
2357 ( % print(normal_forall(Parameters)),nl,
2358 b_generate_for_all_list_domain1(Parameters,ParCard,LHS,RHS,[],[],AllSolList,NewRHS,WF),
2359 % now check every instance of the expanded domain (AllSolList):
2360 ? expand_forall1(AllSolList,NewRHS,Parameters,WF)
2361 )).
2362
2363
2364 % a treatment of for all where we look for counter examples satisfying LHS & not(RHS)
2365 b_for_all_find_counter_example(Parameters,CParameters,CParameterTypes,Infos,LHS,RHS,WF) :-
2366 % if LHS is Parameters: avl_set(V) then we probably should not apply this rule ?
2367 create_negation(RHS,NegRHS),
2368 conjunct_predicates_with_pos_info(LHS,NegRHS,Pred0),
2369 % format('looking for: ~w ',[CParameters]), translate:print_bexpr(LHS),nl, translate:print_bexpr(NegRHS),nl,
2370 perfmessage(good(forall),translating_forall_into_not_exists(CParameters),LHS),
2371 add_texpr_infos(Pred0,[quantifier_kind(forall)],ClosureBody1), % for call_stack
2372 init_quantifier_wait_flag(WF,not(forall),Parameters,ParValues,Infos,LocalWF), % relevant for test 1904
2373 not_with_enum_warning_and_possible_delay(
2374 (custom_explicit_sets:b_test_closure(CParameters,CParameterTypes,ClosureBody1,ParValues,negative,LocalWF),
2375 perfmessage_bexpr(forall,forall_counter_example(CParameters,ParValues),LHS)
2376 ),LocalWF, WF, forall(CParameters), Infos).
2377
2378 :- use_module(library(timeout),[time_out/3]).
2379 not_with_enum_warning_and_possible_delay(C,WF,OuterWF,PP,Span) :-
2380 get_preference(disprover_mode,true),
2381 % in disprover mode we do not track WD errors, no need to start_attach_inner_abort_errors
2382 !,
2383 % delay potentially expensive quantifications in the hope of finding other contradictions earlier
2384 if( (time_out(not_with_enum_warning(C,WF,PP,Span),20,TRes),TRes \== time_out),
2385 copy_wfe_from_inner_if_necessary(WF,OuterWF),
2386 (get_wait_flag(2,not_with_enum_warning_and_possible_delay,OuterWF,LWF), % which priority to use ??
2387 debug_println(19,delay_not_in_disprover_mode),
2388 not_with_enum_warning_delay(C,LWF,WF,OuterWF,PP,Span))).
2389 not_with_enum_warning_and_possible_delay(C,WF,OuterWF,PP,Span) :-
2390 start_attach_inner_abort_errors(Level,not_with_enum_warning),
2391 call_cleanup(not_with_enum_warning(C,WF,PP,Span),
2392 re_attach_pending_inner_abort_errors(Level,OuterWF,_)),
2393 copy_wfe_from_inner_if_necessary(WF,OuterWF).
2394
2395
2396 :- block not_with_enum_warning_delay(?,-,?,?,?,?).
2397 not_with_enum_warning_delay(C,_,WF,OuterWF,PP,Span) :-
2398 debug_println(19,trigger_not_with_enum_warning_delay),
2399 not_with_enum_warning(C,no_wf_available,PP,Span),
2400 copy_wfe_from_inner_if_necessary(WF,OuterWF).
2401
2402 :- use_module(avl_tools,[quick_avl_approximate_size/2]).
2403 obvious_enumeration(LHS,[Id]) :- % TO DO : allow multiple ids
2404 % TO DO: unify with is_for_all_set_membership_predicate code below
2405 TLHSMembership = b(LHSMembership,_,_),
2406 ? member_conjunct(TLHSMembership,LHS,_),
2407 obvious_enum_aux(LHSMembership,Id).
2408
2409 obvious_enum_aux(member(TID,b(value(VAL),_,_)),ID) :- get_texpr_id(TID,ID),
2410 nonvar(VAL), VAL = avl_set(AVL), % TO DO: also support interval closures ?
2411 quick_avl_approximate_size(AVL,Size),
2412 Size<256.
2413 %obvious_enum_aux(equal(LHS,RHS),ID) :- % stillposes problem for test 231, investigate
2414 % ( get_texpr_id(LHS,ID) -> get_texpr_expr(RHS,value(_))
2415 % ; get_texpr_id(RHS,ID) -> get_texpr_expr(LHS,value(_))).
2416 % % TODO: do we need to accept integer(.),... literals?
2417
2418 % expands forall quantifier and thus enables that we also propagate from right to left
2419 % This helps for test 1397 (HandshakeSimple_TotFun)
2420 % TO DO: directly call the code which tries to expand a forall quantifier
2421 expand_forall_quantifier(Parameters,LHS,RHS,Infos,WF,ReificationVariable) :-
2422 (preferences:preference(use_smt_mode,true) -> true
2423 ; preferences:preference(solver_strength,SS), SS>9), % sometimes contrapositive checking maybe not useful; see test 1368
2424 % TO DO: investigate and provide more principled heuristic
2425 b_interpreter_check:b_check_forall_wf(Parameters,LHS,RHS,Infos,[],[],WF,ReificationVariable).
2426
2427 % rewrite !(x,..).( TRUTH => (LHS2 => RHS2)) into !(x,...).(LHS2 => RHS2)
2428 peel_implications(Parameters,ParCard,LHS,RHS, NewLHS,NewRHS) :-
2429 %print(forall),nl, print(Parameters),nl,print(LHS),nl,
2430 % this patterns occurs often in Event-B translations to classical B
2431 LHS=b(truth,_,_),
2432 RHS=b(implication(LHS2,RHS2),_,_), % TO DO: maybe also accept nested forall and then add to Parameters?
2433 (is_inf_or_overflow_card(ParCard) -> true ; ParCard>50),
2434 % larger bound than below: maybe user explicitly wants to expand it
2435 !,
2436 peel_implications(Parameters,ParCard,LHS2,RHS2, NewLHS,NewRHS).
2437 peel_implications(_,_,LHS,RHS, LHS,RHS).
2438
2439 b_generate_for_all_list_domain_nolwf(Parameters,LHS,RHS,LS,S,ForAllDomain,NewRHS,WF) :-
2440 ? parameter_list_cardinality(Parameters,ParCard),
2441 peel_implications(Parameters,ParCard,LHS,RHS, LHS2,RHS2),
2442 b_generate_for_all_list_domain1(Parameters,ParCard,LHS2,RHS2,LS,S,OForAllDomain,NewRHS,WF),
2443 optlist_to_list(OForAllDomain,ForAllDomain). % resolve any optional_value/2 items
2444
2445 % generate the domain of a Universally Quantified Formula as a list
2446 b_generate_for_all_list_domain1(Parameters,_ParCard,LHS,RHS,LS,S,ForAllDomain,NewRHS,WF) :-
2447 % optimized treatment for formulas of the form !x.(x:S => RHS) or !(x,y).(x|->y:S => RHS)
2448 % to do: expand to more formulas, such as !(x,y).(x:S & y:T => RHS)
2449 % or !(x,y,z).( (x|->y:S & y|->z:S) => RHS)
2450 % or !y.(y:1..(n-1) & f(y)=TRUE => f(y+1)=TRUE) --> !y.(y:1..(n-1) => (f(y)=TRUE => f(y+1)=TRUE))
2451 % or we could try and reify set membership for small domains and trigger implication
2452 is_for_all_set_membership_predicate(LHS,Parameters,Set,Pattern,ParameterValues),!,
2453 perfmessages_bexpr_call(good(forall),['Detected forall set membership over ',Ps,': '],
2454 LHS,bsyntaxtree:def_get_texpr_ids(Parameters,Ps)),
2455 NewRHS=RHS,
2456 b_generate_set_for_all_domain(Set,LS,S,Pattern,ParameterValues,ForAllDomain,WF).
2457 b_generate_for_all_list_domain1(Parameters,ParCard,LHS,RHS,LS,S,ForAllDomain,NewRHS,WF) :-
2458 b_generate_forall_closure(Parameters,LHS,LS,S,Closure,WF), % POSSIBLY NO NEED TO COMPILE
2459 b_generate_for_all_domain2(Closure,Parameters,ParCard,LHS,RHS,ForAllDomain,NewRHS,WF).
2460
2461 b_generate_for_all_domain2(Closure,_Parameters,_,LHS,RHS,ForAllDomain,NewRHS,WF) :-
2462 (LHS=b(truth,pred,_) ; ground_value(Closure)),
2463 !, NewRHS=RHS, % nl,print('FORALL EXPAND: '),(ground_value(Closure) -> print(ground(_Parameters)),nl, print_bexpr(LHS),nl ; print('NONGROUND!!'),nl,print_bexpr(RHS),nl), %%
2464 b_expand_closure_forall_to_list(Closure,ForAllDomain,WF).
2465 b_generate_for_all_domain2(_,Parameters,_,LHS,RHS,ForAllDomain,NewRHS,WF) :-
2466 is_a_conjunct(LHS,_,_), % otherwise we have already checked for set_membership above !
2467 LHS_Membership = b(member(_,_),_,_), % TO DO: also allow conjuncts
2468 ? member_conjunct(LHS_Membership,LHS,RestLHS),
2469 % !(x). ( x:Set & RestLHS => RHS) ---> !(x).(x:Set => (RestLHS => RHS))
2470 is_for_all_set_membership_predicate(LHS_Membership,Parameters,Set,Pattern,ParameterValues),
2471 ? max_cardinality_ok_for_expansion(Set,100,[],[]), % TO DO: simplify LS,S argument <----
2472 !,
2473 % as we expand Set without constraining RHS predicate, check if this is ok
2474 % indeed maximum cardinality of Set could be infinite !! !x.(x:NATURAL1 & x<N => P)
2475 % print('Splitting for all conjunct: '), print(Parameters),nl, print_bexpr(LHS_Membership),nl,print_bexpr(RestLHS),nl, %%
2476 perfmessage_bexpr(good(forall),'Splitting LHS of forall: ',LHS),
2477 NewRHS = b(implication(RestLHS,RHS),pred,[]), % TO DO: extract & join info
2478 b_generate_set_for_all_domain(Set,[],[],Pattern,ParameterValues,ForAllDomain,WF).
2479 b_generate_for_all_domain2(Closure,_Parameters,ParCard,LHS,RHS,ForAllDomain,NewRHS,WF) :-
2480 (is_inf_or_overflow_card(ParCard) -> true ; ParCard>8),
2481 !,
2482 NewRHS=RHS,
2483 perfmessage_bexpr(forall,'No optimisations applicable to forall (will delay until all variables are bound): ',LHS),
2484 % maybe we should generate this message only if ForAllDomain is var ?
2485 b_expand_closure_forall_to_list(Closure,ForAllDomain,WF).
2486 b_generate_for_all_domain2(_Closure,Parameters,ParCard,LHS,RHS,ForAllDomain,NewRHS,WF) :-
2487 NewLHS=b(truth,pred,[]), NewRHS=b(implication(LHS,RHS),pred,[]),
2488 b_generate_forall_closure(Parameters,NewLHS,[],[],Closure,WF),
2489 perfmessages_bexpr(good(forall),['Expanding forall with finite parameter type, card = ',ParCard,': '],LHS),
2490 b_expand_closure_forall_to_list(Closure,ForAllDomain,WF).
2491
2492 % code to decide whether a for all should be expanded if the
2493 % predicate contains a set membership predicate : !x.( (P & x:S & P') => Q)
2494 max_cardinality_ok_for_expansion(b(Expr,Type,_Info),Limit,LS,S) :- % which value to choose for Limit ??
2495 ? kernel_objects:max_cardinality(Type,TypeCard),
2496 ( (number(TypeCard),TypeCard =< Limit) -> true ;
2497 max_cardinality_ok_for_expansion2(Expr,Limit,TypeCard,LS,S)).
2498
2499 max_cardinality_ok_for_expansion1(b(E,_,_),Limit,TC,LS,S) :-
2500 max_cardinality_ok_for_expansion2(E,Limit,TC,LS,S).
2501
2502 :- use_module(custom_explicit_sets,[efficient_card_for_set/3]).
2503
2504 max_cardinality_ok_for_expansion2(set_extension(E),Limit,_TC,_,_) :- !, length(E,Len), Len =< Limit.
2505 max_cardinality_ok_for_expansion2(interval(Up,Low),Limit,_TC,LS,S) :- !,
2506 get_integer(UpI,Up,LS,S), get_integer(LowI,Low,LS,S),
2507 UpI-LowI<Limit.
2508 max_cardinality_ok_for_expansion2(integer_set(GS),Limit,_TC,_LS,_S) :- !, b_global_set_cardinality(GS,Card),
2509 number(Card), Card =< Limit.
2510 max_cardinality_ok_for_expansion2(set_subtraction(A,_),Limit,TC,LS,S) :- !,
2511 max_cardinality_ok_for_expansion1(A,Limit,TC,LS,S).
2512 max_cardinality_ok_for_expansion2(image(RelA,_),Limit,TC,LS,S) :- !,
2513 max_cardinality_ok_for_expansion1(RelA,Limit,TC,LS,S).
2514 max_cardinality_ok_for_expansion2(function(_RelA,_),_Limit,_TC,_LS,_S) :- !,
2515 fail. % TO DO: we should look at the size of the range elements
2516 % max_cardinality_ok_for_expansion1(_RelA,_Limit,_TC,_LS,_S).
2517 max_cardinality_ok_for_expansion2(intersection(A,B),Limit,TC,LS,S) :- !,
2518 (max_cardinality_ok_for_expansion1(A,Limit,TC,LS,S) -> true ; max_cardinality_ok_for_expansion1(B,Limit,TC,LS,S)).
2519 max_cardinality_ok_for_expansion2(union(A,B),Limit,TC,LS,S) :- !,
2520 max_cardinality_ok_for_expansion1(A,Limit,TC,LS,S), max_cardinality_ok_for_expansion1(B,Limit,TC,LS,S).
2521 max_cardinality_ok_for_expansion2(range(A),Limit,TC,LS,S) :- !,
2522 max_cardinality_ok_for_expansion1(A,Limit,TC,LS,S).
2523 max_cardinality_ok_for_expansion2(domain(A),Limit,TC,LS,S) :- !,
2524 max_cardinality_ok_for_expansion1(A,Limit,TC,LS,S).
2525 max_cardinality_ok_for_expansion2(domain_restriction(_A,B),Limit,TC,LS,S) :- !,
2526 max_cardinality_ok_for_expansion1(B,Limit,TC,LS,S). % note: finite A does not guarantee finite result
2527 max_cardinality_ok_for_expansion2(domain_subtraction(_A,B),Limit,TC,LS,S) :- !,
2528 max_cardinality_ok_for_expansion1(B,Limit,TC,LS,S).
2529 max_cardinality_ok_for_expansion2(range_restriction(A,_B),Limit,TC,LS,S) :- !,
2530 max_cardinality_ok_for_expansion1(A,Limit,TC,LS,S). % note: finite B does not guarantee finite result
2531 max_cardinality_ok_for_expansion2(range_subtraction(A,_B),Limit,TC,LS,S) :- !,
2532 max_cardinality_ok_for_expansion1(A,Limit,TC,LS,S).
2533 max_cardinality_ok_for_expansion2(direct_product(A,B),Limit,TC,LS,S) :- !,
2534 max_cardinality_ok_for_expansion2(cartesian_product(A,B),Limit,TC,LS,S).
2535 max_cardinality_ok_for_expansion2(parallel_product(A,B),Limit,TC,LS,S) :- !,
2536 max_cardinality_ok_for_expansion2(cartesian_product(A,B),Limit,TC,LS,S).
2537 max_cardinality_ok_for_expansion2(cartesian_product(A,B),Limit,TC,LS,S) :- !,
2538 ILimit is Limit//2, ILimit>0, %use sqrt ?
2539 max_cardinality_ok_for_expansion1(A,ILimit,TC,LS,S),
2540 max_cardinality_ok_for_expansion1(B,ILimit,TC,LS,S).
2541 max_cardinality_ok_for_expansion2(value(S),Limit,_TC,_LS,_S) :- !,
2542 get_max_card_for_value(S,MaxCard),
2543 MaxCard =< Limit.
2544 max_cardinality_ok_for_expansion2(identifier(_ID),_Limit,TC,_LS,_S) :- !, number(TC).
2545 % TO DO: check if ID is fully defined; if so use card else accept as it will
2546 % probably be represented by a list and the forall constraints could be useful in finding ID's value
2547 % we have to store/compute ID anyway (could be infinite closure; hence check that TC is a number); a bit of a hack; is there a more principled way?
2548 max_cardinality_ok_for_expansion2(external_function_call(_,_),_,_,_,_) :- !,fail.
2549 max_cardinality_ok_for_expansion2(lazy_lookup_expr(_),_,_,_,_) :- !,fail.
2550 max_cardinality_ok_for_expansion2(record_field(_,_),_Limit,_TC,_LS,_S) :- !, fail.
2551 max_cardinality_ok_for_expansion2(E,Limit,TC,_LS,_S) :- functor(E,F,N),
2552 print(unknown_max_card(F/N,Limit,TC)),nl,fail.
2553
2554
2555 :- use_module(kernel_cardinality_attr,[clpfd_card_domain_for_var/3]).
2556
2557 get_max_card_for_value(S,MaxCard) :- var(S), !,
2558 clpfd_card_domain_for_var(S,_,Max),
2559 number(Max),
2560 MaxCard=Max.
2561 get_max_card_for_value([],R) :- !, R=0.
2562 get_max_card_for_value([_|T],R) :- !,get_max_card_for_value(T,TMax), R is TMax+1.
2563 get_max_card_for_value(S,Card) :- efficient_card_for_set(S,Card,C),!,
2564 call(C), number(Card).
2565
2566
2567 get_integer(X, b(Expr,integer,_),LS,S) :- get_integer2(Expr,X,LS,S).
2568 get_integer2(integer(X),X,_,_) :- number(X).
2569 get_integer2(identifier(Id),Val,LS,S) :- lookup_value(Id,LS,S,int(Val)), number(Val).
2570
2571 member_conjunct(Predicate,Conjunction,Rest) :-
2572 conjunction_to_list(Conjunction,List),
2573 ? select(Predicate,List,RestList),
2574 conjunct_predicates(RestList,Rest).
2575 % member_conjunct(Conj,Conj,b(truth,pred,[])). covered by case above
2576
2577 b_generate_set_for_all_domain(Set,LS,S,Pattern,ParameterValues,ForAllDomain,WF) :-
2578 b_compute_expression(Set,LS,S,EvSet,WF),
2579 expand_custom_set_to_list_wf(EvSet,ESet,_Done,b_generate_set_for_all_domain,WF),
2580 filter_and_convert_list_to_parameter_tuples(ESet,Pattern,ParameterValues,ForAllDomain).
2581
2582
2583 % check if it is a predicate of the form x:S or x:Sx & y:Sy ... which we can optimize
2584 % (i.e. compute SET before all values inside it are fully known)
2585 is_for_all_set_membership_predicate(LHS,Parameters,Set,Pattern,ParameterValues) :-
2586 % print('CHECK FORALL : '), translate:print_bexpr(LHS),nl,nl,
2587 get_texpr_ids(Parameters,ParIDs), % TO DO: call get_texpr_ids before
2588 same_length(ParIDs,ParameterValues),
2589 is_for_all_set_membership_predicate2(LHS,ParIDs,ParIDs,UnmatchedParIDs,Set,Pattern,ParameterValues,_UPV),
2590 UnmatchedParIDs=[].
2591
2592 % TODO: maybe also deal with existential quantifiers #x.(x|->y:Set) -> in Pattern x becomes free var
2593 is_for_all_set_membership_predicate2(LHS,All,ParIDs,UnmatchedParIDs,Set,Pattern,ParameterValues,UPV) :-
2594 is_member_test(LHS,Element,Set),
2595 !,
2596 identifiers_not_used_in_bexp(All,Set),
2597 convert_to_prolog_pattern_match(Element,ParIDs,UnmatchedParIDs,Pattern,ParameterValues,UPV).
2598 % TO DO: also allow failing pattern matches ?!; at least when splitting
2599 is_for_all_set_membership_predicate2(LHS,All,ParIDs,ParIDs2,Set,
2600 (Pat1,Pat2),ParameterValues,UPV) :-
2601 is_a_conjunct(LHS,LHS1,LHS2), % we could have something of the form x:Sx & y:Sy ...
2602 Set = b(cartesian_product(Set1,Set2),couple(T1,T2),[]),
2603 is_for_all_set_membership_predicate2(LHS1,All,ParIDs, ParIDs1,Set1,Pat1,ParameterValues,PV1),
2604 get_texpr_type(Set1,T1),
2605 !,
2606 is_for_all_set_membership_predicate2(LHS2,All,ParIDs1,ParIDs2,Set2,Pat2,PV1,UPV),
2607 get_texpr_type(Set2,T2).
2608
2609 % TO DO: maybe use a more general test to be reused in other places
2610 is_member_test(b(P,_,_),Element,Set) :- is_member_test_aux(P,Element,Set).
2611 is_member_test_aux(member(Element,Set),Element,Set).
2612 % also detect equalities: important for tests 28,29 after b_compiler can introduce equalities for singleton set memberships
2613 is_member_test_aux(equal(Element,SetVal),Element,Set) :- % TO DO : also other direction + other kinds of values ?
2614 SetVal = b(value(SV),T,I),
2615 Set = b(value([SV]),set(T),I).
2616
2617 identifiers_not_used_in_bexp(IDList,Expr) :-
2618 find_identifier_uses(Expr,[],Used),
2619 id_check(IDList,Used).
2620 id_check([],_).
2621 id_check([ID|T],Used) :-
2622 nonmember(ID,Used), !,
2623 id_check(T,Used).
2624
2625 % check if an expression can be converted to a Prolog linear unification/pattern match
2626 % give an list of free identifiers IDS
2627 convert_to_prolog_pattern_match(b(E,_,_),IDS,OutIDS,Pattern,VarsIn,VarsOut) :-
2628 convert_to_prolog_pattern_match2(E,IDS,OutIDS,Pattern,VarsIn,VarsOut).
2629
2630 convert_to_prolog_pattern_match2(identifier(ID),IDsIn,IDsOut,PatVariable,VarsIn,VarsOut) :-
2631 % check that the identifier is in the list of quantified variables and thus unbound
2632 !,
2633 ? (nth1(Nr,IDsIn,ID,IDsOut)
2634 -> nth1(Nr,VarsIn,PatVariable,VarsOut) % put fresh PatVariable in the Pattern
2635 ),!.
2636 convert_to_prolog_pattern_match2(couple(ID1,ID2),IDS,OutIDS,Pattern,VarsIn,VarsOut) :-
2637 Pattern = (Pat1,Pat2),
2638 convert_to_prolog_pattern_match(ID1,IDS,RemIDS,Pat1,VarsIn,VarsInt),
2639 convert_to_prolog_pattern_match(ID2,RemIDS,OutIDS,Pat2,VarsInt,VarsOut).
2640 convert_to_prolog_pattern_match2(value(V),IDsIn,IDsOut,Pattern,VarsIn,VarsOut) :-
2641 can_be_used_for_unification(V), % check if we can use Prolog unification for equality
2642 !, Pattern=V, IDsOut=IDsIn, VarsIn=VarsOut.
2643 % TO DO: records?
2644
2645 % a pattern match code to be used with above; ensure we do not instantiate values
2646 pattern_match(PatVar,Val,Res) :- var(PatVar),!,PatVar=Val, Res=pred_true. % we have a free pattern variable
2647 pattern_match((Pat1,Pat2),(V1,V2),Res) :- !,
2648 pattern_match(Pat1,V1,R1), conjoin_simple(R1,R2,Res),
2649 pattern_match(Pat2,V2,R2).
2650 pattern_match(GroundPatVal,Val,Res) :- % we have a value that can_be_used_for_unification
2651 when( ?=(GroundPatVal,Val), (GroundPatVal=Val -> Res=pred_true ; Res=pred_false)).
2652
2653 :- block conjoin_simple(-,?,?). % TO DO: also allow second arg to unblock
2654 conjoin_simple(pred_true,X,X).
2655 conjoin_simple(pred_false,_,pred_false).
2656
2657 % similar to get_template(V,T,[])
2658 % but more restricted; we only accept those values where equality corresponds to Prolog unification
2659 % get_template is different and can assume normalized values, e.g., for empty set
2660 % pairs are treated above in convert_to_prolog_pattern_match2
2661 % see test 2528
2662 can_be_used_for_unification(V) :- var(V),!,fail.
2663 can_be_used_for_unification(int(V)) :- integer(V).
2664 can_be_used_for_unification(string(S)) :- ground(S).
2665 can_be_used_for_unification(fd(S,T)) :- ground(S), ground(T).
2666 can_be_used_for_unification(pred_false).
2667 can_be_used_for_unification(pred_true).
2668 can_be_used_for_unification(term(T)) :- nonvar(T), T=floating(F), number(F). % unless real_solver used??
2669 % TODO: simple atomic freevalues?
2670
2671
2672 % take a list and a pattern and filter the values that do not match the Pattern
2673 % Unification with the Pattern also instantiates the ParameterValues
2674 % used for triggering and instantiating right-hand-side of forall: !x.(x:Set => RHS)
2675 % TODO: Instead of converting to a Prolog Unification we could use kernel_equality instead of pattern_match
2676 % but this is not obvious, as the pattern contains free variables and equality would never return true
2677 % we would need to apply kernel_equality only to the ground pattern parts
2678 :- block filter_and_convert_list_to_parameter_tuples(-,?,?,?).
2679 filter_and_convert_list_to_parameter_tuples([],_,_,[]).
2680 filter_and_convert_list_to_parameter_tuples([H|T],Pattern,ParameterValues,Res) :-
2681 copy_term((Pattern,ParameterValues),(CPat,CPV)),
2682 pattern_match(CPat,H,PredRes), % check if pattern matches new element H in set; careful not to instantiate H
2683 ? filter_and_convert_list_to_parameter_tuples_aux(PredRes,CPV,T,Pattern,ParameterValues,Res).
2684
2685 :- block filter_and_convert_list_to_parameter_tuples_aux(-,?,-,?,?,?).
2686 filter_and_convert_list_to_parameter_tuples_aux(PredRes,CPV,T,Pattern,ParameterValues,Res) :-
2687 var(PredRes),!, % we cannot decide yet whether the optional value is to be used or not
2688 Res = [optional_value(CPV,PredRes)|RT], % create constructor for map_optlist or similar
2689 filter_and_convert_list_to_parameter_tuples(T,Pattern,ParameterValues,RT).
2690 filter_and_convert_list_to_parameter_tuples_aux(PredRes,CPV,T,Pattern,ParameterValues,Res) :-
2691 (PredRes = pred_true % we have a match, universal quantifier applies to H
2692 -> Res = [CPV|RT]
2693 ; % element of set does not match pattern; universal quantifier does not apply
2694 % ProB used to only accept non-failing pattern matches;
2695 % now we also accept tuples with static parts where Prolog unification can fail
2696 Res=RT
2697 ),
2698 ? filter_and_convert_list_to_parameter_tuples(T,Pattern,ParameterValues,RT).
2699
2700 :- use_module(tools,[map_optlist/2,optlist_to_list/2]).
2701 :- use_module(library(lists),[maplist/3]).
2702 expand_forall1(OList,RHS,Parameters,WF) :-
2703 ground_bexpr(RHS), % because compiled this means we cannot do any constraint propagation on variables in RHS
2704 optlist_to_list(OList,List),
2705 ground_value(List), % ditto here: no variables on which we could do constraint propagation
2706 %% preferences:get_preference(double_evaluation_when_analysing,false), % causes test 1112 to fail TO DO:fix
2707 % otherwise we do not have a real redundancy wrt to not exists check
2708 debug_println(15,ground_forall_translating_into_not_exists(Parameters)),
2709 !,
2710 init_quantifier_wait_flag(WF,forall,Parameters,ParResult,unknown,LocalWF),
2711 % Advantage over treatment below: NegRHS is interpreted only once
2712 % but we cannot provide any instantiations and there must not be any links with variables outside of the forall !!
2713 create_negation(RHS,NegRHS),
2714 not_with_enum_warning( (
2715 b_interpreter:test_forall_instance(NegRHS,Parameters,LocalWF,negative,ParResult),
2716 % test_forall_instance can fail; if inconsistency detected in WF0
2717 kernel_waitflags:ground_det_wait_flag(LocalWF),
2718 member(ParResultInList,List), % check the body for every solution
2719 lists:maplist(kernel_objects:equal_object,ParResultInList,ParResult), % match params with solutions of domain
2720 kernel_waitflags:ground_wait_flags(LocalWF)
2721 ), LocalWF, forall(Parameters), RHS
2722 ).
2723 expand_forall1(List,RHS,Parameters,WF) :-
2724 % blocking version of maplist which also filters out some optional_value/2 terms:
2725 ? map_optlist(b_interpreter:test_forall_instance(RHS,Parameters,WF,positive),List).
2726
2727 % test RHS of a forall for a particular valuation ParResult of the Parameters
2728 test_forall_instance(RHS,Parameters,WF,NegationContext,ParResult) :-
2729 LocalState=[],State=[],
2730 ? if(set_up_typed_localstate(Parameters,ParResult,_TypedVals,LocalState,NewLocalState,NegationContext),
2731 true,
2732 (nl,print(set_up_typed_localstate_failed(Parameters,ParResult,_,LocalState,NewLocalState)),nl,
2733 % it can happen that ParResult has constraints on it and that setting up the typing info detects the error
2734 % add_internal_error('Call failed: ', set_up_typed_localstate(Parameters,ParResult,_,LocalState,NewLocalState)),
2735 fail)),
2736 ? b_optimized_b_test_instance(RHS,NewLocalState,State,WF).
2737
2738 reification_relevant_for_op(implication(_,_)).
2739 reification_relevant_for_op(equivalence(_,_)).
2740 reification_relevant_for_op(disjunct(_,_)).
2741 % TODO: maybe check if a conjunct contains implication
2742 % relevant for example for: n=2000 & f:1..n-->BOOL & !i.(i:2..n => (f(i)=TRUE =>f(i-1)=FALSE)) & f(1)=TRUE
2743
2744 b_optimized_b_test_instance(RHS,NewLocalState,State,WF) :-
2745 get_texpr_expr(RHS,RE), reification_relevant_for_op(RE), % we will attempt reification
2746 attempt_reification,
2747 \+ always_well_defined(RHS), % this will prevent reification
2748 !,
2749 % try and compile in the hope that now the WD issue disappears:
2750 b_compiler:b_optimize(RHS,[],NewLocalState,State,NewRHS,WF),
2751 b_test_boolean_expression(NewRHS,NewLocalState,State,WF).
2752 b_optimized_b_test_instance(RHS,NewLocalState,State,WF) :-
2753 ? b_test_boolean_expression(RHS,NewLocalState,State,WF).
2754 % using b_test_inner_boolean_expression considerably slows down NQueens, Sudoku,...
2755 % WF=InnerWF. /* give the boolean expression a chance to do ground propagations first */
2756
2757
2758 % use this when the test boolean expression could be called with WF0 already set
2759 % give the inner expression a chance to do the deterministic stuff first
2760 b_test_inner_boolean_expression(Pred,LocalState,State,WF) :-
2761 clone_wait_flags_from1(WF,GroundUponFinish,WF2),
2762 % set WF0 to variable to propagate deterministic infos first:
2763 ? b_test_boolean_expression(Pred,LocalState,State,WF2),
2764 ? clone_wait_flags_from1_finish(WF,GroundUponFinish,WF2).
2765 % the same for testing negation of a predicate:
2766 b_not_test_inner_boolean_expression(Pred,LocalState,State,WF) :-
2767 clone_wait_flags_from1(WF,GroundUponFinish,WF2),
2768 % set WF0 to variable to propagate deterministic infos first:
2769 ? b_not_test_boolean_expression(Pred,LocalState,State,WF2),
2770 ? clone_wait_flags_from1_finish(WF,GroundUponFinish,WF2).
2771
2772 /* now the same as above; but without converting list of values into pairs */
2773 :- assert_pre(b_interpreter:b_expand_closure_forall_to_list(Closure,_Result,_WF),
2774 (nonvar(Closure), custom_explicit_sets:is_closure(Closure,_Parameters,_ParameterTypes,ClosureBody),
2775 nonvar(ClosureBody),
2776 bsyntaxtree:check_if_typed_predicate(ClosureBody))).
2777 :- assert_post(b_interpreter:b_expand_closure_forall_to_list(_Closure,Result,_WF),
2778 b_interpreter:value_type(Result)).
2779 b_expand_closure_forall_to_list(Closure,Result,WF) :- nonvar(Closure),
2780 Closure = closure(Parameters,ParameterTypes,ClosureBody),
2781 !,
2782 % print('Expand closure forall: '), translate:print_bexpr(ClosureBody),nl,
2783 % at the moment we may wait too long before expanding this closure
2784 % what if we have f(1) in the ClosureBody: in principle we only need to wait until f(1) known or even f sekeleton set up ? compilation now solves this issue ?
2785 (performance_monitoring_on,
2786 term_variables(ClosureBody,Vars),
2787 Vars \= []
2788 ->
2789 perfmessagecall(delaying_forall(Parameters,vars(Vars),out(ParValues)),
2790 translate:print_bexpr(ClosureBody),ClosureBody)
2791 ; true),
2792 ground_bexpr_check(ClosureBody,BodyGround),
2793 add_texpr_infos(ClosureBody,[quantifier_kind(forall)],ClosureBody1), % for call_stack
2794 delay_setof_list_wf( ParValues,
2795 %% (print_bt_message(expanding_forall_closure(Parameters,ClosureBody,ParValues)), %%
2796 custom_explicit_sets:b_test_closure(Parameters,ParameterTypes,ClosureBody1,
2797 ParValues,all_solutions,WF)
2798 %% ,print_bt_message(expanded(Parameters,ParValues)) ) %%
2799 ,
2800 Result,
2801 BodyGround,WF).
2802 b_expand_closure_forall_to_list(Closure,Result,WF) :-
2803 add_internal_error('Illegal Call: ', b_expand_closure_forall_to_list(Closure,Result,WF)),
2804 fail.
2805
2806
2807 :- assert_pre(b_interpreter:set_up_typed_localstate(V,S,_), (list_skeleton(V),list_skeleton(S))).
2808 :- assert_post(b_interpreter:set_up_typed_localstate(_,_,R),list_skeleton(R)).
2809
2810 set_up_typed_localstate(Identifiers,InState,OutState) :-
2811 ? set_up_typed_localstate(Identifiers,_FreshVars,_TypedVals,InState,OutState,positive).
2812
2813 :- use_module(b_enumerate,[construct_typedval_infos/4]).
2814 set_up_typed_localstate([],[],[],State,State,_).
2815 set_up_typed_localstate([Identifier|IdRest],[Val|ValRest],[typedval(Val,Type,Var,TINFO)|TRest],
2816 % TO DO: add info field to typedval: source_span, and lambda_result/do_not_enumerate infos
2817 InState,OutState,NegationContext) :-
2818 % The other way round (first add Identfier, then IdRest) would be more efficient,
2819 % but we do it this way to keep compatibility with a previous version.
2820 % In specfile:compute_operation_effect, the arguments of an operation are in the same order than in the store
2821 ? set_up_typed_localstate(IdRest,ValRest,TRest,InState,InterState,NegationContext),
2822 def_get_texpr_id(Identifier,Var), get_texpr_type(Identifier,Type),
2823 get_texpr_info(Identifier,Info),
2824 triggers_enum_warning(Var,Type,Info,NegationContext,TriggersEnumWarning),
2825 get_texpr_info(Identifier,Infos),construct_typedval_infos(Var,Infos,TriggersEnumWarning,TINFO),
2826 ? add_typed_var_to_localstate(Var,Val,Type,InterState,OutState).
2827
2828 % same version; but with list of atomic ids and list of types
2829 set_up_typed_localstate2([],[],_,[],[],State,State,_).
2830 set_up_typed_localstate2([Var|IdRest],[Type|TyRest],Infos,[Val|ValRest],[typedval(Val,Type,Var,TINFO)|TRest],
2831 InState,OutState,NegationContext) :-
2832 % The other way round (first add Identfier, then IdRest) would be more efficient,
2833 % but we do it this way to keep compatibility with a previous version.
2834 % In specfile:compute_operation_effect, the arguments of an operation are in the same order than in the store
2835 ? set_up_typed_localstate2(IdRest,TyRest,Infos,ValRest,TRest,InState,InterState,NegationContext),
2836 triggers_enum_warning(Var,Type,Infos,NegationContext,TriggersEnumWarning),
2837 construct_typedval_infos(Var,Infos,TriggersEnumWarning,TINFO),
2838 ? add_typed_var_to_localstate(Var,Val,Type,InterState,OutState).
2839
2840 % possible values for NegationContext: positive, negative, all_solutions
2841 triggers_enum_warning(Id,Type,Info,all_solutions,Res) :- !,
2842 Res = trigger_throw(b(identifier(Id),Type,Info)).
2843 %triggers_enum_warning(Id,_Type,Info,NegationContext,trigger_false(Id)) :- % no longer used
2844 % NegationContext=positive, % when negated then success will occur if all possibilities have been tried out
2845 % memberchk(introduced_by(exists),Info),
2846 % %%((preferences:get_preference(disprover_mode,true),type_contains_unfixed_deferred_set(Type))-> fail % otherwise %finding a solution may depend on the size of the deferred set; true),
2847 % %% The Disprover now checks whether unfixed_deferred sets were involved; keeping track of implicit enumerations of %deferred sets is just too difficult
2848 % !.
2849 triggers_enum_warning(Id,Type,Info,_,trigger_true(b(identifier(Id),Type,Info))).
2850
2851
2852 add_typed_var_to_localstate(Var,Val,Type,InState,OutState) :-
2853 add_var_to_localstate(Var,Val,InState,OutState),
2854 %%when(ground(Val), (print(' ++ '),print(Var),print(' ---> '), print(Val),nl)),
2855 ? kernel_objects:basic_type(Val,Type). %% ,print(ok(Val)),nl.
2856
2857 /*
2858 xxb_test_exists(Parameters,Condition,Infos,LocalState,State,WF) :-
2859 b_check_boolean_expression(b(exists(Parameters,Condition),pred,Infos),LocalState,State,WF,NR),
2860 get_exists_used_ids(Parameters,Condition,Infos,Used),lookup_values_if_vars(Used,LocalState,State,WaitVars),
2861 \+ ground(WaitVars),
2862 !,
2863 debug_println(9,unfolding_exists(Parameters)), print(unfolding(Parameters)),nl,
2864 %translate:print_bexpr(Condition),nl, print(State),nl, print(LocalState),nl,nl,
2865 NR=pred_true. %, print(set_res(pred_true)),nl.
2866 % if enabled it slows down: ./probcli examples/EventBPrologPackages/SET_Game/SET_GAM_Sym_NoSet20_mch.eventb -mc 10000000 -p SYMMETRY_MODE hash -p TIME_OUT 7000 -p CLPFD TRUE -df -goal "n=18" -p MAX_OPERATIONS 20 -strict -expcterr goal_found
2867 */
2868
2869 b_test_exists(Parameters,Condition,Infos,LocalState,State,WF) :-
2870 get_wait_flag0(WF,WF0),
2871 ? b_test_exists(WF0,Parameters,Condition,Infos,LocalState,State,WF).
2872
2873 :- block b_test_exists(-,?,?, ?,?,?,?).
2874 b_test_exists(_LWF,Parameters,Condition,Infos,LocalState,State,WF) :-
2875 if((attempt_reification, % what if there is a wd_condition attached to Condition?
2876 b_interpreter_check:b_check_exists_wf(Parameters,Condition,Infos,LocalState,State,WF,ReificationVariable)),
2877 % try and expand quantifiers of small cardinality; see also expand_forall_quantifier
2878 % tested in test 1452
2879 (debug_println(9,expanded_exists(Parameters)),
2880 ReificationVariable=pred_true),
2881 ? b_test_exists_wo_expansion(Parameters,Condition,Infos,LocalState,State,WF)).
2882
2883 %attempt_reification :- preferences:preference(use_clpfd_solver,true),!. % all tests seem to pass
2884 attempt_reification :- preferences:preference(use_smt_mode,true),!.
2885 attempt_reification :- preferences:preference(solver_strength,SS), SS>9.
2886 % TO DO: maybe take context into account: setup constants, becomes such, ... allow_skipping_over_components/reset_component_info(true)
2887
2888 :- use_module(kernel_tools,[bexpr_variables/2, value_variables/3]).
2889
2890 % we treat the existential quantifier without expansion into a disjuncition aka reification
2891 b_test_exists_wo_expansion(Parameters,Condition,Infos,LocalState,State,WF) :-
2892 %print(test_exists(Parameters,Infos)),nl,portray_waitflags(WF),nl,
2893 ? (preference(lift_existential_quantifiers,true) ; member(allow_to_lift_exists,Infos)),
2894 !, % we enumerate the exists normally; treat it just like an ordinary predicate
2895 % lifting may generate multiple solutions; but avoids delaying enumeration of quantified parameters
2896 % print('*Lifting existential quantifier: '), translate:print_bexpr(Condition),nl,
2897 ? set_up_typed_localstate(Parameters,ParaValues,TypedVals,LocalState,NewLocalState,positive),
2898 copy_wf_start(WF,b_test_exists_wo_expansion,CWF),
2899 opt_push_wait_flag_call_stack_quantifier_info(CWF,exists,Parameters,ParaValues,Infos,CWF2),
2900 ? b_test_boolean_expression(Condition,NewLocalState,State,CWF2),
2901 % often we do not need to enumerate TypedVals; they can be derived, but we could have #y.(y>x) and need to enum y
2902 b_tighter_enumerate_values_in_ctxt(TypedVals,Condition,CWF2),
2903 ? copy_wf_finish(WF,CWF2). % moving this before tighter_enum may mean that we have more precise ranges; but this can be counter-productive (e.g., for test 1162 unless we strengthen the useless enum analysis)
2904 b_test_exists_wo_expansion(Parameters,Condition,Infos,LocalState,State,WF) :-
2905 get_exists_used_ids(Parameters,Condition,Infos,Used),
2906 % IT IS IMPORTANT THAT THE USED INFO IS CORRECT ; otherwise the WaitVars will be incorrect
2907 % The used_ids info does not include the Parameters of the existential quantifier !
2908 ? set_up_typed_localstate(Parameters,ParaValues,TypedVals,LocalState,NewLocalState,positive),
2909 lookup_values_if_vars(Used,LocalState,State,WaitVarsState), % TO DO: we could use b_compiler instead
2910 % What if the Condition was compiled and now contains a previously used_variable inside a closure/value ?
2911 %term_variables((Condition,WaitVarsState),WaitVars), % this can be expensive when we have large data values (see rule_RVF219/rule_RVF219_compo.mch)
2912 bexpr_variables(Condition,CondVars),
2913 value_variables(WaitVarsState,CondVars,WaitVars),
2914 % now determine which WaitVars are really worth waiting for, e.g., do not wait for res in #x.(x:E & ... res=min(f(x)))
2915 % relevant tests: 1868, 1194, 383, 1642, 1708, 1003, 1080, 1081, 1943
2916 (remove_ids_defined_by_equality(WaitVars,LocalState,State,Infos,RealWaitVars) -> RemovedVars=true
2917 ; RealWaitVars = WaitVars, RemovedVars=false),
2918 opt_push_wait_flag_call_stack_quantifier_info(WF,exists,Parameters,ParaValues,Infos,WF2),
2919 create_inner_wait_flags(WF2,expansion_context(b_test_exists,Parameters),LocalWF), % we are creating inner waitflags here as the exist will wait anyway; LocalWF shares just WFE flag with WF
2920 ? b_test_boolean_expression(Condition,NewLocalState,State,LocalWF), /* check Condition */
2921 ? ground_det_wait_flag(LocalWF), % print('det no contradiction'),nl,flush_output,
2922 b_tighter_enumerate_values_in_ctxt(TypedVals,Condition,LocalWF), % will not yet enumerate
2923 (% we could treat allow_to_lift_exists also here by setting ESWF=1; but 1162 then fails
2924 get_preference(data_validation_mode,true),
2925 not_generated_exists_paras(Parameters) % generated exists, e.g., for relational composition can lead to virtual timeouts, cf Thales_All/rule_zcpa2.mch in test 2287
2926 -> get_wait_flag(50000,b_test_exists(Parameters),WF,ESWF) % 100000 sufficient for test 1945; 869 for rule_CHAMPS in private_examples/ClearSy/2023
2927 ; get_enumeration_starting_wait_flag(b_test_exists(Parameters),WF,ESWF)), %% TO DO: get flag when enumeration of infinite type starts; maybe if domain of exists is small we can start enumerating earlier ?? <-> relation with lifting exists in closure expansion heuristic
2928 when((nonvar(ESWF);ground(RealWaitVars)),b_enumerate_exists(ESWF,RemovedVars,WaitVars,Parameters,Infos,LocalWF,WF)).
2929
2930
2931 :- use_module(tools,[remove_variables/3]).
2932 :- use_module(kernel_tools,[value_variables/2]).
2933 % if we have #x.( P & y = E(x)) we do not have to wait for y to be known
2934 remove_ids_defined_by_equality(WaitVars,LocalState,State,Infos,RealWaitVars) :- WaitVars \== [],
2935 memberchk(used_ids_defined_by_equality(Ideq),Infos),
2936 Ideq = [ID1|_], % currently we only look at one used_id defined by equality,
2937 % we could have #x.(P & y=E(z) & z=E(y)): TODO: improve computation in ast_cleanup
2938 (memberchk(bind(ID1,VAL),LocalState) -> true ; memberchk(bind(ID1,VAL),State)),
2939 value_variables(VAL,VARS),
2940 remove_variables(WaitVars,VARS,RealWaitVars),
2941 debug_println(9,removed_ids_def_by_equality(WaitVars,ID1,RealWaitVars)).
2942
2943
2944 b_enumerate_exists(ESWF,RemovedVars,WaitVars,Parameters,Infos,LocalWF,WF) :-
2945 %print(enum_exists(ESWF,RemovedVars,WaitVars,Parameters,LocalWF,WF)),nl,
2946 ((RemovedVars=false,var(ESWF) ; % WaitVars guaranteed to be ground
2947 ground(WaitVars)) % TODO: replace this by an optimised version of ground check
2948 -> get_idle_flag(Parameters,WF,LWF),
2949 /* allow all other co-routines waiting on WaitVars to complete */
2950 /* Note however: if WF grounding as triggered two non-deterministic co-routines this
2951 will allow the other non-determinism to run first, duplicating the number of calls !
2952 This has been fixed by storing seperate waitflag variables for same prio in kernel_waitflags
2953 TODO: However, for enumeration of FD variables this might still happen and lead to duplication of
2954 calls to b_enumerate_exists_aux_ground
2955 */
2956 %print(get_idle(Parameters,WaitVars)),nl, %kernel_waitflags:portray_waitflags(WF),nl,nl,
2957 b_enumerate_exists_aux_ground(LWF,WaitVars,Parameters,Infos,LocalWF,WF)
2958 ; debug_println(9,semi_lifting_exists(ESWF,Parameters)),
2959 % add_message_wf(exists,'Semi-lifting exists:',Parameters,Parameters,WF),portray_waitflags(LocalWF),nl,
2960 copy_waitflag_store(LocalWF,WF) % outer WF will now drive enumeration
2961 % Note: in case a LET has been moved inside and replaced this may lead to duplication
2962 ).
2963
2964 :- if(environ(prob_safe_mode,true)).
2965 get_idle_flag(Parameters,WF,LWF) :- get_idle_wait_flag(b_enumerate_exists(Parameters),WF,LWF),
2966 (var(LWF) -> true ; add_internal_error('Illegal idle waitflag for exists:',get_idle_flag(Parameters,WF,LWF))).
2967 :- else.
2968 get_idle_flag(Parameters,WF,LWF) :- get_idle_wait_flag(b_enumerate_exists(Parameters),WF,LWF).
2969 :- endif.
2970
2971 :- block b_enumerate_exists_aux_ground(-,?,?,?,?,?).
2972 b_enumerate_exists_aux_ground(_,_WaitVars,Parameters,Infos,LocalWF,_WF) :-
2973 /* Note: this does a local cut: so it is important
2974 that all conditions are fully evaluated before performing the cut ; otherwise
2975 solutions will be lost */
2976 % print_bt_message('ENUMERATE EXISTS'(_Parameters)),nl, % portray_waitflags(_WF),
2977 if(ground_wait_flags_for_exists(Parameters,LocalWF),true,
2978 (perfmessage(exists,'Late bound exists failed: ',Parameters,Infos),fail)).
2979
2980
2981 ground_wait_flags_for_exists(Parameters,LocalWF) :-
2982 \+ enumeration_warning_occured_in_error_scope,
2983 get_current_error_scope(Level),
2984 ? \+ error_manager:throw_error(Level,_,_),
2985 !, % current scope is already clean, no need to enter a fresh one
2986 ground_wait_flags_for_exists2(Parameters,LocalWF,Level).
2987 ground_wait_flags_for_exists(Parameters,LocalWF) :-
2988 enter_new_clean_error_scope(Level,ground_wait_flags_for_exists),
2989 % Note: see {x|x:1..10 & #y.(y>x & y*y >10)} in test 2210:
2990 % we do not want to throw enum warnings even if the outer scope does in case a solution is found
2991 % NOTE: if this engenders an enumeration warning: it may have been better to enumerate the outer WF first ?! : but as WaitVars are ground, so only failure of outer WF could help us here in preventing enumeration warning
2992 call_cleanup(ground_wait_flags_for_exists2(Parameters,LocalWF,Level),
2993 exit_error_scope(Level,_,ground_wait_flags_for_exists)).
2994
2995 ground_wait_flags_for_exists2(_Parameters,LocalWF,Level) :-
2996 ? (ground_constraintprop_wait_flags(LocalWF)
2997 -> % local cut: one solution is sufficient.
2998 clear_enumeration_warning_in_error_scope(Level)
2999 % ; %print(fail),nl, % do not clear enumeration warnings fail
3000 ).
3001
3002
3003 :- use_module(b_ast_cleanup,[check_used_ids_info/4]).
3004 get_exists_used_ids(Parameters,Condition,Infos,Used) :-
3005 preference(prob_safe_mode,true),!,
3006 ? (select(used_ids(Used),Infos,Rest)
3007 -> check_used_ids_info(Parameters,Condition,Used,exists), %% comment in to check used_ids field
3008 (member(used_ids(_),Rest)
3009 -> add_internal_error('Multiple used_ids info fields:',Parameters:Infos) ; true)
3010 ;
3011 add_internal_error(
3012 'Expected information of used identifiers in exists information',Parameters:Infos),
3013 bsyntaxtree:find_identifier_uses(Condition, [], Used)
3014 ).
3015 get_exists_used_ids(Parameters,Condition,Infos,Used) :-
3016 ? member(used_ids(Used),Infos) -> true
3017 ;
3018 add_internal_error(
3019 'Expected information of used identifiers in exists information',Parameters:Infos),
3020 bsyntaxtree:find_identifier_uses(Condition, [], Used).
3021 % what if we call test_exists for a negated universal quantifier ??
3022
3023
3024
3025
3026 :- use_module(kernel_tools,[ground_state/1]).
3027 /* the following causes performance problems with examples/B/Mathematical/GraphIso/CheckGraphIsomorphism
3028 and with lausanne.mch in SMT mode */
3029 b_not_test_exists(Parameters,Condition,Infos,LocalState,State,_,WF) :-
3030 is_a_conjunct(Condition,LHS,RHS),
3031 preferences:preference(use_smt_mode,SMT),
3032 (SMT=true -> true
3033 ; is_for_all_set_membership_predicate(LHS,Parameters,_,_,_)
3034 -> true % optimised processing is available in forall; important for test 1753
3035 ),
3036 (\+ ground_state(LocalState) ; \+ ground_state(State)),
3037 % TO DO: check if any of the variables in Condition are not ground
3038 % TO DO: check if used_ids exist in Infos ? memberchk(used_ids(_),Infos),
3039 !,
3040 %print(translating_not_exists_into_forall),nl,print(' '),print_bexpr(LHS),nl, print('=> '),print_bexpr(RHS),nl,
3041 (SMT=true,
3042 is_for_all_set_membership_predicate(RHS,Parameters,_Set,_Pattern,_ParameterValues),
3043 \+ is_for_all_set_membership_predicate(LHS,Parameters,_,_,_)
3044 -> LLHS=RHS, RRHS=LHS % swap LHS and RHS; TO DO: search for membership predicate inside LHS,RHS !!
3045 ; LLHS=LHS, RRHS=RHS
3046 ),
3047 safe_create_texpr(negation(RRHS),pred,NegRHS),
3048 b_for_all(Parameters,Infos,LLHS,NegRHS,LocalState,State,WF).
3049 b_not_test_exists(Parameters,Condition,Infos,[],[],no_compile,WF) :- !,
3050 % already compiled in is_empty_closure_wf
3051 ground_bexpr_check(Condition,Ground),
3052 b_not_test_exists_aux(Ground,Parameters,Condition, Infos, WF).
3053 b_not_test_exists(Parameters,Condition,Infos,LocalState,State,_,WF) :-
3054 % compile to remove dependency on unused parts of State+LocalState; will make it delay less below
3055 def_get_texpr_ids(Parameters,ParaIDs),
3056 %% print(b_not_test_exists(ParaIDs)),nl, print(state(LocalState,State)),nl, %%
3057 ? b_compiler:b_compile(Condition,ParaIDs,LocalState,State,CompiledCond,WF),
3058 (is_truth(CompiledCond) -> fail
3059 ; is_falsity(CompiledCond) -> true
3060 % TO DO: we could detect equalities that will always succeed (but be careful for WD issues)
3061 ; ground_bexpr_check(CompiledCond,Ground),
3062 b_not_test_exists_aux(Ground,Parameters,CompiledCond, Infos, WF)
3063 ).
3064
3065 :- block b_not_test_exists_aux(-,?,?,?,?).
3066 b_not_test_exists_aux(_,Parameters,CompiledCond,Infos,WF) :-
3067 % getting an idle waitflag considerably slows down test 1739; see also ClearSy/2019_Aug/call_residue/rule_erreur.mch
3068 % slow down no longer the case with the new waitflag implementation
3069 get_idle_wait_flag(b_not_test_exists_aux(Parameters),WF,LWF),
3070 % allow pending co-routines to complete
3071 b_not_test_exists_aux2(LWF,Parameters,CompiledCond,Infos,WF).
3072 :- block b_not_test_exists_aux2(-,?,?,?,?).
3073 b_not_test_exists_aux2(_,Parameters,CompiledCond,Infos,WF) :-
3074 % no need to create inner waitflag: we enumerate fully below: create_inner_wait_flags(WF,b_not_test_exists(Parameters),LocalWF),
3075 %init_wait_flags(LocalWF,[expansion_context(b_not_not_test_exists,Parameters)]),
3076 init_quantifier_wait_flag(WF,not(exists),Parameters,ParaResult,Infos,LocalWF),
3077 not_with_enum_warning(
3078 b_interpreter:b_not_not_test_exists_aux(Parameters,ParaResult,CompiledCond,LocalWF),
3079 LocalWF, CompiledCond, % was not_exists(Parameters), the not_exists quantifier call is on call_stack now
3080 CompiledCond),
3081 copy_wfe_from_inner_if_necessary(LocalWF,WF). % for the case that the negated call has found abort errors and WFE was not grounded
3082 b_not_not_test_exists_aux(Parameters,ParaResult,CompiledCond,LocalWF) :-
3083 ? b_interpreter:set_up_typed_localstate(Parameters,ParaResult,TypedVals,[],NewLocalState,negated),
3084 % delay generation of WD error messages until outer WFE flag set
3085 ? b_interpreter:b_test_boolean_expression(CompiledCond,NewLocalState,[],LocalWF), % check Condition
3086 b_tighter_enumerate_values_in_ctxt(TypedVals,CompiledCond,LocalWF),
3087 ? ground_inner_wait_flags(LocalWF). % does not always ground WFE if abort is pending in which case not_with_enum_warning also does not fail and keeps the co-routines
3088 % pending co-routines will be discarded by negation !
3089
3090
3091 /* --------------------------------- */
3092
3093 value_type(_X). % only used in post_conditions (assert_post)
3094 /*
3095 value_type(X) :- nonvar(X),
3096 (X = value(_) ; X = global_set(_) ;
3097 X = global_constant(_) ; X = term(_)).*/
3098
3099
3100 % look up identifiers in store, if the identifier
3101 % is not in the store, assume it's a constant and ignore it
3102 % used for determining wait variables for existential quantifier
3103 % TO DO: better deal with CSE @identifiers ?
3104 lookup_values_if_vars([],_,_,[]).
3105 lookup_values_if_vars([Id|IRest],LocalStore,Store,Values) :-
3106 ( lookup_value(Id,LocalStore,Store,Val)
3107 -> (force_evaluation_of_lazy_value(Id,Val,RealVal)
3108 -> Values = [RealVal|VRest]
3109 ; Values = [Val|VRest])
3110 ; Values = VRest),
3111 lookup_values_if_vars(IRest,LocalStore,Store,VRest).
3112
3113 force_evaluation_of_lazy_value(Id,Value,RealVal) :- nonvar(Value), Value=(Trigger,RealVal),
3114 var(Trigger),
3115 get_preference(use_common_subexpression_elimination,true),
3116 is_lazy_let_identifier(Id),
3117 !,
3118 Trigger=pred_true. % force evaluation, as the exists will otherwise delay/flounder
3119 % Warning: this means that outer lazy_let_expressions inside an exists should be well-defined (WD)
3120
3121
3122 /* will not generate error messages; used for CSP||B when we don't know if something is a B variable or not */
3123 /* TO DO: add peel_prefix for global_sets and constants ?? */
3124 try_lookup_value_in_store_and_global_sets(Id,State,Val) :-
3125 (lookup_value(Id,State,RVal) -> RVal=Val
3126 ; b_global_sets:lookup_global_constant(Id,VGC) -> Val = VGC
3127 ; b_global_set_or_free_type(Id,_AnyType,Value) -> Val=Value /* global set evaluates to itself */
3128 ).
3129
3130
3131 lookup_value_in_store_and_global_sets_wf(Id,Type,LocalState,State,Val,Span,WF) :-
3132 (lookup_value_with_span_wf(Id,LocalState,State,RVal,Span,WF)
3133 -> RVal=Val
3134 ; lookup_value_in_global_sets_wf(Id,Type,Val,LocalState,State,Span,WF)
3135 ).
3136
3137 lookup_value_in_global_sets_wf(Id,Type,Val,LocalState,State,Span,WF) :-
3138 (b_global_sets:lookup_global_constant(Id,VGC)
3139 -> Val=VGC
3140 ? ; (b_global_set_or_free_type(Id,Type,Value)
3141 -> Val = Value /* global set evaluates to itself */
3142 ; ((member(bind(Id,_),LocalState) ; member(bind(Id,_),State))
3143 -> Msg1 = 'Cannot determine value for identifier '
3144 ; Msg1 = 'Cannot find identifier '
3145 ),
3146 append(LocalState,State,LSS),
3147 translate:translate_bstate_limited(LSS,StateInfo),
3148 ajoin([Msg1,Id,':'],Msg),
3149 add_error_wf(identifier_not_found,Msg,StateInfo,Span,WF),
3150 fail % Val = term(Id) /* Val=fail */
3151 )
3152 ).
3153
3154 :- use_module(probsrc(kernel_freetypes),[registered_freetype/2, registered_freetype_case_value/3]).
3155 ?b_global_set_or_free_type(Id,_,global_set(Id)) :- b_global_set(Id).
3156 b_global_set_or_free_type(Id,_,freetype(Id)) :- registered_freetype(Id,_).
3157 b_global_set_or_free_type(Id,Type,Value) :-
3158 registered_freetype_case_value(Id,Type,Value). % to instantiate the type parameters we also need the TypeId
3159 % TODO: we could also register Event-B destructors and look them up here
3160
3161 /* -----------------------------*/
3162 /* b_compute_expressions */
3163 /* -----------------------------*/
3164
3165 b_compute_expressions([], _, _, [],_WF).
3166 b_compute_expressions([EXPRsHd|EXPRsTl],LocalState,InState,[ValHd|ValTl],WF) :-
3167 ? b_compute_expression(EXPRsHd,LocalState,InState,ValHd,WF),
3168 ? b_compute_expressions(EXPRsTl,LocalState,InState,ValTl,WF).
3169
3170 % a variation of above that delays computing the expressions until Waitflag 1/2 is set
3171 b_compute_assign_expressions_when(EXPRsTl,LocalState,InState,ValTl,WF,OR) :-
3172 get_assign_expr_priority_wf(OR,WF,LWF),
3173 ? b_compute_expressions_when2(EXPRsTl,LocalState,InState,ValTl,WF,LWF).
3174 b_compute_expressions_when2([], _, _, [],_WF,_).
3175 b_compute_expressions_when2([EXPRsHd|EXPRsTl],LocalState,InState,[ValHd|ValTl],WF,LWF) :-
3176 ? b_compute_expression_when2(EXPRsHd,LocalState,InState,ValHd,WF,LWF),
3177 b_compute_expressions_when2(EXPRsTl,LocalState,InState,ValTl,WF,LWF).
3178
3179 % TO DO: add step number in OR
3180 get_assign_expr_priority_wf(output_required,_WF,LWF) :- !,
3181 % the Output of the statement is required; do not delay computing it
3182 LWF=0. % this would delay computation until WF0 is set: get_wait_flag0(WF,LWF); cf. initialisation for test 2104
3183 get_assign_expr_priority_wf(_,WF,LWF) :-
3184 % the Output is not directly required; compute it later (when we are sure that the statement actually succeeds)
3185 (preferences:preference(use_smt_mode,true)
3186 -> Prio = 2.0 % SMT Mode: we are probably doing CBC checking, we may have set up constraints on ValTl
3187 ; Prio=4000), % unless the expression is inside an sequential composition: nothing can depend on ValTl; TO DO: check if we are inside a sequential composition; if not use inf priority; otherwise use 2.0 or 4
3188 get_wait_flag(Prio,get_assign_expr_priority_wf,WF,LWF).
3189
3190 :- block b_compute_expression_when2(?,?,?,?,?,-).
3191 b_compute_expression_when2(eval_must_not_fail(ErrMsg,EXPRsHd),LocalState,InState,Res,WF,_) :- !,
3192 % catch failure; in case the interpreter fails to catch wd-error itself (e.g., try_find_abort is false)
3193 if(b_compute_expression(EXPRsHd,LocalState,InState,ValHd,WF),equal_object_wf(ValHd,Res,WF),
3194 (translate:translate_bexpression_with_limit(EXPRsHd,TS),
3195 add_wd_error_span(ErrMsg,TS,span_predicate(EXPRsHd,LocalState,InState),WF))).
3196 b_compute_expression_when2(EXPRsHd,LocalState,InState,ValHd,WF,_) :-
3197 copy_wf_start(WF,b_compute_expression_when2,CWF), % not sure this is useful for expressions:
3198 ? b_compute_expression(EXPRsHd,LocalState,InState,ValHd,CWF),
3199 ? copy_wf_finish(WF,CWF).
3200
3201
3202 /* -----------------------------*/
3203 /* b_execute_statement */
3204 /* -----------------------------*/
3205 /* b_execute_statement(XMLStatements:input, StateofLocalVariables:input,
3206 StateOfGlobalVariables:input,
3207 ListOfUpdateBindingsForGlobalVariablesAndResultVariables:output) */
3208
3209 :- assert_pre(b_interpreter:b_execute_statement(Stmt,LS,IS,_OS,_WF,_Path,_OR),
3210 (bsyntaxtree:check_if_typed_substitution(Stmt),type_check(LS,store),type_check(IS,store) )).
3211 :- assert_post(b_interpreter:b_execute_statement(_Stmt,_LS,_IS,OS,_WF,_Path,_OR),
3212 (type_check(OS,store))).
3213
3214 b_execute_inner_statement(Body,LocalState,InState,OutState,WF,Path,output_required) :-
3215 get_texpr_expr(Body,BE),
3216 BE \= while(_COND,_STMT,_INV,_VARIANT), % also other non-det substitutions ??
3217 BE \= select(_),
3218 BE \= select(_,_),
3219 BE \= if(_), % case(_,_,_) statements are now translated to if-then-else in ast_cleanup
3220 !,
3221 get_wait_flag0(WF,WF0),
3222 block_execute_statement(WF0,Body,LocalState,InState,OutState,WF,Path).
3223 b_execute_inner_statement(Body,LocalState,InState,OutState,WF,Path,OR) :-
3224 get_wait_flag(2,inner_stmt,WF,LWF), % was 2.0
3225 clone_wait_flags_from1(WF,GroundUponFinish,InnerWF), % copy everything but WF0
3226 b_execute_inner_statement(Body,LocalState,InState,OutState,GroundUponFinish,InnerWF,Path,LWF,OR).
3227
3228 :- block block_execute_statement(-, ?,?,?, ?,?,?).
3229 block_execute_statement(_,Body,LocalState,InState,OutState,WF,Path) :-
3230 ? b_execute_statement(Body,LocalState,InState,OutState,WF,Path,output_required).
3231
3232 :- block b_execute_inner_statement(?,?,?,?,?,?,?,-,?).
3233 b_execute_inner_statement(Body,LocalState,InState,OutState,GUF,InnerWF,Path,_,OR) :-
3234 ? b_execute_statement(Body,LocalState,InState,OutState,InnerWF,Path,OR),
3235 ? (GUF=ground_upon_finish -> ground_wait_flags(InnerWF) ; ground_wait_flag0(InnerWF)).
3236
3237 :- use_module(source_profiler,[opt_add_source_location_hits/2]).
3238 :- use_module(b_operation_guards,[get_substitution_enabling_condition/4]).
3239
3240
3241 b_execute_statement_nowf(Subst,LS,S,OutS,Ctxt) :-
3242 init_wait_flags_with_call_stack(WF,[prob_command_context(Ctxt,unknown)]),
3243 b_interpreter:b_execute_statement(Subst,LS,S,OutS,WF,_Path),
3244 ground_wait_flags(WF).
3245
3246 b_execute_statement(Stmt, LS, S, OS, WF,Path) :-
3247 ? b_execute_statement(Stmt, LS, S, OS, WF,Path,output_not_required).
3248 b_execute_statement(b(Stmt,_,Infos), LS, S, OS, WF,Path,OR) :- !,
3249 ? b_execute_statement2(Stmt, Infos, LS, S, OS, WF,Path,OR).
3250 b_execute_statement(Stmt, LS, S, OS, WF,Path,OR) :-
3251 add_internal_error('Statement not properly wrapped: ',b_execute_statement(Stmt, LS, S, OS, WF,Path,OR)),
3252 b_execute_statement2(Stmt, [], LS, S, OS, WF,Path,OR).
3253
3254 % blocks should be removed by type-checker
3255 b_execute_statement2(block(Stmt),_,LS,IS,OS,WF,Path,OR) :- !,
3256 b_execute_statement(Stmt,LS,IS,OS,WF,Path,OR). %% NOT COVERED
3257 b_execute_statement2(assign(LHS,Exprs),Info,LocalState,InState,OutState,WF,assign(LHS,VALs),OR) :- !,
3258 /* Var1, ..., VarN := Expr1, ..., ExprN */
3259 /* also: Var1, fun1(arg), ... := Expr1, Expr2, ... */
3260 opt_add_source_location_hits(Info,1),
3261 ? b_compute_assign_expressions_when(Exprs,LocalState,InState,VALs,WF,OR),% VALs - a list of computed values
3262 ? b_assign_values_or_functions(LHS,VALs,LocalState,InState,OutState,WF,OR).
3263 b_execute_statement2(assign_single_id(IDE,Expr),Info,LocalState,InState,OutState,WF,assign_single_id(ID,Value),_OR) :-
3264 get_texpr_id(IDE,ID),!,
3265 opt_add_source_location_hits(Info,1),
3266 ? b_compute_expression(Expr,LocalState,InState,Value,WF), % b_compute_assign_expressions_when
3267 %b_compute_assign_expressions_when([Expr],LocalState,InState,[Value],WF),
3268 OutState=[bind(ID,Value)].
3269 b_execute_statement2(choice(ChoiceList),_,LocalState,InState,OutState,WF,Path,OR) :- !,
3270 /* CHOICE LHS OR RHS OR ... END */
3271 get_wait_flag(2,choice,WF,WFC), % % was 2.0, maybe use length of ChoiceList as Priority ??
3272 b_execute_choice(ChoiceList,LocalState,InState,OutState,WF,Path,WFC,OR).
3273 b_execute_statement2(becomes_element_of(LHS,RHS), /* LHS :: RHS */
3274 Info,LocalState,InState,OutState,WF,Path,_OR) :- !,
3275 % LHS must be of the form Var1,..,Vark where all variables are disjoint
3276 opt_add_source_location_hits(Info,1),
3277 b_execute_becomes_element_of(LHS,RHS,LocalState,InState,OutState,WF,Path).
3278 b_execute_statement2(becomes_such(Vars,Condition),Info,LocalState,InState,OutState,WF,Path,OR) :- !,
3279 /* Vars : (Condition) */
3280 opt_add_source_location_hits(Info,1),
3281 (OR=output_required, get_preference(expand_becomes_such_into_set,true) % see test 1770
3282 -> % compute all solutions of the Condition predicate and then choose amongst them;
3283 % possibly good for complex preds, ensures we solve local constraints in isolation in context of sequence(.)
3284 % runs into time_out for test 2093; TODO: detect special patterns like partial_function, ...
3285 insert_before_substitution_variables(Vars,LocalState,InState,LocalState,TempLocalState),
3286 add_debug_message(b_interpreter,'Expanding become_such predicate into set: ',Condition,Condition),
3287 b_compute_comprehension_set(Vars,Condition,Info,TempLocalState,InState,CResult,WF),
3288 RHS = b(value(CResult),any,[was(becomes_such)]),
3289 b_execute_statement2(becomes_element_of(Vars,RHS), Info,LocalState,InState,OutState,WF,Path,OR)
3290 ; % create Vars in State and assert that Condition is true; probably good for cbc checking
3291 ? b_execute_becomes_such(Vars,Condition,Info,LocalState,InState,OutState,_,Path,WF)
3292 ).
3293 b_execute_statement2(sequence(Seq), /* LHS ; RHS */
3294 _,LocalState,InState,OutUpdates,WF,Path,OR) :- !, %pe_print(sequence(Seq,InState)),
3295 ? b_execute_sequence(Seq,LocalState,InState,OutUpdates,WF,Path,OR).
3296 b_execute_statement2(precondition(PreCond,Body),_,LocalState,InState,OutState,WF,Path,OR) :- !,
3297 %print('*** Non-outermost PRE construct'),nl,
3298 Path=pre(PreRes,IPath),
3299 b_try_check_boolean_expression(PreCond,LocalState,InState,WF,PreRes),
3300 %used to be: ground_det_wait_flag(WF),
3301 check_precondition_result(PreRes,PreCond,LocalState,InState,WF),
3302 ? (PreRes == pred_true -> b_execute_statement(Body,LocalState,InState,OutState,WF,IPath,OR)
3303 ; PreRes == pred_false -> IPath = not_executed
3304 ; b_execute_inner_statement(Body,LocalState,InState,OutState,WF,IPath,OR) % with extra waitflag
3305 ).
3306 b_execute_statement2(assertion(PreCond,Body),_,LocalState,InState,OutState,WF,Path,OR) :- !,
3307 ? b_execute_assertion(PreCond,Body,LocalState,InState,OutState,WF,Path,OR).
3308 b_execute_statement2(witness_then(PreCond,Body),_,LocalState,InState,OutState,WF,witness(Path),OR) :- !,
3309 b_test_boolean_expression(PreCond,LocalState,InState,WF),
3310 b_execute_inner_statement(Body,LocalState,InState,OutState,WF,Path,OR).
3311 b_execute_statement2(select(Whens),_, LocalState, InState, OutState,WF,select(Nr,Path),OR) :- !,
3312 get_texpr_expr(TExpr,select_when(PreCond, Body)), % info field not used for select_when
3313 ? optimized_nth1(Nr, Whens, TExpr), % THIS IS A CHOICE POINT if length(Whens)>1 ! <-------- TO DO guard
3314 ? b_test_boolean_expression(PreCond,LocalState,InState,WF),
3315 %used to call: ground_det_wait_flag(WF), now execute inner statement delays
3316 b_execute_inner_statement(Body,LocalState,InState,OutState,WF,Path,OR).
3317 b_execute_statement2(select(Whens,Else), Infos, LocalState, InState, OutState,WF,Path,OR) :- !,
3318 (
3319 ? b_execute_statement2(select(Whens), Infos, LocalState, InState, OutState,WF,Path,OR)
3320 ; % THIS IS A CHOICE POINT ! <-------- TO DO guard
3321 findall(PC,
3322 (member(SW,Whens),get_texpr_expr(SW,select_when(PC,_))), AllPreconds),
3323 b_not_test_list_of_boolean_expression(AllPreconds,LocalState,InState,WF),
3324 Path = select(else,IPath),
3325 b_execute_inner_statement(Else,LocalState,InState,OutState,WF,IPath,OR)
3326 ).
3327 b_execute_statement2(var(Parameters,Body), /* VAR _ IN _ substitution */
3328 _,LocalState,InState,NewOutState,WF,var(Names,Path),OR) :- !,
3329 /* introduces a new variable that can be assigned to */
3330 split_names_and_types(Parameters,Names,_),
3331 delete_variables_from_state(Names,InState,InState1), % in case any local parameter name is also a constant/variable: remove it % but if we do an operation_call: we leave context and it becomes visible again !!
3332 % otherwise we may think there are two updates, e.g., in WHILE loop; see Rule_DB_SIGAREA_0030 from test 1303
3333 set_up_undefined_localstate(Parameters,InState1,NewInState),
3334 delete_variables_from_state(Names,LocalState,NewLocalState),
3335 %check_valid_store(InState,var_in_state), check_valid_store(LocalState,var_local_state),
3336 ? b_execute_statement(Body,NewLocalState,NewInState,OutState,WF,Path,OR),
3337 % check_valid_store(OutState,var_out_state),
3338 filter_results(Parameters,OutState,NewOutState,WF)
3339 .
3340 /* it can be ok not to assign to a local variable */
3341
3342 %TODO(DP, 5.8.2008):
3343 b_execute_statement2(let(Parameters,Defs,Body), /* LET _ BE _ IN _ */
3344 _,LocalState,InState,OutState,WF,let(Path),OR) :- !,
3345 ? set_up_typed_localstate(Parameters,LocalState,NewLocalState),
3346 b_execute_let_definitions(Defs,NewLocalState,InState,WF),
3347 ? b_execute_statement(Body,NewLocalState,InState,OutState,WF,Path,OR).
3348 b_execute_statement2(lazy_let_subst(Id,IdExpr,Body),_,LocalState,InState,OutState,WF,lazy_let(Path),OR) :-
3349 !,
3350 add_lazy_let_id_and_expression(Id,IdExpr,LocalState,InState,NewLocalState,WF),
3351 b_execute_statement(Body,NewLocalState,InState,OutState,WF,Path,OR).
3352 b_execute_statement2(any(Parameters,PreCond,Body), /* ANY _ WHERE */
3353 Info,LocalState,InState,OutState,WF0,any(Bindings,Path),OR) :- !, %statistics(runtime,_),
3354 %print('ANY: '), print_bexpr(PreCond),nl, %%
3355 ? set_up_typed_localstate(Parameters,FreshVars,TypedVals,LocalState,NewLocalState,positive),
3356 create_any_bindings(Parameters,FreshVars,Bindings),
3357 push_wait_flag_call_stack_info(WF0,quantifier_call('ANY',Parameters,FreshVars,Info),WF),
3358 ? b_test_inner_boolean_expression(PreCond,NewLocalState,InState,WF), /* check WHERE */
3359 %%observe_state(TypedVals,WF,0), b_tracetest_boolean_expression(PreCond,NewLocalState,InState,WF,one), %% comment in for debugging
3360 b_tighter_enumerate_all_values(TypedVals,WF), % moved enumeration after test; in case WF already instantiated
3361 %TODO: check if we can use b_tighter_enumerate_values_in_ctxt
3362 ? b_execute_statement(Body,NewLocalState,InState,OutState,WF,Path,OR). /* should we use b_execute_inner_statement/LWF here ?? */
3363 b_execute_statement2(skip, /* SKIP */
3364 Info,_LocalState,_InState,OutState,_WF,skip,_OR) :- !,
3365 opt_add_source_location_hits(Info,1),
3366 OutState = [].
3367 b_execute_statement2(parallel(Statements), /* LHS || RHS */ %@@@
3368 _,LocalState,InState,OutState,WF,parallel(Paths),OR) :- !,
3369 ? b_execute_statements_in_parallel(Statements,LocalState,InState,OutState,WF,Paths,OR).
3370 b_execute_statement2(init_statement(Stmt),_,LocalState,InState,OutState,WF,Path,OR) :- !,
3371 /* Like block: but
3372 writes error messages if statement fails */ %@@@
3373 (get_preference(provide_trace_information,true)
3374 -> nl,print(' =INIT=> '),translate:print_subst(Stmt),nl, flush_output(user_output),
3375 statistics(walltime,[Tot1,_])
3376 ; true),
3377 ? if(b_execute_initialisation_statement(Stmt,LocalState,InState,OutState,WF,Path,OR),
3378 (
3379 (get_preference(provide_trace_information,true)
3380 -> statistics(walltime,[Tot2,_]), Tot is Tot2-Tot1,
3381 format(' [=OK= ~w ms]~n',[Tot]), flush_output(user_output)
3382 ; true)
3383 ),
3384 ( translate:translate_substitution(Stmt,TStmtStr),
3385 (bmachine:b_machine_temp_predicate(_TempPred)
3386 -> Msg = 'INITIALISATION statement cannot be executed with extra predicate: ',
3387 add_error_wf(initialisation_fails,Msg,TStmtStr,Stmt,WF)
3388 % do not add as state error; user requested transition
3389 ; Msg = 'INITIALISATION statement fails: ',
3390 (get_substitution_enabling_condition(Stmt,SpanPred,_BSVars,_IsPreciseV)
3391 -> %insert_custom_predicate_into_guard(EnablingCondition,TempPred,SpanPred),
3392 ErrPos = span_predicate(SpanPred,LocalState,InState) % for visualising by user
3393 % Note: user can also visualise by chooise execute by predicate (in TK)
3394 ; ErrPos = Stmt
3395 ),
3396 % add as state error so that we can visualise span predicate
3397 add_state_error_wf(initialisation_fails,Msg,TStmtStr,ErrPos,WF) % cf test 1736 and 278
3398 %add_error_wf(initialisation_fails,Msg,TStmtStr,ErrPos,WF)
3399 ),
3400 fail
3401 )
3402 ).
3403 b_execute_statement2(if(IfList),_,LocalState,InState,OutState,WF,Path,OR) :- !,
3404 LWF='$GENERATE_ON_DEMAND',
3405 ? b_execute_else_list(IfList,LocalState,InState,OutState,WF,1,Path,LWF,OR).
3406 b_execute_statement2(operation_call(Operation,Results,Parameters),Info,LocalState,InState,OutState,WF,
3407 operation_call(OperationName,Results,ParamValues,ResultValues,InnerPath),OR) :- !,
3408 def_get_texpr_id(Operation,op(OperationName)),
3409 ? b_execute_operation_with_parameters(OperationName,LocalState,InState,Results,
3410 Parameters,OpOutState,ParamValues,ResultValues,InnerPath,Info,WF,OR),
3411 opt_add_source_location_hits(Info,1),
3412 split_names_and_types(Results,ResultingIDs,_),
3413 store_values(ResultingIDs, ResultValues, ResultsOutState),
3414 combine_updates(ResultsOutState,OpOutState,OutState).
3415
3416 b_execute_statement2(while(COND,STMT,INV,VARIANT),
3417 Info,LocalState,InState,OutState,WF0,while(VarVal,BodyPath),_OR) :- !,
3418 %hit_profiler:add_profile_hit(while(COND,WF),2),
3419 % we may go around the loop many times: avoid carrying around unused variables
3420 get_while_reads_write_info_and_filter_state(Info,LocalState,InState,LS,IS,ModVars),
3421 push_wait_flag_call_stack_info(WF0,b_operator_call('WHILE',[VarVal],Info),WF), % TODO: provide subst. call stack entry
3422 %print_message(execute_while(LocalState,InState)),
3423 b_compiler:b_optimize(INV,ModVars,LS,IS,CINV,WF),
3424 b_compiler:b_optimize(COND,ModVars,LS,IS,CCOND,WF),
3425 b_compiler:b_optimize(VARIANT,ModVars,LS,IS,CVARIANT,WF),
3426 %,b_compiler:b_compile(STMT,ModVars,LS,IS,CSTMT,WF)
3427 % TO DO: maybe exclude in one go; use ordered approach ?
3428 %exclude(unused_variable(ModVars),LS,LS2), % only keep modified vars; all other compiled
3429 %exclude(unused_variable(ModVars),IS,IS2), % only keep modified vars; all other compiled
3430 b_compute_expression(CVARIANT,LS,IS,VarVal,WF),
3431 b_execute_while(CCOND,STMT,CINV,CVARIANT,ModVars,VarVal,LS,IS,OutState,WF,BodyPath).
3432 b_execute_statement2(external_subst_call(FunName,Args),Info,LocalState,State,OutState,WF,external_subst(FunName),_OR) :-
3433 !, b_compute_expressions(Args, LocalState,State, EvaluatedArgs, WF),
3434 push_wait_flag_call_stack_info(WF,external_call(FunName,EvaluatedArgs,Info),WF2),
3435 call_external_substitution(FunName,EvaluatedArgs,State,OutState,Info,WF2).
3436 b_execute_statement2(E,I,LS,S,O,WF,Path,OR) :-
3437 add_internal_error('Uncovered statement: ',b_execute_statement2(E,I,LS,S,O,WF,Path,OR)),
3438 print_functor(E),nl,fail.
3439
3440 % -------------------
3441
3442 b_execute_becomes_element_of(LHS,RHS,LocalState,InState,OutState,WF,becomes_element_of(LHS,SingleValue)) :-
3443 b_compute_expression(RHS,LocalState,InState,ValueSet,WF),
3444 (get_preference(warn_about_failing_assignments,false)
3445 -> b_execute_becomes_element_of_aux(LHS,SingleValue,ValueSet,OutState,WF)
3446 ; if(b_execute_becomes_element_of_aux(LHS,SingleValue,ValueSet,OutState,WF),
3447 true,
3448 (add_feasibility_error(b(not_equal(RHS,b(empty_set,any,[])),pred,[]),
3449 'Assignment by set (becomes_element_of) fails:', LocalState,InState,WF),
3450 SingleValue = term(undefined),
3451 OutState = [] % pretend no assignment occurred (skip)
3452 ))
3453 ).
3454 b_execute_becomes_element_of_aux(LHS,SingleValue,ValueSet,OutState,WF) :-
3455 convert_pairs_into_list(LHS,SingleValue,ValList),
3456 set_up_typed_localstate(LHS,ValList,TypedVals,[],OutState,positive),
3457 check_element_of_wf(SingleValue,ValueSet,WF),
3458 ground_det_wait_flag(WF), %% TODO: remove this
3459 b_tighter_enumerate_all_values(TypedVals,WF).
3460
3461 :- use_module(b_interpreter_components,[construct_optimized_exists/3]).
3462 b_execute_becomes_such(Vars,Condition,Info,LocalState,InState,OutState,Values,becomes_such(Ids,Values),WF) :- !,
3463 % create the LHS variables in the local state
3464 ? set_up_typed_localstate(Vars,Values,TypedVals,LocalState,TempLocalState1,positive),
3465 get_texpr_ids(Vars,Ids),
3466 % there might be some variables of the form x$0 to access the
3467 % values before the substitution. We put them into the local state
3468 insert_before_substitution_variables(Vars,LocalState,InState,TempLocalState1,TempLocalState),
3469 push_wait_flag_call_stack_info(WF,quantifier_call(':(_)',Vars,Values,Info),WF1),
3470 (get_preference(warn_about_failing_assignments,false)
3471 -> % store those values also into the outgoing state as bind/2 pairs
3472 store_values(Ids,Values,OutState),
3473 ? b_test_inner_boolean_expression(Condition,TempLocalState,InState,WF1),
3474 b_tighter_enumerate_values_in_ctxt(TypedVals,Condition,WF1)
3475 ; if((store_values(Ids,Values,OutState),
3476 b_test_inner_boolean_expression(Condition,TempLocalState,InState,WF1),
3477 b_tighter_enumerate_values_in_ctxt(TypedVals,Condition,WF1)),
3478 true, % Note: the predicate could still fail later when WF1 is instantiated !
3479 (construct_optimized_exists(Vars,Condition,EC,false),
3480 add_feasibility_error(EC,'Assignment by predicate (becomes_such) fails:',TempLocalState,InState,WF1),
3481 OutState = [] % pretend no assignment occurred (skip)
3482 )
3483 )
3484 ).
3485 % moved enumeration after test, to avoid overhead in case Condition is deterministic
3486 % (see e.g. WhileAssignTupleChoose_v2)
3487
3488 add_feasibility_error(Condition,Msg,LS,S,WF) :-
3489 translate_bexpression(Condition,CS),
3490 add_abort_error_span(feasibility_error, Msg, CS,span_predicate(Condition,LS,S),WF).
3491
3492 b_execute_sequence([],_LocalState,_InState,[],_WF,[],_OR).
3493 b_execute_sequence([First|Rest],LocalState,InState,OutUpdates,WF,Path,OR) :-
3494 (Rest == []
3495 ? -> b_execute_statement(First,LocalState,InState,OutUpdates,WF,Path,OR)
3496 ; Path = sequence(Path1,RestPath),
3497 ? b_execute_statement(First,LocalState,InState,LHSUpdates,WF,Path1,output_required),
3498 ? ground_det_wait_flag(WF), % maybe better to delay next execute_statement ? TODO
3499 store_intermediate_updates_wf(InState,LHSUpdates,IntermediateState,First,WF),
3500 % TO DO: statically determine what Rest can modify and copy LHSUpdates not modified by Rest into OutUpdates
3501 ? b_execute_statement_list_when_state_set(Rest,LocalState,IntermediateState,
3502 LHSUpdates,OutUpdates,WF,RestPath,OR)
3503 ).
3504
3505
3506 :- block check_precondition_result(-,?,?,?,?).
3507 check_precondition_result(pred_true,_,_,_,_).
3508 check_precondition_result(pred_false,PreCond,LS,S,WF) :-
3509 translate_bexpression(PreCond,PreString),
3510 add_abort_error_span(precondition_error,'Precondition violated: ',PreString,span_predicate(PreCond,LS,S),WF).
3511
3512 create_any_bindings([],[],[]).
3513 create_any_bindings([Param|Prest],[Value|Vrest],[bind(Id,Value)|Brest]) :-
3514 get_texpr_id(Param,Id),
3515 create_any_bindings(Prest,Vrest,Brest).
3516
3517 % insert the values of variables before the substitution under an
3518 % alternative name. The alternative name is given as an optional extra
3519 % information in the variable (see type-checking of becomes_such for
3520 % details). Usually (i.e. always) the alternative name is x$0 for the variable x.
3521 insert_before_substitution_variables([],_LocalState,_InState,State,State).
3522 insert_before_substitution_variables([Var|VRest],LocalState,InState,StateA,ResultStateB) :-
3523 get_texpr_info(Var,Infos),
3524 ? ( member(before_substitution(_,Alternative),Infos) ->
3525 def_get_texpr_id(Var,Id),
3526 lookup_value_for_existing_id(Id,LocalState,InState,Value),
3527 store_value(Alternative,Value,StateA,StateC)
3528 ;
3529 StateA = StateC),
3530 insert_before_substitution_variables(VRest,LocalState,InState,StateC,ResultStateB).
3531
3532
3533
3534 % treat the bool(.) operator
3535 b_convert_bool(Pred,LocalState,State,WF,PredRes) :-
3536 get_wait_flag0(WF,WF0), % first give a chance for PredRes to be instantiated
3537 ? b_convert_bool_wf0(Pred,LocalState,State,WF,PredRes,WF0).
3538
3539 :- block b_convert_bool_wf0(?,?,?,?,-,-).
3540 b_convert_bool_wf0(Pred,LocalState,State,WF,PredRes,_) :- PredRes==pred_true,!,
3541 %% print('bool(.)=TRUE '), translate:print_bexpr(Pred),nl, %%
3542 ? b_test_inner_boolean_expression(Pred,LocalState,State,WF).
3543 b_convert_bool_wf0(Pred,LocalState,State,WF,PredRes,_) :- PredRes==pred_false,!,
3544 %% print('bool(.)=FALSE '), translate:print_bexpr(Pred),nl, %%
3545 ? b_not_test_inner_boolean_expression(Pred,LocalState,State,WF).
3546 b_convert_bool_wf0(Pred,LocalState,State,WF,PredRes,_) :-
3547 %% print('bool(.) check : '), translate:print_bexpr(Pred),nl, % obsv(LocalState),
3548 ? b_try_check_boolean_expression_wf(Pred,LocalState,State,WF,PredRes ).
3549 %% print('finished bool(.) check : '), translate:print_bexpr(Pred),nl,translate:print_bstate(LocalState),nl.
3550
3551 % Additional time limit +TO in ms, e.g., used for CDCL(T). +TORes is time_out if a timeout occurred.
3552 b_convert_bool_timeout(Pred,LocalState,State,WF,PredRes,TO,TORes) :-
3553 get_wait_flag0(WF,WF0),
3554 b_convert_bool_wf0_timeout(Pred,LocalState,State,WF,PredRes,WF0,TO,TORes).
3555
3556 :- block b_convert_bool_wf0_timeout(?,?,?,?,-,-,?,?).
3557 b_convert_bool_wf0_timeout(Pred,LocalState,State,WF,PredRes,_,TO,TORes) :-
3558 PredRes == pred_true,
3559 !,
3560 safe_time_out(b_test_inner_boolean_expression(Pred,LocalState,State,WF),
3561 TO,
3562 TORes).
3563 b_convert_bool_wf0_timeout(Pred,LocalState,State,WF,PredRes,_,TO,TORes) :-
3564 PredRes == pred_false,
3565 !,
3566 safe_time_out(b_not_test_inner_boolean_expression(Pred,LocalState,State,WF),
3567 TO,
3568 TORes).
3569 b_convert_bool_wf0_timeout(Pred,LocalState,State,WF,PredRes,_,TO,TORes) :-
3570 safe_time_out(b_try_check_boolean_expression_wf(Pred,LocalState,State,WF,PredRes ),
3571 TO,
3572 TORes).
3573
3574 %%obsv([]).
3575 %%obsv([bind(Var,Val) | T] ) :- when(ground(Val), format("~w = ~w~n",[Var,Val])), obsv(T).
3576
3577 % check boolean expression without enumeration predicate result (unless WFE is set)
3578 b_try_check_boolean_expression_no_enum_wf(Pred,LocalState,State,WF,PredRes) :-
3579 ? b_try_check_boolean_expression_lwf(Pred,LocalState,State,WF,'$NO_ENUMERATION',PredRes,_).
3580
3581 b_try_check_boolean_expression_wf(Pred,LocalState,State,WF,PredRes) :-
3582 ? b_try_check_boolean_expression_lwf(Pred,LocalState,State,WF,'$ENUMERATION',PredRes,'$GENERATE_ON_DEMAND' ).
3583 % try to do check_boolean expression; if not possible create choice point if LWF is grounded
3584 b_try_check_boolean_expression_lwf(Pred,LocalState,InState,WF,DoEnumeration,PredRes,LWF) :-
3585 ? b_compiler:b_optimize(Pred,[],LocalState,InState,CPRED,WF), % this increases chance that check can be applied+avoids multiple computations in two branches
3586 % still: some computations may not be pre-computed, e.g., union of closures, ..., see Rule_DB_PSR_0003_C
3587 ? b_try_check_boolean_expression_lwf_c(CPRED,LocalState,InState,WF,DoEnumeration,PredRes,LWF).
3588
3589 b_try_check_boolean_expression_lwf_c(b(truth,_,_),_LocalState,_InState,_WF,_,PredRes,_LWF) :- !,
3590 % typical case in e.g. IF-THEN-ELSE
3591 PredRes= pred_true.
3592 b_try_check_boolean_expression_lwf_c(Pred,LocalState,InState,WF,DoEnumeration,PredRes,LWF) :-
3593 copy_wf_start(WF,try_check,CWF),
3594 ? if(b_check_boolean_expression_with_enum(Pred,LocalState,InState,CWF,DoEnumeration,Res),
3595 % Note: we do not use a cut here ! usually b_check will not enumerate; but on rare occasions it can (apply function in inverse,...)
3596 (PredRes=Res,
3597 ? copy_wf_finish(WF,CWF)
3598 ),
3599 b_try_check_failed(Pred,LocalState,InState,WF,DoEnumeration,PredRes,LWF)
3600 ).
3601 b_try_check_failed(Pred,LocalState,InState,WF,DoEnumeration,PredRes,LWF) :-
3602 % print(choice_point(LWF)),nl, translate:print_bexpr(Pred),nl,
3603 perfmessagecall(choice_point,reification_of_check_predicate_failed,translate:print_bexpr(Pred),Pred),
3604 (LWF=='$GENERATE_ON_DEMAND' -> get_binary_choice_wait_flag('$GENERATE_ON_DEMAND',WF,WF1)
3605 ; var(LWF),DoEnumeration=='$NO_ENUMERATION' -> get_enumeration_finished_wait_flag(WF,WF1) % nothing will enum LWF
3606 ; WF1=LWF),
3607 b_try_check_boolean_expression_lwf_block(Pred,LocalState,InState,WF,PredRes,WF1).
3608
3609 % a version of b_check_boolean_expression which will enumerate its result as last resort
3610 % should we only do this in SMT mode : preferences:preference(use_smt_mode,true) ?
3611 b_check_boolean_expression_with_enum(Pred,LocalState,State,WF,DoEnumeration,Res) :-
3612 ? b_check_boolean_expression(Pred,LocalState,State,WF,Res),
3613 (nonvar(Res) -> true
3614 ; DoEnumeration=='$NO_ENUMERATION' -> get_enumeration_finished_wait_flag(WF,EWF), enum_pred_result(Res,EWF,WF)
3615 ; get_wait_flag0(WF,LWF0),
3616 enum_pred_result0(Res,LWF0,WF)).
3617
3618 % first set up with wait_flag0: easy to get, avoid putting unnecessary waitflags into store
3619 % relevant for DataValidationTest.mch with n>20000
3620 :- block enum_pred_result0(-,-,?).
3621 enum_pred_result0(Res,_,WF) :- var(Res),!,
3622 get_last_wait_flag(b_check_boolean_expression_with_enum,WF,LWF),
3623 enum_pred_result(Res,LWF,WF). % before doing infinite enumerations: better do case-distinction here
3624 enum_pred_result0(_,_,_).
3625
3626 :- block enum_pred_result(-,-,?).
3627 enum_pred_result(pred_true,_,_).
3628 enum_pred_result(pred_false,_,_).
3629
3630 :- block b_try_check_boolean_expression_lwf_block(?,?,?, ?,-,-).
3631 b_try_check_boolean_expression_lwf_block(Pred,LocalState,InState,WF,PREDRES,_) :-
3632 PREDRES \== pred_false,
3633 % print(' TRUE +++++> '), translate:print_bexpr(Pred),nl,
3634 ? b_test_inner_boolean_expression(Pred,LocalState,InState,WF),
3635 PREDRES = pred_true. % set it only after we have actually checked the predicate; e.g., for IF we may execute rest of while loop etc... before actually having set up the constraint Pred; See Hansen23_WhilePerformance
3636 b_try_check_boolean_expression_lwf_block(Pred,LocalState,InState,WF,PREDRES,_) :-
3637 PREDRES \== pred_true,
3638 % print(' FALSE +++++> '), translate:print_bexpr(Pred),nl,
3639 ? b_not_test_inner_boolean_expression(Pred,LocalState,InState,WF),
3640 PREDRES = pred_false.
3641
3642 % try to do check_boolean expression; if not possible create choice point *directly*
3643 b_try_check_boolean_expression(Pred,LocalState,InState,WF,PredRes) :-
3644 b_compiler:b_optimize(Pred,[],LocalState,InState,CPRED,WF), % this increases chance that check can be applied+avoids multiple computations in two branches
3645 b_try_check_boolean_expression_c(CPRED,LocalState,InState,WF,PredRes).
3646 b_try_check_boolean_expression_c(Pred,LocalState,InState,WF,PredRes) :-
3647 copy_wf_start(WF,try_check_c,CWF),
3648 if(b_check_boolean_expression(Pred,LocalState,InState,CWF,Res),
3649 (PredRes=Res,copy_wf_finish(WF,CWF)),
3650 ? b_try_check_boolean_expression_c2(Pred,LocalState,InState,WF,PredRes)
3651 ).
3652 b_try_check_boolean_expression_c2(Pred,LocalState,InState,WF,pred_true) :-
3653 %hit_profiler:add_profile_hit(b_try_check_failed(Pred),3),
3654 b_test_inner_boolean_expression(Pred,LocalState,InState,WF).
3655 b_try_check_boolean_expression_c2(Pred,LocalState,InState,WF,pred_false) :-
3656 b_not_test_inner_boolean_expression(Pred,LocalState,InState,WF).
3657
3658
3659 % WHILE SUBSTITUTION TREATMENT:
3660
3661 :- if(environ(prob_noopt_mode,true)).
3662 get_while_reads_write_info_and_filter_state(Info,LocalState,InState,LS,IS,ModVars) :-
3663 member(modifies(ModVars),Info),!,
3664 LS=LocalState, IS=InState. % do not filter state
3665 :- endif.
3666 get_while_reads_write_info_and_filter_state(Info,LocalState,InState,LS,IS,ModVars) :-
3667 member(reads(ReadVars),Info),
3668 ? member(modifies(ModVars),Info),!,
3669 % we may go around the loop many times: avoid carrying around unused variables
3670 ord_union(ReadVars,ModVars,ReadOrModVars),
3671 filter_states(ReadOrModVars,LocalState,InState,LS,IS).
3672 get_while_reads_write_info_and_filter_state(Info,LocalState,InState,LS,IS,ModVars) :-
3673 add_internal_error('No reads & modifies info for while loop: ',get_while_reads_write_info_and_filter_state(Info,LocalState,InState,LS,IS,ModVars)),
3674 ModVars=_, % all variables assumed to be modified
3675 LS=LocalState, IS=InState.
3676
3677 unused_variable(List,bind(Var,_)) :-
3678 % b_is_variable(Var), % TO DO: also include constants in reads Info ?
3679 ord_nonmember(Var,List).
3680 unused_localvariable(List,bind(Var,Val)) :- ord_nonmember(Var,List),
3681 (nonvar(Val),Val=(_,_) -> atom_codes(Var,Codes), Codes \= [64|_] % not a lazy_let ID starting with @
3682 % TO DO: either ensure lazy-let ids are also included in reads/writes ! or mark Val not as pair but using a special functor in add_lazy_let_id_to_local_state ?
3683 ; true).
3684
3685 filter_states(ReadOrModVars,LocalState,InState,LS,IS) :-
3686 exclude(unused_localvariable(ReadOrModVars),LocalState,LS),
3687 exclude(unused_variable(ReadOrModVars),InState,IS).
3688 % TO DO: investigate whether we should use ord_intersect; ReadVars is already sorted
3689
3690 :- block lazy_exclude(-,?,?).
3691 lazy_exclude([],_,[]).
3692 lazy_exclude([bind(Var,Val)|T],ModVars,Res) :- lazy_exclude_aux(Var,Val,T,ModVars,Res).
3693 :- block lazy_exclude_aux(-,?,?,?,?).
3694 lazy_exclude_aux(Var,Val,T,ModVars,Res) :-
3695 ? (member(Var,ModVars) -> Res = [bind(Var,Val)|RT]
3696 ; Res = RT),
3697 lazy_exclude(T,ModVars,RT).
3698
3699
3700 :- use_module(kernel_tools,[ground_state_check/2]).
3701 % outermost while code:; at next iteration b_execute_while1 will be called.
3702 :- block b_execute_while(?,?,?,?,?,-, ?,?,?, ?,?). % we block on Variant Value int(VarVal)
3703 b_execute_while(COND,STMT,INV,VARIANT,ModVars,int(VarVal),LocalState,InState,OutState,WF,BodyPath) :-
3704 %get_idle_wait_flag(b_execute_while,WF,LWF),
3705 (number(VarVal),VarVal =< 50
3706 -> LWF=VarVal % we will wait anyway on GrInState below; no danger for WD issues in in b_optimize
3707 ; no_pending_waitflags(WF) -> get_wait_flag0(WF,LWF) %important for e.g. PerformanceTests/While/LiftExec_LIM.mch
3708 ; get_last_wait_flag(b_execute_while1,WF,LWF) % to do: maybe get largest waitflag to avoid as much as possible that new choice points get enumerated before while triggers?
3709 % see also tests 979, 981
3710 ),
3711 % before entering while loop, we wait for co-routines to complete that may have activated b_execute_while
3712 b_execute_while_idle(COND,STMT,INV,VARIANT,ModVars,int(VarVal),LocalState,InState,OutState,WF,LWF,BodyPath).
3713
3714 :- block b_execute_while_idle(?,?,?,?,?,?, ?,?,?, ?,-,?). % we block on enumeration starting wait_flag
3715 b_execute_while_idle(COND,STMT,INV,VARIANT,ModVars,int(VarVal),LocalState,InState,OutState,WF,_,BodyPath) :-
3716 %ground_constraintprop_wait_flags(WF),
3717 (number(VarVal), VarVal>50, preference(compile_while_body,true)
3718 % if VarVal > 50 -> worthwhile to compile STMT
3719 % TO DO: also take size of body into account, and what if only a small part of the body is reachable in each iteration
3720 ? -> b_compiler:b_optimize(STMT,ModVars,LocalState,InState,CSTMT,WF),
3721 % print(compiled_while(ModVars)),nl, translate:print_subst(CSTMT),nl,
3722 OutState=WhileOutState,
3723 exclude(unused_variable(ModVars),LocalState,LS), % only keep modified vars; all other compiled
3724 exclude(unused_variable(ModVars),InState,IS) % only keep modified vars; all other compiled
3725 ; CSTMT=STMT, LS=LocalState, IS=InState,
3726 lazy_exclude(WhileOutState,ModVars,OutState) % only copy over those variables (potentially) modified by While loop
3727 % Note: it is important that we only have one copy of each modified variable in OutState
3728 ),
3729 ground_state_check(InState,GrInState),
3730 ? b_execute_while_loop_block(GrInState,COND,CSTMT,INV,VARIANT,none,VarVal,LS,IS,WhileOutState,WF,BodyPath).
3731
3732 :- block b_execute_while_loop_block(-,?,?,?,?,?,?,?,?,?,?,?).
3733 b_execute_while_loop_block(_,COND,CSTMT,INV,VARIANT,none,VarVal,LS,IS,WhileOutState,WF,BodyPath) :-
3734 % the information passed to the outside is the number of iterations
3735 ? b_execute_while_loop(COND,CSTMT,INV,VARIANT,none,VarVal,LS,IS,WhileOutState,WF,while_bpath(0,none),BodyPath).
3736
3737 :- block b_execute_while1(?,?,?,?,?,-,?,?,?,?,?,?).
3738 b_execute_while1(COND,STMT,INV,VARIANT,PrevVariantValue,int(VarVal),LocalState,InState,OutState,WF,InPath,OutPath) :-
3739 % get_last_wait_flag(while(VarVal),WF,LWF),
3740 deref_wf(WF,FreshWF),
3741 %ground_constraintprop_wait_flags(FreshWF), % this is not a good idea, co-routine may be triggered while grounding WF; this subsidiary call will prevent grounding from completing and may trigger later waitflags before earlier ones are finished
3742 % this can lead to enumeration warnings; the same applies to other calls to ground_constraintprop_wait_flags below
3743 b_execute_while_loop(COND,STMT,INV,VARIANT,PrevVariantValue,VarVal,LocalState,InState,OutState,FreshWF,InPath,OutPath).
3744
3745 % block on PrevVarVal and VarVal not yet needed here; but we need it for b_execute_while_body below
3746 :- block b_execute_while_loop(?,?,?,?,-,?,?,?,?,?,?,?), b_execute_while_loop(?,?,?,?,?,-,?,?,?,?,?,?).
3747 b_execute_while_loop(COND,STMT,INV,VARIANT,PrevVarVal,VarVal,LocalState,InState,OutState,WF,InPath,OutPath) :-
3748 ? b_try_check_boolean_expression_c(INV,LocalState,InState,WF,INVRes),
3749 %ground_constraintprop_wait_flags(WF), % seems to slow down interpretation
3750 ? b_check_execute_while_loop1(INVRes,COND,STMT,INV,VARIANT,PrevVarVal,VarVal,LocalState,InState,OutState,WF,InPath,OutPath).
3751
3752 :- block b_check_execute_while_loop1(-,?,?,?,?,?,?,?,?,?,?, ?,?).
3753 b_check_execute_while_loop1(pred_false,_COND,_STMT,INV,_VAR,_PrevVarVal,VarVal,LocalState,InState,_OutState,WF,P,P) :-
3754 add_abort_error_span(while_invariant_violation,
3755 'While INVARIANT VIOLATED, current VARIANT value: ',VarVal,span_predicate(INV,LocalState,InState),WF).
3756 b_check_execute_while_loop1(pred_true,COND,STMT,INV,VARIANT,PrevVarVal,VarVal,LocalState,InState,OutState,WF,InPath,OutPath) :-
3757 b_try_check_boolean_expression_c(COND,LocalState,InState,WF,CondRes),
3758 %ground_constraintprop_wait_flags(WF), % seems to slow down interpretation
3759 ? b_check_execute_while_loop2(CondRes,COND,STMT,INV,VARIANT,PrevVarVal,VarVal,LocalState,InState,OutState,WF,InPath,OutPath).
3760
3761 :- block b_check_execute_while_loop2(-,?,?,?,?,?,?,?,?,?,?, ?,?).
3762 b_check_execute_while_loop2(pred_false,_COND,_STMT,_INV,_VARIANT,_PrevVarVal,_VarVal,_LS,InState,OutState,_WF,P,P) :-
3763 OutState=InState. % we copy over the while InState: the updates will be computed at the end of the while loop
3764 b_check_execute_while_loop2(pred_true,COND,STMT,INV,VARIANT,PrevVarVal,VarVal,LocalState,InState,OutState,WF,InPath,OutPath) :-
3765
3766 %hit_profiler:add_profile_hit(b_execute_while_body(STMT,VarVal,PrevVarVal,LocalState),2),
3767 % TO DO: maybe only compute VARIANT now and not above ??
3768 % b_compute_expression(VARIANT,LocalState,InState,VarVal,WF),
3769 % ground_constraintprop_wait_flags(WF), %% moved here because VARIANT computed later
3770 inc_while_path(InPath,P1),
3771 ? b_execute_while_body(COND,STMT,INV,VARIANT,PrevVarVal,VarVal,LocalState,InState,OutState,WF,P1,OutPath).
3772
3773 % register in the event path that we have entered one more while iteration:
3774 inc_while_path(while_bpath(Cnt,LastIterPath),while_bpath(C1,LastIterPath)) :- C1 is Cnt+1.
3775 add_while_body_path(while_bpath(Cnt,_),Path1,Res) :-
3776 get_preference(eventtrace,true),!,
3777 Res = while_bpath(Cnt,Path1). % TODO: we could given a setting construct a sequence
3778 add_while_body_path(P,_,P).
3779
3780 %:- block b_execute_while_body(?,?,?,?,-,?,?,?,?,?,?,?), b_execute_while_body(?,?,?,?,?,-,?,?,?,?,?,?).
3781 % we must ensure VarVal and PrevVaraintValue known
3782 % the block declaration above for b_execute_while_loop already ensures this
3783 b_execute_while_body(_COND,_STMT,_INVARIANT,VAR,_PV,VarVal,LocalState,InState,_OutState,WF,Path,Path) :-
3784 VarVal<0, !, % more efficient than is_not_natural(int(VarVal)),
3785 %ground_constraintprop_wait_flags(WF),
3786 % add_abort_error_span will fail; hence no need to set _OutState
3787 add_abort_error_span(while_variant_error,'While VARIANT not NATURAL:',VarVal,span_predicate(VAR,LocalState,InState),WF).
3788 b_execute_while_body(_COND,_STMT,_INVARIANT,VAR,PrevVariantValue,VarVal,LocalState,InState,_OutState,WF,Path,Path) :-
3789 % check no longer required VarVal>=0,%is_natural(int(VarVal),WF),
3790 PrevVariantValue \= none,
3791 PrevVariantValue =< VarVal, !, %less_than_equal(int(PrevVariantValue),int(VarVal)),
3792 %ground_constraintprop_wait_flags(WF),
3793 % add_abort_error_span will fail; hence no need to set _OutState
3794 ajoin(['VARIANT = ',VarVal,', previous value = ',PrevVariantValue],Details),
3795 add_abort_error_span(while_variant_error,'While VARIANT not decreasing:',
3796 Details,span_predicate(VAR,LocalState,InState),WF).
3797 b_execute_while_body(COND,STMT,INV,VARIANT,_PrevVariantValue,VarVal,LocalState,InState,OutState,WF,InPath,OutPath) :-
3798 % check no longer required due to cuts above %VarVal>=0, %is_natural(int(VarVal),WF),
3799 %(PrevVariantValue==none -> true ; less_than(int(VarVal),int(PrevVariantValue))),
3800 %ground_constraintprop_wait_flags(WF), % seems to slow down interpretation
3801 copy_wf_start(WF,while_body,CWF),
3802 ? b_execute_statement(STMT,LocalState,InState,LHSUpdates,CWF,Path1,output_required),
3803 add_while_body_path(InPath,Path1,P1),
3804 copy_wf_finish(WF,CWF),
3805 ground_det_wait_flag(WF), % TODO: remove this
3806 store_intermediate_updates_wf(InState,LHSUpdates,IntermediateState,STMT,WF),
3807 check_state_skeleton_bound(LHSUpdates,Bound), % otherwise variable lookups will cause problems; ensures IntermediateState skeleton bound
3808 b_execute_while_when_state_set(COND,STMT,INV,VARIANT,VarVal,LocalState,IntermediateState,OutState,WF,Bound,P1,OutPath).
3809
3810 :- block b_execute_while_when_state_set(?,?,?,?,?,?,?,?,?,-,?,?).
3811 b_execute_while_when_state_set(COND,STMT,INV,VARIANT,PrevVariantValue,LocalState,State,Res,WF,_,InPath,OutPath) :-
3812 copy_wf_start(WF,while2,CWF),
3813 b_compute_expression(VARIANT,LocalState,State,VarVal,CWF),
3814 copy_wf_finish(WF,CWF),
3815 b_execute_while1(COND,STMT,INV,VARIANT,PrevVariantValue,VarVal,LocalState,State,Res,WF,InPath,OutPath).
3816
3817 % ------------- IF-THEN-ELSE
3818
3819 :- block b_execute_else_list2(-,?,?,?, ?,?,?,?,?,-,?). % should we also unblock if LWF set ? needed for seq. composition to set up state ??
3820 b_execute_else_list2(PredRes,Body,Rest,LocalState,InState,OutState,InnerWF,CaseNr,Path,LWF,OR) :-
3821 %(var(PredRes) -> print('IF-THEN-ELSE ENUMERATION: '), translate:print_subst(Body),nl ; true),
3822 ? b_execute_else_list3(PredRes,Body,Rest,LocalState,InState,OutState,InnerWF,CaseNr,Path,LWF,OR).
3823
3824 b_execute_else_list3(pred_true,Body,_,LocalState,InState,OutState,WF,CaseNr,if(CaseNr,Path),_,OR) :-
3825 ? push_wait_flag_call_stack_info(WF,b_subst_call(if_then_body,Body),WF2),
3826 ? b_execute_statement(Body,LocalState,InState,OutState,WF2,Path,OR).
3827 b_execute_else_list3(pred_false,_Body,Rest,LocalState,InState,OutState,WF,CaseNr,Path,LWF,OR) :-
3828 CaseNr1 is CaseNr+1,
3829 ? b_execute_else_list(Rest,LocalState,InState,OutState,WF,CaseNr1,Path,LWF,OR).
3830
3831 b_execute_else_list([],_,_State,[],_WF,_,if_skip,_LWF,_OR). /* skip */
3832 b_execute_else_list([TExpr|Rest],LocalState,InState,OutState,WF,CaseNr,Path,LWF,OR) :-
3833 get_texpr_expr(TExpr,if_elsif(Test,Body)), % Info field not used
3834 % get_enumeration_finished_wait_flag(WF,LWF),
3835 InnerWF=WF, %clone_wait_flags_from1(WF,InnerWF),
3836 push_wait_flag_call_stack_info(InnerWF,b_expr_call(if_elsif_test,Test),WF2),
3837 ? b_try_check_boolean_expression_lwf(Test,LocalState,InState,WF2,'$ENUMERATION',PredRes,LWF),
3838 %ground_wait_flag0(InnerWF),
3839 (nonvar(PredRes)
3840 ? -> b_execute_else_list3(PredRes,Body,Rest,LocalState,InState,OutState,InnerWF,CaseNr,Path,LWF,OR)
3841 ; (LWF == '$GENERATE_ON_DEMAND' ->
3842 get_wait_flag0(WF,LWF1),
3843 get_wait_flag_if_necessary(PredRes,LWF1,OR,WF,LWF2)
3844 ; LWF2=LWF),
3845 ? b_execute_else_list2(PredRes,Body,Rest,LocalState,InState,OutState,InnerWF,CaseNr,Path,LWF2,OR)
3846 ).
3847
3848 % avoid calling get_wait_flag if possible (expensive)
3849 :- block get_wait_flag_if_necessary(-,-,?,?,?).
3850 get_wait_flag_if_necessary(PredRes,_,OR,WF,LWF2) :- var(PredRes), !, % we need waitflag
3851 (preferences:preference(use_smt_mode,true) -> Prio = 2 % was 2.0
3852 ; OR == output_required -> Prio = 2000
3853 ; Prio = 200000 %last_finite_priority(Prio)
3854 ), % TO DO: check if there is a guard inside; if not we can wait much longer; unless we are in CBC mode
3855 get_wait_flag(Prio,if_else,WF,LWF2).
3856 get_wait_flag_if_necessary(_,_,_,_,_).
3857
3858 :- block b_execute_choice(?,?,?,?,?,?,-,?).
3859 b_execute_choice(ChoiceList,LocalState,InState,OutState,WF,choice(Nr,Path),_WFC,OR) :-
3860 ? nth1(Nr,ChoiceList,Choice),
3861 b_execute_statement(Choice,LocalState,InState,OutState,WF,Path,OR).
3862
3863 % execute ASSERT PreCond THEN Body
3864 b_execute_assertion(_PreCond,Body,LocalState,InState,OutState,WF,Path,OR) :-
3865 preference(do_assert_checking,false), % ASSERT checking disabled
3866 !,
3867 b_execute_statement(Body,LocalState,InState,OutState,WF,Path,OR).
3868 b_execute_assertion(PreCond,Body,LocalState,InState,OutState,WF,Path,OR) :-
3869 ? b_try_check_boolean_expression_lwf(PreCond,LocalState,InState,WF,'$ENUMERATION',PredRes,WFC),
3870 % enumeration of PredRes before WFE set make sense, Body can instantiate values
3871 (var(PredRes) -> get_last_wait_flag(assertion,WF,WFC) ; true),
3872 b_execute_assertion_block(PredRes,PreCond,Body,LocalState,InState,OutState,WF,Path,OR).
3873
3874 :- block b_execute_assertion_block(-, ?,?,?,?, ?,?,?,?).
3875 b_execute_assertion_block(pred_true,_PreCond,Body,LocalState,InState,OutState,WF,Path,OR) :-
3876 Path = assertion(IPath),
3877 b_execute_statement(Body,LocalState,InState,OutState,WF,IPath,OR).
3878 b_execute_assertion_block(pred_false,PreCond,_Body,LocalState,InState,_OutState,WF,Path,_OR) :-
3879 Path = assertion_violated,
3880 translate_bexpression(PreCond,PreString),
3881 add_abort_error_span(assert_error,'ASSERT violated: ',PreString,span_predicate(PreCond,LocalState,InState),WF).
3882
3883 :- block check_state_skeleton_bound(-,?).
3884 check_state_skeleton_bound([],true).
3885 check_state_skeleton_bound([bind(Var,_)|T],Res) :-
3886 check_state_skeleton_bound_aux(Var,T,Res).
3887
3888 :- block check_state_skeleton_bound_aux(-,?,?).
3889 check_state_skeleton_bound_aux(Var,T,Res) :-
3890 (atomic(Var) -> true ; print('*** variable name not atomic: '), print(Var),nl),
3891 check_state_skeleton_bound(T,Res).
3892
3893
3894 b_execute_statement_list_when_state_set(StmtList,LS,State,USoFar,Res,WF,Path,OR) :-
3895 check_state_skeleton_bound(State,Bound), % otherwise variable lookups will cause problems
3896 ? b_execute_statement_when_state_set2(StmtList,LS,State,USoFar,Res,WF,Path,Bound,OR).
3897 :- block b_execute_statement_when_state_set2(?,?,?,?,?,?,?,-,?).
3898 b_execute_statement_when_state_set2(StmtList,LS,State,UpdatesSofar,Res,WF,Path,_,OR) :-
3899 (get_preference(warn_about_failing_assignments,true)
3900 ; get_preference(provide_trace_information,true)),!,
3901 copy_wf_start(WF,while2,CWF),
3902 ? if(b_execute_sequence(StmtList,LS,State,StmtUpdates,CWF,Path,OR),
3903 true,
3904 (StmtList=[NS|_], % typically, statements inside a sequential composion do not have inner guards
3905 (get_preference(warn_about_failing_assignments,true)
3906 -> add_warning_wf(b_interpreter,'Statement inside sequential composition fails: ',NS,NS,WF)
3907 ; add_message_wf(b_interpreter,'Statement inside sequential composition fails: ',NS,NS,WF)
3908 ),
3909 fail)),
3910 ? copy_wf_finish(WF,CWF),
3911 ? merge_updates(UpdatesSofar,StmtUpdates,Res).
3912 b_execute_statement_when_state_set2(StmtList,LS,State,UpdatesSofar,Res,WF,Path,_,OR) :-
3913 copy_wf_start(WF,while2,CWF),
3914 ? b_execute_sequence(StmtList,LS,State,StmtUpdates,CWF,Path,OR),
3915 ? copy_wf_finish(WF,CWF),
3916 merge_updates(UpdatesSofar,StmtUpdates,Res).
3917
3918
3919 store_values([], [], []).
3920 store_values([IDsHd|IDsTl], [VALsHd|VALsTl], [bind(IDsHd,VALsHd)|OutStateTl]) :-
3921 store_values(IDsTl, VALsTl, OutStateTl).
3922
3923
3924
3925
3926 /* the B syntax does allow multiple definitions in a LET: */
3927
3928 b_execute_let_definitions(Pred,LocalState,State,WF) :-
3929 is_a_conjunct(Pred,LHS,RHS),!,
3930 b_execute_let_definitions(LHS,LocalState,State,WF),
3931 b_execute_let_definitions(RHS,LocalState,State,WF).
3932 b_execute_let_definitions(b(equal(LHS,RHS),_,_),LocalState,State,WF) :- !,
3933 b_compute_expression(LHS,LocalState,State,LHSVal,WF),
3934 b_compute_expression(RHS,LocalState,State,RHSVal,WF),
3935 % TO DO: ideally we should check if LHS is a declared identifier and is only defined once
3936 kernel_objects:equal_object_optimized(LHSVal,RHSVal,b_execute_let_definitions).
3937 b_execute_let_definitions(b(lazy_let_pred(Id,AssignmentExpr,Body),_,_),LocalState,State,WF) :- !,
3938 add_lazy_let_id_and_expression(Id,AssignmentExpr,LocalState,State,NewLocalState,WF),
3939 b_execute_let_definitions(Body,NewLocalState,State,WF).
3940 b_execute_let_definitions(P,_L,_S,WF) :-
3941 add_internal_error_wf(b_interpreter,'Let contains a predicate which is not an equality: ',P,P,WF),fail.
3942
3943
3944 /* -----------------------------------------*/
3945 /* b_assign_function */
3946 /* -----------------------------------------*/
3947
3948 b_assign_values_or_functions([],[],_LS,_S,[],_WF,_OR).
3949 b_assign_values_or_functions([TExpr|ERest],[Value|VRest],LS,S,[bind(Id,New)|NRest],WF,OR) :-
3950 get_texpr_expr(TExpr,Expr),
3951 ? b_assign_value_or_function(Expr,Value,LS,S,Id,New,WF,OR),
3952 b_assign_values_or_functions(ERest,VRest,LS,S,NRest,WF,OR).
3953
3954 :- use_module(kernel_tools,[ground_value_check/2]).
3955 :- use_module(kernel_records,[overwrite_record_wf/5]).
3956 b_assign_value_or_function(identifier(Id),Value,_LS,_S,LHS_Id,FullValue,WF,_OR) :- !,
3957 LHS_Id=Id,
3958 ? equal_object_wf(FullValue,Value,b_assign_value_or_function(Id),WF).
3959 b_assign_value_or_function(function(Fun,Arg),Value,LocalState,InState,Id,FullValue,WF,OR) :- !,
3960 %b_compute_expression(Arg,LocalState,InState,ArgVal,WF),
3961 %expand_global_sets_but_not_closures(ArgVal,EArgVal),
3962 FunMNF = eval_must_not_fail('Assignment left-hand-side (or part thereof) could not be evaluated: ',Fun), % could be f(..)(..)
3963 b_compute_assign_expressions_when([Arg,FunMNF],LocalState,InState,[ArgVal,FunVal],WF,OR), % or should we pass the OR info around ?
3964 /* we do not examine local state: these vars cannot be modified by operations !? */
3965 (OR=output_required -> override(FunVal,ArgVal,Value,NewFun,WF)
3966 ; ground_value_check((FunVal,ArgVal,Value),GRV),
3967 % wait until all arguments known so that we can effiently compute override
3968 blocking_override(GRV,FunVal,ArgVal,Value,NewFun,WF)),
3969 get_texpr_expr(Fun,Lhs),
3970 b_assign_value_or_function(Lhs,NewFun,LocalState,InState,Id,FullValue,WF,OR).
3971 b_assign_value_or_function(record_field(RecordExpr,FieldName),Value,LocalState,InState,LHS_Id,FullValue,WF,OR) :-
3972 !,
3973 % we allow nested record assignments: x'Field1'Field2 := Value
3974 b_compute_expression(RecordExpr,LocalState,InState,OldRecVal,WF),
3975 overwrite_record_wf(OldRecVal,FieldName,Value,NewRecVal,WF),
3976 get_texpr_expr(RecordExpr,Lhs),
3977 b_assign_value_or_function(Lhs,NewRecVal,LocalState,InState,LHS_Id,FullValue,WF,OR).
3978 b_assign_value_or_function(LHS,_Value,_LS,_InState,_Id,_FullValue,WF,_OR) :-
3979 add_internal_error_wf(b_interpreter,'Illegal LHS for assignment (must be ID(.) or ID\'Field or ID): ',LHS,LHS,WF),
3980 fail.
3981
3982 :- block blocking_override(-,?,?,?,?,?).
3983 blocking_override(_,FunVal,ArgVal,Value,NewFun,WF) :- override(FunVal,ArgVal,Value,NewFun,WF).
3984
3985
3986 /* -----------------------------------------*/
3987 /* b_execute_statements_in_parallel */
3988 /* -----------------------------------------*/
3989 /* execute a parallel composition of statements */
3990 :- assert_pre(b_interpreter:b_execute_statements_in_parallel(Ss,LS,State,_Os,WF,_Paths,_OR),
3991 (ground_check(Ss),type_check(LS,store),
3992 type_check(State,store),type_check(WF,wait_flag))).
3993 :- assert_post(b_interpreter:b_execute_statements_in_parallel(_Ss,_LS,_State,Os,WF,_Paths,_OR),
3994 (type_check(Os,store),type_check(WF,wait_flag))).
3995
3996 b_execute_statements_in_parallel([],_,_,[],_WF,[],_OR).
3997 b_execute_statements_in_parallel([Stmt|TS],LocalState,InState,OutState,WF,[Path1|TPath],OR) :-
3998 ? b_execute_statement(Stmt,LocalState,InState,OutState1,WF,Path1,OR),
3999 ? combine_updates(OutState1,OutState2,OutState), /* merge updates */
4000 ? b_execute_statements_in_parallel(TS,LocalState,InState,OutState2,WF,TPath,OR).
4001
4002
4003 %:- block combine_updates(-,-,?).
4004 %combine_updates(A,B,C) :- (B==[] -> A=C ; combine_updates_aux(A,B,C)).
4005
4006 % TO DO: investigate whether we could also unblock on second argument and copy it to result
4007 :- block combine_updates(-,?,?). % can also be used to merge states
4008 combine_updates([],X,R) :- !,R=X.
4009 ?combine_updates([H|T],Y,Res) :- !, Res=[H|Z], combine_updates(T,Y,Z).
4010 combine_updates(X,Y,Z) :- add_internal_error('Illegal call: ',combine_updates(X,Y,Z)),fail.
4011
4012
4013
4014 b_execute_initialisation_statement(Stmt,LS,In,Out,_OUTERWF,Path,OR) :-
4015 init_wait_flags(WF,[b_execute_initialisation_statement]),
4016 % each initialisation can be executed in isolation (except in CBC mode)
4017 ? b_execute_statement(Stmt,LS,In,Out,WF,Path,OR),
4018 ? ground_wait_flags(WF).
4019
4020 % replace certain parallels by init_parallel for better error reporting in INITIALISATION
4021 % will not be used in CBC mode (by set_up_initialisation or tc_initialise)
4022 translate_init_statements(b(Stmt,subst,I),b(TStmt,subst,I)) :-
4023 tp2(Stmt,I,TStmt).
4024 tp2(assign(LHS,RHS),I,parallel(S)) :- LHS=[_,_|_],
4025 % translate multiple assignment into parallel assignments
4026 maplist(generate_assignment(I),LHS,RHS,S),
4027 !.
4028 tp2(Stmt,I,init_statement(b(Stmt,subst,I))) :- %get_preference(provide_trace_information,true),
4029 wrap_stmt(Stmt),
4030 !.
4031 % TO DO: cover WHILE
4032 tp2(parallel(S),_,parallel(TS)) :- maplist(translate_init_statements,S,TS),
4033 !.
4034 tp2(sequence(A),_,sequence(LA)) :- !,maplist(translate_init_statements,A,LA).
4035 tp2(if(A),_,if(LA)) :- !, maplist(translate_init_statements,A,LA).
4036 tp2(if_elsif(Test,Body),_,if_elsif(Test,LBody)) :- !,
4037 translate_init_statements(Body,LBody).
4038 tp2(X,_,X). % :- functor(X,F,A), nl,nl,print(uncovered(F/A)),nl,nl.
4039
4040 wrap_stmt(assign(_,_)).
4041 wrap_stmt(becomes_element_of(_,_)).
4042 wrap_stmt(becomes_such(_,_)).
4043 wrap_stmt(assign_single_id(_,_)).
4044
4045 generate_assignment(I,V,RHS,b(init_statement(b(Assign,subst,I)),subst,I)) :-
4046 Assign = assign([V],[RHS]).
4047
4048
4049
4050 /* ---------------------------------------*/
4051 /* b_execute_top_level_statement */
4052 /* ---------------------------------------*/
4053
4054 /* this is just like b_execute_statement with the
4055 only difference that a PRE-condition is treated like
4056 a select, i.e., it does not generate an abort if used
4057 outside of its condition */
4058 b_execute_top_level_statement(TExpr,LocalState,InState,OutState,WF,Path,OR) :-
4059 get_texpr_expr(TExpr,Stmt),
4060 ? b_execute_top_level_statement2(Stmt,TExpr,LocalState,InState,OutState,WF,Path,OR).
4061 b_execute_top_level_statement2(precondition(PreCond,Body),TExpr,
4062 LocalState,InState,OutState,WF,Path,OR) :-
4063 preferences:preference(treat_outermost_pre_as_select,true),!,
4064 %debug_println(9,'Top level PRE treated as SELECT'),
4065 preference(ltsmin_do_not_evaluate_top_level_guards,NO_EVAL),
4066 (NO_EVAL=true, % do not evaluate guards detected by guard splitting
4067 get_texpr_info(TExpr,Info),member(prob_annotation('LTSMIN-GUARD'),Info)
4068 -> debug_println(9,ltsmin_guard_will_not_be_evaluated)
4069 ? ; b_test_boolean_expression(PreCond,LocalState,InState,WF)
4070 ),
4071 % b_tracetest_boolean_expression(PreCond,LocalState,InState,WF,one), % comment in for debugging
4072 ? b_execute_statement(Body,LocalState,InState,OutState,WF,Path,OR).
4073 b_execute_top_level_statement2(lazy_let_subst(Id,IdExpr,Body),_,
4074 LocalState,InState,OutState,WF,lazy_let(Path),OR) :-
4075 !,
4076 add_lazy_let_id_and_expression(Id,IdExpr,LocalState,InState,NewLocalState,WF),
4077 ? b_execute_top_level_statement(Body,NewLocalState,InState,OutState,WF,Path,OR).
4078 b_execute_top_level_statement2(_,TExpr,LocalState,InState,OutState,WF,Path,OR) :-
4079 ? b_execute_statement(TExpr,LocalState,InState,OutState,WF,Path,OR).
4080
4081
4082 /* -----------------------------*/
4083 /* b_execute_operation */
4084 /* -----------------------------*/
4085 /* execute a single operation */
4086
4087 try_get_op_name(FullOperation,_Name) :- var(FullOperation),!.
4088 try_get_op_name('-->'(FO,_),Name) :- !,try_get_op_name(FO,Name).
4089 try_get_op_name(FullOperation,Name) :- functor(FullOperation,Name,_).
4090
4091
4092
4093 :- assert_pre(b_interpreter:b_execute_top_level_operation_update(_Name,_FullOperation,InState,_NewState,_P),
4094 (ground_check(InState),type_check(InState,store))).
4095 :- assert_post(b_interpreter:b_execute_top_level_operation_update(Name,_FullOperation,_InState,NewState,_Path),
4096 (type_check(NewState,store),ground_check(Name))).
4097
4098
4099 b_execute_top_level_operation_update(Name,FullOperation,InState,Updates,Path) :-
4100 ? b_execute_top_level_operation_update_wf(Name,FullOperation,InState,Updates,Path,WF),
4101 ? ground_wait_flags(WF).
4102 %store:store_updates_and_normalise(Updates,InState,NewState).
4103
4104
4105 b_execute_top_level_operation_update_wf(Name,FullOperation,InState,Updates,Path,WF) :-
4106 init_wait_flags(WF,[]), % now treated by call_stack: [expansion_context(op(Name),[])]),
4107 % b_execute_operation2 below will push_wait_flag_call_stack_info
4108 try_get_op_name(FullOperation,Name), b_top_level_operation(Name),
4109 setup_result_input_values(Name,RIV),
4110 Info=unknown, % Info extracted later for top_level
4111 ? b_execute_operation2(Name,FullOperation,InState,Updates,_,RIV,_,true,Path,Info,WF,output_not_required).
4112
4113 % set up value of read output variables *before* operation call to some dummy value
4114 setup_result_input_values(Name,ResultInputValues) :-
4115 (get_preference(allow_operations_to_read_outputs,true),
4116 b_operation_reads_output_variables(Name,_Reads,TReadsInfo) ->
4117 maplist(setup_read_output_variable,TReadsInfo,ResultInputValues)
4118 %translate_bstate_limited(ResultInputValues,TS),
4119 %ajoin(['Warning: setting read output variables in ',Name,' to default values: ',TS],Msg),
4120 %add_warning(b_interpreter,Msg),
4121 %store_error_for_context_state(eventerror(Name,event_other_error(Msg),[]),_Id)
4122 ; ResultInputValues=[]).
4123
4124 :- use_module(typing_tools,[any_value_for_type/2]).
4125 setup_read_output_variable(reads_result(_,Name,Type),bind(Name,Val)) :- any_value_for_type(Type,Val).
4126
4127 % for use by CBC:
4128 b_execute_top_level_operation_wf(Name,FullOperation,ParaVals,ResultVals,InState,NewState,Path,WF) :-
4129 try_get_op_name(FullOperation,Name),
4130 if(b_top_level_operation(Name),true,
4131 (add_internal_error('Unknown operation name for b_execute_top_level_operation_wf: ',Name),fail)
4132 ),
4133 % call before execute operation to copy over results immediately in case b_execute_operation2 generates choice points:
4134 store_intermediate_updates_wf(InState,Updates,NewState,operation(Name),WF), % no normalising is better for constraint propagation
4135 % TO DO?: copy over unmodified variables b_get_machine_variables(Variables),copy_unmodified_variables(Variables,OpName,InState,NewState)
4136 setup_result_input_values(Name,RIV),
4137 Info=unknown, % Info extracted later for top_level
4138 b_execute_operation2(Name,FullOperation,InState,Updates,ParaVals,RIV,ResultVals,true,Path,Info,WF,output_required).
4139 % we should ensure that Operation part is executed to instantiate NewOutState skeleton
4140
4141
4142
4143 % Note : if the argument OR (OutputRequired) has value output_required this indicates that the output
4144 % an operation or its effect is required (e.g., because of sequential composition) and the constraint solver
4145 % should not delay computing the effect of the operation
4146 % Atelier-B Handbook 6.16: [R <- op (E)]P = [X := E ; S ; R :=Y] P where op defined by X <- op(Y) = S
4147 b_execute_operation_with_parameters(Name,LocalState,InState,Results,Parameters,OutState,ParamValues,ResultValues,
4148 Path,Info,WF,OR) :-
4149 (b_is_operation_name(Name)
4150 -> b_compute_expressions(Parameters,LocalState,InState,ParamValues,WF),
4151 % TO DO : remove local vars from InState
4152 (b_operation_reads_output_variables(Name,_Reads,TReadsInfo)
4153 -> % format('Transferring outputs ~w ~w~n ~w~n',[Name,_Reads,TReadsInfo]),
4154 maplist(output_parameters_value(LocalState,InState,Results,Info,WF),TReadsInfo,ResultInputValues)
4155 ; ResultInputValues=[]),
4156 ? call_b_execute_operation2(Name,InState,OutState,ParamValues,ResultInputValues,ResultValues,false,
4157 Path,Info,WF,OR)
4158 ; add_internal_error('Unknown B operation, cannot call: ',
4159 b_execute_operation_with_parameters(Name,LocalState,InState,Results,Parameters,
4160 OutState,ParamValues,ResultValues,Path,Info,WF,OR)),
4161 fail
4162 ).
4163
4164
4165 %b_execute_operation_in_expression(Name,_LocalState,_InState,_Parameters,_Value,Info,_WF) :-
4166 % % This clause is disabled: sometimes variables are marked as read even though they are not:
4167 % % the analysis is not precise due to sequential composition, CASE statements, ...
4168 % b_operation_reads_output_variables(Name,_Reads,_TReadsInfo),!,
4169 % add_error(b_interpreter,'Operation that reads output cannot be called in expression: ',Name,Info),
4170 % fail.
4171 b_execute_operation_in_expression(Name,LocalState,InState,Parameters,Value,Info,WF) :-
4172 % TODO: check that this is a query operation; probably done in type checker
4173 OR=output_required, % alternative: OR=output_not_required,
4174 setup_result_input_values(Name,ResultInputValues),
4175 b_compute_expressions(Parameters,LocalState,InState,ParamValues,WF),
4176 (b_get_operation_normalized_read_write_info(Name,Read,_Modified)
4177 -> true % Modified should be []
4178 ; member(reads(Read),Info)
4179 -> add_message(b_interpeter,'Unregistered operation in expression: ',Name) % prefixed operation not found
4180 ; add_error(b_interpeter,'Cannot obtain read-write info for operation in expression:',Name),
4181 Read=[]
4182 ),
4183 create_inner_wait_flags(WF,operation_call_in_expr,OpWF),
4184 ground_value_check(ParamValues,ParaGround),
4185 exclude(unused_variable(Read),InState,IS),
4186 ground_state_check(IS,StateGround),
4187 % TO DO: in case of recursion it may be good to delay executing sub-operation until some WF is set
4188 call_b_execute_operation2(Name,IS,_OutState,ParamValues,ResultInputValues,ResultValues,false,_Path,Info,OpWF,OR),
4189 ground_inner_wf(ParaGround,StateGround,OpWF),
4190 make_couplise(ResultValues,Value).
4191
4192 % ground inner waitflags when parameters and relevant read variables fully known
4193 :- block ground_inner_wf(-,?,?), ground_inner_wf(?,-,?).
4194 ground_inner_wf(_,_,WF) :-
4195 ? ground_inner_wait_flags(WF).
4196
4197 call_b_execute_operation2(Name,InState,OutState,ParamValues,ResultInputValues,ResultValues,false,Path,Info,WF,OR) :-
4198 ? runtime_profiler:profile_single_call(Name,unknownStateId, b_interpreter:
4199 b_execute_operation2(Name,_,InState,OutState,ParamValues,ResultInputValues,ResultValues,false,Path,Info,WF,OR)
4200 ).
4201
4202 output_parameters_value(LocalState,InState,Results,_,WF,reads_result(Index,ID,_Type),bind(ID,Val)) :-
4203 nth1(Index,Results,ReadResultTID),!,
4204 def_get_texpr_id(ReadResultTID,ReadID),
4205 (lookup_value_without_check(ReadID,LocalState,InState,Val)
4206 -> true %check_not_undefined(Val,ReadID,ReadResultTID)
4207 ; add_error_wf(output_parameters,'Could not obtain value for read output parameter: ',ReadID,ReadResultTID,WF),
4208 Val = term(undefined)).
4209 output_parameters_value(_LocalState,_InState,_Results,Info,WF,reads_result(_Index,ID,_Type),bind(ID,Val)) :-
4210 add_error_wf(output_parameters,'Could not obtain value for read output parameter: ',ID,Info,WF),
4211 Val = term(undefined).
4212
4213 % TO DO: use this ?
4214 %:- block check_not_undefined(-,?,?).
4215 %check_not_undefined(term(undefined),ReadID,ReadResultTID) :- !,
4216 % add_error(output_parameters_value,'Output parameter not assigned to: ',ReadID,ReadResultTID).
4217 %check_not_undefined(_,_,_).
4218
4219 :- use_module(probsrc(succeed_max),[assert_max_reached/1]).
4220 % ResultInputValues: in Atelier-B result parameters can also be read !
4221 b_execute_operation2(Name,Operation,InState,Updates,ParaValues,ResultInputValues,ResultValues,_TopLvl,TransInfo,_,_WF,_OR) :-
4222 ResultInputValues = [], % in this case the operation's behaviour also depends on current value of output variables
4223 lookup_cached_transitions(Name,InState,Info,Solutions),!,
4224 (member(max_reached,Info) -> assert_max_reached(Name) ; true),
4225 ? member(trans_cached(ParaValues,ResultValues,Updates,TransInfo),Solutions),
4226 create_full_operation(Name,ResultValues,ParaValues,ResultValues,Operation).
4227 % TODO: call operation with ParaValues if not found and max_reached is true !!
4228
4229 b_execute_operation2(Name,Operation,InState,NewOutState,ParaValues,ResultInputValues,ResultValues,
4230 TopLevel,TransInfo,Info,WF,OutputRequired) :-
4231 if(b_get_machine_operation_for_animation(Name,Results,Parameters,Body,OType,TopLevel,OpPos),
4232 true,
4233 (add_error_wf(b_interpreter,'Cannot find operation:',Name,Info,WF),fail)),
4234 %% % we do not want skip the evaluation of a guard of an operation with parameters
4235 (Info=unknown, TopLevel==true -> CallInfo=OpPos ; CallInfo=Info),
4236 push_wait_flag_call_stack_info(WF,operation_call(Name,ParaValues,CallInfo),WF2),
4237 ? b_execute_operation3(OType,Name,Operation,
4238 InState,NewOutState,
4239 Body,Parameters,ParaValues,Results,ResultInputValues,ResultValues,TopLevel,TransInfo,WF2,OutputRequired).
4240
4241 create_full_operation(Name,Results,ParaValues,ResultValues,FullOperation) :-
4242 Operation =.. [Name|ParaValues], % TO DO: catch if > 255 args (max_arity)
4243 ( Results == [] -> /* we have an ordinary operation */
4244 FullOperation = Operation
4245 ; FullOperation = '-->'(Operation,ResultValues)
4246 ).
4247
4248 b_execute_operation3(classic,Name,Operation,InState,NewOutState,
4249 Body,Parameters,ParaValues,Results,ResultInputValues,NormalisedResultValues,TopLevel,
4250 [path(Path)], % as path is currently filtered out anyway and not stored !
4251 WF,OR) :-
4252 %print('Attempting Operation ----> '),print(Name),nl,
4253 empty_state(EmptyState),
4254 ? set_up_typed_localstate(Parameters,ParaValues,ParamTypedVals,EmptyState,LocalState,positive),
4255 l_expand_and_normalise_values(ParaValues,NormalisedParaValues,Parameters),
4256 % not useful for call_b_execute_operation2
4257 create_full_operation(Name,Results,NormalisedParaValues, % ditto
4258 NormalisedResultValues,Operation),
4259 set_up_undefined_localstate_with_predefined(Results,ResultInputValues,InState,NewInState),
4260 /* to avoid error messages with sequential composition (store_intermediate_updates) */
4261 check_additional_guard(TopLevel,LocalState,NewInState,WF),
4262 (TopLevel==true
4263 ? -> b_execute_top_level_statement(Body,LocalState,NewInState,OutState,WF,Path,OR)
4264 ? ; b_execute_statement(Body,LocalState,NewInState,OutState,WF,Path,OR)
4265 ),
4266 b_tighter_enumerate_all_values(ParamTypedVals,WF),
4267 % moved after execute for performance reasons; see PerformanceTests/ParameterEnumeration.mch
4268 % print_bt_message('Operation Successful ------> '),
4269 (preferences:preference(treat_outermost_pre_as_select,true),
4270 preferences:preference(require_operations_to_assign_all_outputs,true)
4271 -> ReportError = true ; ReportError = false),
4272 get_results(Results,OutState,NormalisedResultValues,NewOutState,ReportError,normalise_results,WF).
4273 b_execute_operation3(eventb_operation(ChangeSet,ParaValues,Operation),
4274 _Name,Operation, InState,Updates,
4275 TBody,Parameters,ParaValues,[],[],[],true,TransInfo,WF,OutputRequired) :-
4276 % TO DO: check if need to pass _OutputRequired to b_event
4277 ? b_execute_event_with_change_set_wf(TBody,Parameters,ParaValues,InState,ChangeSet,Updates,TransInfo,WF,OutputRequired).
4278
4279 :- use_module(b_global_sets,[add_prob_deferred_set_elements_to_store/3]).
4280 % additional guards can be set by the user to constrain/direct the execution of operations
4281 check_additional_guard(TopLevel,LocalState,State,WF) :-
4282 (TopLevel==true,
4283 bmachine:b_machine_temp_predicate(TempPred)
4284 /* an additional precondition typed in by the user */
4285 -> check_state_skeleton_bound(LocalState,LB),
4286 check_state_skeleton_bound(State,BB),
4287 check_additional_guard_when_bound(LB,BB,TempPred,LocalState,State,WF)
4288 ; true
4289 ).
4290
4291 :- block check_additional_guard_when_bound(-,?,?, ?,?,?), check_additional_guard_when_bound(?,-,?, ?,?,?).
4292 check_additional_guard_when_bound(_,_,TempPred,LocalState,State,WF) :-
4293 (debug_mode(on) -> print(check_additional_guard),nl, print_bexpr(TempPred),nl ; true),
4294 add_prob_deferred_set_elements_to_store(State,BState1,visible),
4295 b_test_boolean_expression(TempPred,LocalState,BState1,WF).
4296
4297 % additional properties can either be set by user or by command-line or by VALUES clause
4298 add_additional_properties(OldProperty,NewProperty) :-
4299 (bmachine:b_machine_temp_predicate(TempPred) % this overrides additional property !
4300 -> conjunct_predicates([TempPred,OldProperty],NewProperty)
4301 ; findall(AddPred,b_machine_additional_property(AddPred),L),
4302 (L=[] -> NewProperty = OldProperty
4303 ; conjunct_predicates([OldProperty|L],NewProperty)
4304 )
4305 ).
4306
4307 % get removes results from OutState
4308 filter_results(Results,OutState,NewOutState,WF) :-
4309 get_results(Results,OutState,_ResultValues,NewOutState,false,do_not_normalise,WF).
4310 get_results(Results,OutState,ResultValues,NewOutState,ReportError,Normalise,WF) :-
4311 (Results==[] -> (ResultValues,NewOutState) = ([],OutState)
4312 ; get_results1(Results,OutState,ResultValues,NewOutState,ReportError,Normalise,WF)).
4313 :- block get_results1(?,-,?,?,?,?,?).
4314 get_results1([],OutState,[],OutState,_ReportError,_Normalise,_WF).
4315 get_results1([R|Results],OutState,[NRV|ResultValues],NewOutState,ReportError,Normalise,WF) :-
4316 def_get_texpr_id(R,ResultId),
4317 lookup_and_delete_value(ResultId,RV,OutState,OutState2,ReportError,WF,Finished),
4318 get_results2(Finished,R,Results,RV,NRV,OutState2,ResultValues,NewOutState,ReportError,Normalise,WF).
4319 :- block get_results2(-,?,?,?,?,?,?,?,?,?,?).
4320 get_results2(_,R,Results,RV,NRV,OutState2,ResultValues,NewOutState,ReportError,Normalise,WF) :-
4321 (Normalise==normalise_results -> normalise_value_for_var(R,true,RV,NRV)
4322 ;
4323 NRV=RV), % Maybe we should not normalise in CBC mode ?
4324 get_results1(Results,OutState2,ResultValues,NewOutState,ReportError,Normalise,WF).
4325
4326
4327
4328 /* ------------------------------------------------------------------ */
4329 /* SET UP CONSTANTS */
4330 /* ------------------------------------------------------------------ */
4331
4332 :- use_module(static_ordering).
4333
4334 :- volatile no_solution_found_for_constants/0, solution_found_for_partial_properties/0,
4335 properties_were_filtered/1,
4336 unsat_properties_component/2, unsat_properties_enumeration_warning/1, unsat_properties_abort_error/1,
4337 unsat_properties_conjunct_inside_component/4.
4338 :- dynamic no_solution_found_for_constants/0, solution_found_for_partial_properties/0,
4339 properties_were_filtered/1,
4340 unsat_properties_component/2, unsat_properties_enumeration_warning/1,
4341 unsat_properties_abort_error/1,
4342 unsat_properties_conjunct_inside_component/4.
4343
4344 reset_unsat_component_infos :-
4345 retractall(unsat_properties_component(_,_)),
4346 retractall(unsat_properties_enumeration_warning(_)),
4347 retractall(unsat_properties_abort_error(_)),
4348 retractall(unsat_properties_conjunct_inside_component(_,_,_,_)).
4349
4350 :- use_module(b_interpreter_components,[unsat_conjunct_inside_component/4, unsat_component_abort_error/1,
4351 unsat_component_enumeration_warning/1]).
4352 % store information about unsatisfiable components for later usage
4353 % will only be called when no solution found for components
4354 copy_unsat_component_infos :-
4355 unsat_component(X,FalseOrUnknown), % from b_interpreter_components
4356 assertz(unsat_properties_component(X,FalseOrUnknown)),fail.
4357 copy_unsat_component_infos :-
4358 unsat_component_enumeration_warning(X), % from b_interpreter_components
4359 assertz(unsat_properties_enumeration_warning(X)),fail.
4360 copy_unsat_component_infos :-
4361 unsat_component_abort_error(X), % from b_interpreter_components
4362 assertz(unsat_properties_abort_error(X)),fail.
4363 copy_unsat_component_infos :-
4364 unsat_conjunct_inside_component(X,BE,Status,Reason), % from b_interpreter_components
4365 assertz(unsat_properties_conjunct_inside_component(X,BE,Status,Reason)),fail.
4366 copy_unsat_component_infos.
4367
4368 get_unsat_component_status(Status) :-
4369 (unsat_conjunct_inside_component(_,_,false,_) -> Status = false
4370 ; unsat_component(X,false),
4371 \+ unsat_component_abort_error(X) -> Status = false % what about enumeration warnings?
4372 ; Status=unknown).
4373
4374 % the same, but work on facts copied by copy_unsat_component_infos
4375 get_unsat_properties_status(Status) :-
4376 (unsat_properties_conjunct_inside_component(_,_,false,_) -> Status = false
4377 ; unsat_properties_component(X,false),
4378 \+ unsat_properties_abort_error(X) -> Status = false % what about enumeration warnings?
4379 ; Status=unknown).
4380
4381
4382 all_unsat_components_marked_prob_ignore :-
4383 unsat_properties_conjunct_inside_component(_,_,unknown,'prob-ignore'), % at least one prob-ignore was used
4384 !,
4385 \+ non_ignore_unsat_component.
4386
4387 non_ignore_unsat_component :-
4388 unsat_properties_conjunct_inside_component(_,_,Status,Reason),
4389 \+ (Status = unknown, Reason = 'prob-ignore').
4390
4391 tcltk_unsatisfiable_components_exist :-
4392 unsat_or_unknown_properties_component_exists.
4393 unsat_or_unknown_properties_component_exists :-
4394 (unsat_properties_component(_,_) -> true). %unsat_or_unknown_component_exists,!.
4395
4396 %tcltk_unsatisfiable_components(list(UnsatComponents)) :-
4397 % findall(C,unsat_properties_component(C),UnsatComponents), UnsatComponents\=[].
4398
4399 get_property_components(Components) :-
4400 b_machine_has_constants_or_properties,
4401 b_get_properties_from_machine(Properties),
4402 add_additional_properties(Properties,NewProperty),
4403 bsyntaxtree:predicate_components(NewProperty,Components),!.
4404 get_property_components([]).
4405
4406 :- dynamic uses_implementable_integers/0.
4407 :- dynamic min_max_integer_value_used/2.
4408
4409
4410 tcltk_quick_describe_unsat_properties(list(FullDescr),STATUS) :-
4411 retractall(uses_implementable_integers),
4412 retractall(min_max_integer_value_used(_,_)), assertz(min_max_integer_value_used(none,none)),
4413 get_property_components(Components),
4414 (unsat_properties_conjunct_inside_component(_,_,false,_) -> STATUS='FALSE'
4415 ; all_unsat_components_marked_prob_ignore -> STATUS = 'prob-ignore'
4416 ; STATUS='UNKNOWN'
4417 ),
4418 findall(TP, (unsat_properties_conjunct_inside_component(CompNr,P,_Status,_ReasonMsg), % find individual conjuncts
4419 % Status can be false or unknown
4420 nth1(CompNr,Components,component(FullPred,_Vars)),
4421 check_uses_implementable_integers(FullPred), % for min-max one may need to look at the entire component !
4422 translate_bexpression_with_limit(P,TrP),
4423 get_component_enum_warning_message(CompNr,EnumWarningAbortMsg),
4424 (EnumWarningAbortMsg = '' -> Prefix = '' ; Prefix = '\n '),
4425 get_span_msg(P,'\n ',SpanMsg),
4426 ajoin([' * ',TrP,Prefix,EnumWarningAbortMsg,SpanMsg,'\n'],TP)),
4427 D1),
4428 findall([Msg1,PS|DescrVars],
4429 (get_unsat_component_description(Components,CompNr,MaxCompNr,
4430 Size,PS,DescrVars,EnumWarningAbortMsg,SpanMsg),
4431 ajoin([' * Predicate Component ',EnumWarningAbortMsg,CompNr,'/',MaxCompNr,
4432 ' (with ',Size,' conjunct(s))',SpanMsg, ':'],Msg1)),
4433 UC),
4434 append(UC,UCL), % join all component descriptions
4435 (D1=[]
4436 % TO DO: adapt message for enumeration warning
4437 -> Descr = D2,
4438 (UCL=[] -> D2 = ['The properties were satisfiable']
4439 ; D2 = ['No solution found for the following predicates: '|UCL]
4440 )
4441 ; Descr = ['The following properties prevented finding a solution:\n'|D12],
4442 % Comment: the predicate can trigger the computation of another earlier registered predicate
4443 % Example f = {1|->2} & f: A --> B & A = 1..5; A=1..5 triggers the check for f
4444 (UCL=[] -> D2=[]
4445 ; D2 = ['\nIn addition no solution was found for the following predicates: '|UCL]
4446 ),
4447 append(D1,D2,D12)),
4448 findall(W,other_warning(W),Warnings),
4449 (Warnings = [] -> FullDescr=Descr ; append(Descr,['\nWARNINGS/MESSAGES:'|Warnings],FullDescr)).
4450
4451 % called by predicate_debugger:
4452 get_unsat_component_predicate(CompNr,Predicate,Vars) :-
4453 unsat_properties_component(CompNr,_FalseOrUnknown),
4454 get_property_components(Components),
4455 nth1(CompNr,Components,component(Predicate,Vars)).
4456
4457 get_unsat_component_description(Components,CompNr,MaxCompNr,Size,PS,DescrVars,EnumWarningAbortMsg,SpanMsg) :-
4458 unsat_properties_component(CompNr,_),
4459 \+ unsat_properties_conjunct_inside_component(CompNr,_,_,_), % we have not yet dealt with this component in first findall above
4460 nth1(CompNr,Components,component(Pred,Vars)),
4461 length(Components,MaxCompNr),
4462 size_of_conjunction(Pred,Size),
4463 describe_constants(Vars,DescrVars),
4464 check_uses_implementable_integers(Pred), % store information in case it does use implementable integers for later user messages
4465 (debug_mode(on) -> Lim = 1500 ; Lim = 250),
4466 translate_bexpression_with_limit(Pred,Lim,PS),
4467 get_component_enum_warning_message(CompNr,EnumWarningAbortMsg),
4468 % note: sometimes we have a conjunction with empty span info, but different conjuncts (possibly from different files):
4469 get_span_msg(Pred,'\n ',SpanMsg).
4470
4471 get_span_msg(Pred,Prefix,SpanMsg) :-
4472 (extract_span_description(Pred,SpanStr) -> ajoin([Prefix,SpanStr],SpanMsg) ; SpanMsg = '').
4473
4474 get_component_enum_warning_message(CompNr,EnumWarningAbortMsg) :-
4475 (unsat_properties_enumeration_warning(CompNr)
4476 ->(unsat_properties_abort_error(CompNr)
4477 -> EnumWarningAbortMsg = '[** with Enumeration Warning and WD-ERROR **] '
4478 ; EnumWarningAbortMsg = '[* with Enumeration Warning *] ')
4479 ; (unsat_properties_abort_error(CompNr)
4480 -> EnumWarningAbortMsg = '[** with WD-ERROR **] '
4481 ; EnumWarningAbortMsg = '')
4482 ).
4483
4484 describe_constants([],R) :- !,R=[].
4485 describe_constants(Vars,['* over identifiers : '|Vars]).
4486
4487 check_uses_implementable_integers(_) :- specfile:eventb_mode,!. % cannot use implementable integers
4488 check_uses_implementable_integers(_) :- uses_implementable_integers,!. % no need to check another component
4489 check_uses_implementable_integers(Pred) :-
4490 (uses_implementable_integers(Pred)
4491 -> assertz(uses_implementable_integers),
4492 retract(min_max_integer_value_used(Min,Max)),
4493 min_max_integer_value_used(Pred,Min,Max,NewMin,NewMax),
4494 assertz(min_max_integer_value_used(NewMin,NewMax))
4495 ; true).
4496
4497 other_warning(W) :- uses_implementable_integers,
4498 preferences:get_preference(minint,MININT),
4499 preferences:get_preference(maxint,MAXINT),
4500 min_max_integer_value_used(Min,Max),
4501 ( (number(Min),Min<MININT ; number(Max),Max>MAXINT)
4502 -> ajoin(['\n MININT...MAXINT only set to ',MININT,'..',MAXINT,' but integers used at least from ',Min,'..',Max],W)
4503 ; (MAXINT < 127 ; MININT > -128)
4504 -> ajoin(['\n MININT...MAXINT possibly too small: ',MININT,'..',MAXINT],W)).
4505 % TO DO: we could also extract explicit integer values used in the component and compare them against MININT/MAXINT
4506 other_warning(W) :- bmachine_eventb:deferred_set_equality_without_enumeration_axioms(X,_Set),
4507 translate_bexpression_with_limit(X,XS),
4508 ajoin(['\n Set not recognized as enumerated: ',XS],W).
4509 % TO DO: generate warning if MAXINT/MININT small and NAT,NAT1 or INT was used in component(s) above
4510
4511 % call if tcltk_quick_describe_unsat_properties fails:
4512 % TODO: maxint warning above
4513 generate_unsat_properties_warnings :- uses_implementable_integers,
4514 preferences:get_preference(minint,MININT),
4515 preferences:get_preference(maxint,MAXINT),
4516 min_max_integer_value_used(Min,Max),
4517 (number(Min),Min<MININT ; number(Max),Max>MAXINT),
4518 ajoin(['MININT...MAXINT only set to ',MININT,'..',MAXINT,' but integers used at least from ',Min,'..',Max],Msg),
4519 add_warning(setup_constants_unknown,Msg),
4520 fail.
4521 generate_unsat_properties_warnings :-
4522 bmachine_eventb:deferred_set_equality_without_enumeration_axioms(X,Set),
4523 translate_bexpression_with_limit(X,TX),
4524 Eq = b(equal(X,Set),pred,[]),
4525 ajoin(['Deferred SET ',TX,' was not recognized as an enumerated set, you may want to use partition instead of the equality: '],Msg),
4526 add_warning(setup_constants_unknown,Msg,Eq,X),
4527 fail.
4528 generate_unsat_properties_warnings.
4529
4530 % -------------
4531
4532 % Complete is either complete_properties or partial_properties if properties were marked as ignore
4533 b_set_up_concrete_constants(NormalisedConstantsState,Complete) :-
4534 reset_unsat_component_infos,
4535 retractall(properties_were_filtered(_)),
4536 (no_solution_found_for_constants -> true ; assertz(no_solution_found_for_constants)),
4537 % preference(allow_incomplete_partial_setup_constants,AllowSkipping),
4538 reset_component_info(true),
4539 b_machine_has_constants_or_properties,
4540 b_get_machine_constants(UnsortedConstants),
4541 !,
4542 silent_mode(SilentMode),
4543 ? (SilentMode=on -> true ; bt_start_ms_timer('SETUP_CONSTANTS')), % TO DO: store time for unsat core
4544 b_get_non_ignored_properties_from_machine(NonIgnoredProperties,Excluded),
4545 (Excluded>0 % prob-ignore predicates were filtered
4546 -> assertz(properties_were_filtered(Excluded)),
4547 Complete1=partial_properties
4548 ; Complete1=complete_properties
4549 ),
4550 add_additional_properties(NonIgnoredProperties,Properties),
4551 project_onto_static_assertions(Properties,UnsortedConstants,PProperties,PUnsortedConstants),
4552 ? solve_properties(PProperties,PUnsortedConstants,ConstantsState,SatResult),
4553 ? (SilentMode=on -> true ; bt_stop_ms_timer('SETUP_CONSTANTS')),
4554 (SatResult=satisfiable -> Complete = Complete1
4555 ; Complete = partial_properties,
4556 assert_solution_found_for_partial_properties),
4557 normalise_store(ConstantsState,NormalisedConstantsState),
4558 retractall(no_solution_found_for_constants). /* ensure that b_partial_set_up_concrete_constants fails */
4559 b_set_up_concrete_constants([],complete).
4560
4561
4562 % solve already projected and filtered properties and constants, return state with solution for constants
4563 % cbc_solve_timed almost does what we want; but looks at current state; see solve_free_aux
4564 % TODO: move this to a separate module and add cdclt
4565 solve_properties(PProperties,PUnsortedConstants,ConstantsState,SatResult) :-
4566 get_preference(use_solver_on_load,Solver),
4567 ? solve_properties(Solver,PProperties,PUnsortedConstants,ConstantsState,SatResult).
4568
4569 solve_properties(sat,Properties,_TypedConstants,ConstantsState,satisfiable) :- !,
4570 ? b2sat:solve_predicate_with_satsolver_free(Properties, ConstantsState,Result,[]),
4571 Result=solution(_).
4572 solve_properties('sat-z3',Properties,_TypedConstants,ConstantsState,satisfiable) :- !,
4573 b2sat:solve_predicate_with_satsolver_free(Properties, ConstantsState,Result,[use_satsolver(z3)]),
4574 Result=solution(_).
4575 solve_properties(cdclt,Properties,_TypedConstants,ConstantsState,satisfiable) :- !,
4576 cdclt_solver:cdclt_solve_predicate(Properties,_,Result),
4577 Result=solution(ConstantsState).
4578 solve_properties(clingo,Properties,_TypedConstants,ConstantsState,satisfiable) :- !,
4579 get_preference(maxNrOfInitialisations,MaxNrSols),
4580 b2asp:solve_pred_with_clingo(Properties,MaxNrSols,_,Result,_Exhaustive),
4581 % TODO: check if non_exhaustive and assert max_reached ?
4582 Result=solution(ConstantsState).
4583 solve_properties(kodkod,PProperties,PUnsortedConstants,ConstantsState,SatResult) :- !,
4584 ? solve_properties(prob,PProperties,PUnsortedConstants,ConstantsState,SatResult). % Kodkod processing is done elswehere
4585 solve_properties(prob,PProperties,PUnsortedConstants,ConstantsState,SatResult) :- !,
4586 (preferences:preference(use_static_ordering,true)
4587 -> sort_ids_by_usage(PUnsortedConstants,PProperties,Constants,no_warnings), % no_warnings as Ids could be used in operations, assertions, ...
4588 set_up_typed_localstate(Constants,_FreshVars,TypedVals,[],SortedState,positive),
4589 ? reorder_state(PUnsortedConstants,SortedState,ConstantsState)
4590 ; Constants = PUnsortedConstants,
4591 ? set_up_typed_localstate(Constants,_FreshVars,TypedVals,[],ConstantsState,positive)
4592 ),
4593 % now try and load saved constants from file for sub-machines when -cache is used:
4594 ? load_partial_constants(ConstantsState,PProperties,LPProperties), % Note: this can backtrack
4595 reset_component_info(true), % reset in case load_partial_constants backtracks! relevant for test 2112
4596 b_global_sets:static_symmetry_reduction_for_global_sets(ConstantsState),
4597 ? call_cleanup(b_trace_test_components_full(LPProperties,ConstantsState,TypedVals,SatResult),
4598 copy_unsat_component_infos).
4599 solve_properties(SolverName,Properties,_TypedConstants,ConstantsState,satisfiable) :-
4600 temporary_set_preference(z3_solve_for_animation, true,Chng),
4601 call_cleanup(smt_solvers_interface:smt_solve_predicate_free(SolverName, Properties, ConstantsState),
4602 reset_temporary_preference(z3_solve_for_animation,Chng)).
4603
4604
4605 b_trace_test_components_full(LPProperties,ConstantsState,TypedVals,SatResult) :-
4606 init_wait_flags_and_push_call_stack(no_wf_available,operation_call('SETUP_CONSTANTS',[],unknown),WF),
4607 ? b_trace_test_components_wf(LPProperties,ConstantsState,TypedVals,all,SatResult,complete,WF),
4608 ground_wait_flags(WF). % WF is just a dummy waitflag to pass call stack info
4609 %(unsat_or_unknown_properties_component_exists -> (!,fail) ; true). % otherwise some expressions were skipped; use partial_set_up
4610
4611 :- volatile project_properties_on_identifiers/1.
4612 :- dynamic project_properties_on_identifiers/1.
4613 set_projection_on_static_assertions(ALL) :-
4614 % set interpreter in mode which projects out all constants not needed
4615 % for static assertion checking; all variables are also projected out
4616 retractall(project_properties_on_identifiers(_)),
4617 (b_get_assertions(ALL,dynamic,[]) -> true
4618 ; nl,print('*** WARNING: DYNAMIC B ASSERTIONS NOT EMPTY'),nl,nl),
4619 ? b_get_assertions(ALL,static,L),
4620 (L=[] -> nl,print('*** WARNING: NO STATIC B ASSERTIONS ***'),nl,nl ; true),
4621 conjunct_predicates(L,Conj),
4622 (debug_mode(on) -> print('Static Assertion: '),translate:print_bexpr(Conj),nl ; true),
4623 bsyntaxtree:predicate_identifiers(Conj,IDs),
4624 (debug_mode(on) -> print('IDS: '), print(IDs),nl ; true),
4625 assertz(project_properties_on_identifiers(IDs)).
4626
4627 % optionally project properties onto those required for checking assertions
4628 project_onto_static_assertions(Properties,Constants,NewProperties,NewConstants) :-
4629 %% set_projection_on_static_assertions(main), %% main or all %% set by probcli if we_need_only_static_assertions
4630 project_properties_on_identifiers(ProjIDs),
4631 bsyntaxtree:project_predicate_on_identifiers(Properties,ProjIDs,NewProperties,PIDs,_),
4632 sort(PIDs,SIPDs),
4633 debug_println(9,projecting(SIPDs)),
4634 include(keep_constant(SIPDs),Constants,NewConstants),!. % Constants is a typed identifier list.
4635 project_onto_static_assertions(Properties,Constants,Properties,Constants).
4636
4637 keep_constant(SIPDs,TypedID) :- get_texpr_id(TypedID,ID),ord_member(ID,SIPDs).
4638
4639
4640
4641 /* can be called if b_set_up_concrete_constants failed; will partially set up the state using values found in first ground value propagation phase */
4642 % called by partial_trans
4643 :- use_module(specfile,[get_specification_description/2]).
4644 b_partial_set_up_concrete_constants(NormalisedConstantsState) :-
4645 get_unsat_properties_status(Status), % Status is false or unknown
4646 no_solution_found_for_constants,
4647 set_error_context(operation('$partial_setup_constants',root)),
4648 (b_partial_set_up_concrete_constants2(NormalisedConstantsState,Status)
4649 -> clear_error_context, generate_unsat_properties_warnings
4650 ; clear_error_context, generate_unsat_properties_warnings,fail).
4651
4652 b_partial_set_up_concrete_constants2(NormalisedConstantsState,Status) :-
4653 b_get_machine_constants(Constants),
4654 Constants \= [],
4655 ? (det_solution_for_constant_was_stored(Cst1) -> true), % we have found a solution for at least one constant
4656 %set_up_typed_localstate(Constants,[],ConstantsState), -> can create call_residue due to typing fd/2 values
4657 findall(bind(ID,_),(member(TID,Constants),def_get_texpr_id(TID,ID)),ConstantsState),
4658 formatsilent('SETUP_CONSTANTS not successful, but solutions were found for some constants (e.g., ~w):~n',[Cst1]),
4659 (fill_in_det_solutions(ConstantsState,FC) -> All=all ; All=some(Cst1)),
4660 (preference(allow_incomplete_partial_setup_constants,true)
4661 -> true
4662 ; % fill_in_det_solutions will fail if not all constants valued and
4663 % if allow_incomplete_partial_setup_constants is false
4664 b_partial_set_up_error_messages(Status,All),
4665 All=all % only continue if all constants valued
4666 ),
4667 normalise_store(FC,NormalisedConstantsState).
4668
4669 assert_solution_found_for_partial_properties :-
4670 (solution_found_for_partial_properties -> true
4671 ; assertz(solution_found_for_partial_properties),
4672 (get_unsat_component_status(Status) -> b_partial_set_up_error_messages(Status,all)
4673 ; add_internal_error('No unsat component: ',assert_solution_found_for_partial_properties),
4674 b_partial_set_up_error_messages(unknown,all))
4675 ).
4676
4677 b_partial_set_up_error_messages(_Status,_All) :-
4678 get_preference(allow_incomplete_partial_setup_constants,true),!.
4679 b_partial_set_up_error_messages(Status,All1) :-
4680 get_specification_description(properties,PS),
4681 (All1=some(Cst1) -> All=some, TMSG = [', e.g., ',Cst1,')'] ; All=All1, TMSG = [')'] ),
4682 % TO DO: determine if time-out occurred or not
4683 (Status=false
4684 -> ajoin([PS,' are unsatisfiable (but ',All,' CONSTANTS valued'|TMSG],Msg),
4685 add_error_or_warning(All,setup_constants_inconsistent,Msg)
4686 ; unsat_properties_abort_error(_)
4687 -> ajoin([PS,' are unknown due to well-definedness error(s) (but ',All,' CONSTANTS valued'|TMSG],Msg),
4688 add_error_or_warning(All,setup_constants_unknown,Msg)
4689 ; unsat_component_enumeration_warning(_)
4690 -> ajoin([PS,' are unknown due to enumeration warning(s) (but ',All,' CONSTANTS valued'|TMSG],Msg),
4691 add_error_or_warning(All,setup_constants_unknown,Msg)
4692 ; all_unsat_components_marked_prob_ignore
4693 -> ajoin([PS,' are unknown due to prob-ignore pragmas (but ',All,' CONSTANTS valued'|TMSG],Msg),
4694 add_message(setup_constants_unknown,Msg)
4695 ;
4696 ajoin([PS,' are unknown (but ',All,' CONSTANTS valued'|TMSG],Msg),
4697 % typical message: but some CONSTANTS valued
4698 add_error_or_warning(All,setup_constants_unknown,Msg)
4699 ).
4700
4701 :- use_module(probsrc(preferences),[get_prob_application_type/1]).
4702 add_error_or_warning(all,Category,Message) :- get_prob_application_type(rodin),!,
4703 add_warning(Category,Message). % if error occurs during LoadEventBModelCommand in ProB for Rodin, the command fails
4704 add_error_or_warning(_,Category,Message) :-
4705 add_error(Category,Message).
4706
4707
4708 :- use_module(store,[no_value_for_variable/2]).
4709 fill_in_det_solutions([],[]).
4710 fill_in_det_solutions([bind(Var,Val)|T],[bind(Var,FVal)|FT]) :-
4711 (det_solution_for_constant(Var,Val)
4712 -> (silent_mode(on) -> true ; write(' --det--> '),print_term_summary(bind(Var,Val))),
4713 FVal=Val
4714 ; %format('No (deterministic) solution was found or stored for constant: ~w~n',[Var]), % message printed by det_solution_for_constant
4715 (preference(allow_incomplete_partial_setup_constants,true)
4716 -> no_value_for_variable(FVal,Var)
4717 ; format('Aborting SETUP_CONSTANTS (set preference ALLOW_INCOMPLETE_SETUP_CONSTANTS to TRUE to allow ProB to proceed without having values for all CONSTANTS)~n',[]),
4718 fail
4719 )
4720 ),
4721 fill_in_det_solutions(T,FT).
4722
4723
4724
4725 /* --------------------------------- */
4726
4727 :- use_module(b_state_model_check, [b_check_valid_state/1]).
4728
4729 % note: set_up_initialisation for CBC checks does not use this predicate
4730 b_initialise_machine(ConstantsState,NormalisedInitialVarsState,FullInitialState,Path) :-
4731 ? if(b_initialise_machine2(ConstantsState,NormalisedInitialVarsState,FullInitialState,Path),
4732 true,
4733 (\+ logged_error(initialisation_fails,_,_,_), % we have already provided a more precise error message
4734 \+ abort_error_exists_in_context_state(initialisation_fails), % ditto as a state error
4735 (bmachine:b_machine_temp_predicate(TempPred)
4736 -> add_message(initialisation_fails,'INITIALISATION FAILS with provided predicate: ',TempPred,TempPred)
4737 ; b_get_initialisation_from_machine(Stmt,_OType)
4738 -> add_error(initialisation_fails,'INITIALISATION FAILS','',Stmt)
4739 ; add_error(initialisation_fails,'MACHINE has no INITIALISATION clause')
4740 ),
4741 fail)
4742 ).
4743
4744 b_initialise_machine2(ConstantsState,NormalisedInitialVarsState,FullInitialState,Path) :-
4745 /* InitialVarsState is an ouput */
4746 b_get_initialisation_from_machine(InitStatement,OType),
4747 ( InitStatement=[] ->
4748 Path = [],
4749 add_message(b_initialise_machine,'Machine has no INITIALISATION statement(s)!'),
4750 NormalisedInitialVarsState = [],
4751 FullInitialState = ConstantsState
4752 ; OType == classic ->
4753 Path = [path(PathInfo)],
4754 b_get_machine_variables(DeclaredVars),
4755 set_up_undefined_localstate(DeclaredVars,ConstantsState,NewInState),
4756 /* this is if the INITIALISATION has a sequential composition; to avoid error messages */
4757 get_texpr_info(InitStatement,PosInfo),
4758 init_wait_flags_with_call_stack(WF,[operation_call('INITIALISATION',[],PosInfo)]),
4759 (bmachine:b_machine_temp_predicate(_)
4760 -> InitStatement2=InitStatement /* avoid enumerating each init statement in parallel in case additional guard links them */
4761 ; translate_init_statements(InitStatement,InitStatement2)
4762 ),
4763 check_additional_guard(true,InitialVarsState,ConstantsState,WF),
4764 ? b_execute_statement(InitStatement2,[],NewInState,InitialVarsState,WF,PathInfo),
4765 % Warning: in Z mode (e.g. test 565) the variable skeleton may not yet be set up !
4766 sort_variable_binding(InitialVarsState,NormalisedInitialVarsState),
4767 append(NormalisedInitialVarsState,ConstantsState,FullInitialState), % put constants at end to make sharing of complete tail-list easier for successor states; should be compatible with order in expand_const_and_vars
4768 split_names_and_types(DeclaredVars,DeclaredNames,DeclaredTypes),
4769 ? ground_wait_flags(WF),
4770
4771 b_enumerate_values_in_store(DeclaredNames,DeclaredTypes,_,InitialVarsState,WF) %% MOVED HERE TO AVOID that target values are enumerated before initialisation effect computed
4772 ; OType = eventb_operation(_ChangeSet,ParaValues,_Operation) ->
4773 prepare_eventb_initialisation(ConstantsState,InitialVarsUnNormState,FullInitialUnNormState),
4774 get_texpr_expr(InitStatement,
4775 rlevent(_Name,_Sec,_Stat,Parameters,_Grd,_Thm,_Act,_VWit,_PWit,_Unmod,_AbsEv)),
4776 ? b_execute_event('initialisation',InitStatement,Parameters,ParaValues,ConstantsState,FullInitialUnNormState,Path),
4777 normalise_store(InitialVarsUnNormState,NormalisedInitialVarsState),
4778 normalise_store(FullInitialUnNormState,FullInitialState) % a bit of redundant work here; we do the work twice and try to normalise constants again !
4779 ),
4780 b_check_valid_state(FullInitialState).
4781
4782 % ensure that the variables always appear in the same order as reported by b_get_machine_variables:
4783 % this is important for e.g., state_packing TO DO: we could sort them according to the variable names, but would there be a gain ??
4784 sort_variable_binding(Store,SortedStore) :- %print(sort_variable_binding(Store,SortedStore)),nl,
4785 b_get_machine_variables(Variables),
4786 sort_aux(Variables,Store,[],SortedStore).
4787 sort_aux([],S,Acc,NormRes) :- reverse(Acc,Res),
4788 normalise_store(Res,NormRes),
4789 (S=[] -> true ; add_internal_error('Unknown variable bindings: ',S)).
4790 sort_aux([TVar|T],Store,Acc,Res) :- def_get_texpr_id(TVar,ID),
4791 bselect(ID,Val,Store,Rest),
4792 sort_aux(T,Rest,[bind(ID,Val)|Acc],Res).
4793
4794 :- block bselect(?,?,-,?). % in Z mode (e.g. test 565) the variable skeleton may not yet be set up !
4795 bselect(ID,Val,[bind(ID1,Val1)|T],Rest) :- % we assume ID1 is nonvar
4796 (ID=ID1 -> Val=Val1,T=Rest
4797 ; Rest = [bind(ID1,Val1)|RT],
4798 bselect(ID,Val,T,RT)).
4799
4800 prepare_eventb_initialisation(ConstantsState,InitialVarsState,FullInitialState) :-
4801 b_get_machine_variables(Variables),
4802 empty_state(Empty),
4803 set_up_typed_localstate(Variables,_,_,Empty,InitialVarsState,positive),
4804 % NormalisedInitialVarsState = InitialVarsState, % TO DO : check that b_event normalises this
4805 combine_updates(InitialVarsState,ConstantsState,FullInitialState).
4806 % put constants at end, to be compatible with b_initialise_machine2 and expand_const_and_vars order and e.g. ltsmin
4807
4808
4809
4810 reset_b_interpreter :-
4811 %reset_partial_evaluator,
4812 retractall(project_properties_on_identifiers(_)),
4813 reset_unsat_component_infos,
4814 retractall(no_solution_found_for_constants),
4815 retractall(solution_found_for_partial_properties).
4816
4817 :- use_module(eventhandling,[register_event_listener/3]).
4818 :- register_event_listener(clear_specification,reset_b_interpreter,
4819 'Reset B-Interpreter Memo Table & Unsat Components.').