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