1 % (c) 2009-2025 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2 % Heinrich Heine Universitaet Duesseldorf
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5
6 :- module(b_state_model_check,
7 [b_set_up_valid_state/1,
8 b_set_up_valid_state_with_pred/2, b_set_up_valid_state_with_pred/4,
9 b_find_dynamic_assertion_violation/1,
10 cbc_dynamic_assertions_check/1, % a version of the above with time-out and result
11 b_check_valid_state/1,
12
13 state_model_check_invariant/4,
14 state_model_check_assertions/4,
15 state_model_check/5,
16
17 cbc_deadlock_freedom_check/3, get_all_guards_false_pred/1,
18 get_unsorted_all_guards_false_pred/1, get_negated_guard/3, get_negated_guard/4,
19 get_guard/2, get_guard_and_precision/3,
20
21 cbc_static_assertions_check/1, cbc_static_assertions_check/2,
22
23 tcltk_perform_cbc_check/4,
24 cbc_find_redundant_invariants/2,
25
26 set_up_transition/7,
27 set_up_initialisation/5,
28
29 execute_operation_by_predicate_in_state/5,
30 execute_operation_by_predicate_in_state_with_pos/6,
31 xtl_execute_operation_by_predicate_in_state/7,
32
33 cbc_constants_det_check/1, tcltk_cbc_constants_det_check/1
34 ]).
35
36
37
38 :- use_module(tools).
39
40 :- use_module(module_information,[module_info/2]).
41 :- module_info(group,cbc).
42 :- module_info(description,'This module provides various tools for constraint-based checking of B machines.').
43
44 :- use_module(self_check).
45 :- use_module(library(lists)).
46 :- use_module(library(ordsets)).
47 :- use_module(store).
48 :- use_module(translate).
49 :- use_module(b_enumerate,[ b_tighter_enumerate_all_values/2]).
50 :- use_module(b_interpreter,
51 [b_test_boolean_expression/4, b_test_boolean_expression/6,
52 %b_det_test_boolean_expression/6,
53 %b_not_test_boolean_expression/6,
54 b_execute_top_level_operation_wf/8,
55 b_execute_top_level_statement/7,
56 set_up_typed_localstate/6]).
57 :- use_module(b_interpreter_eventb, [b_event_constraints/7]).
58 :- use_module(b_global_sets).
59 :- use_module(bmachine).
60 :- use_module(bsyntaxtree).
61
62 :- use_module(kernel_objects).
63 :- use_module(bsets_clp).
64
65 :- use_module(solver_interface, [set_up_typed_localstate_for_pred/4]).
66 :- use_module(preferences, [get_preference/2]).
67
68 :- use_module(debug).
69 :- use_module(typechecker).
70 :- use_module(bmachine).
71 :- use_module(kernel_waitflags).
72 :- use_module(error_manager).
73 :- use_module(probsrc(solver_interface),[apply_kodkod_or_other_optimisations/3]).
74
75 /* --------------------------------------------------------- */
76
77 :- use_module(tools_printing,[format_with_colour_nl/4]).
78 :- use_module(tools,[start_ms_timer/1, stop_ms_timer/1]).
79 stop_silent_ms_timer(T) :- (silent_mode(on) -> true ; stop_ms_timer(T)).
80
81 % constraint-based checking of invariant; checking if invariant is inductive for a given operation
82 state_model_check_invariant(OpName,State,Operation,NormalisedNewState) :-
83 state_model_check(OpName,invariant,State,Operation,NormalisedNewState).
84
85 state_model_check_assertions(OpName,State,Operation,NormalisedNewState) :-
86 state_model_check(OpName,assertions,State,Operation,NormalisedNewState).
87
88 state_model_check(OpName,InvOrAssertion,NormalisedBeforeState,Operation,NormalisedNewState) :-
89 debug_println(9,'===> Starting Constraint-Based Checking'),
90 start_ms_timer(Timer),
91 if(cbc_model_check(OpName,InvOrAssertion,State,Operation,NewState),
92 stop_silent_ms_timer(Timer),
93 (stop_silent_ms_timer(Timer),
94 format_with_colour_nl(user_output,[green],'No cbc counter example for ~w',[OpName]),
95 fail)),
96 nl,
97 format_with_colour_nl(user_error,[red,bold],'Found cbc counter example for ~w',[OpName]),
98 printsilent('% ===> Operation: '), translate_event(Operation,OpStr),println_silent(OpStr),
99 normalise_store(State,NormalisedBeforeState),
100 printsilent('% ===> State: '),translate_bstate(NormalisedBeforeState,StateStr),println_silent(StateStr),
101 normalise_store(NewState,NormalisedNewState),
102 printsilent('% ===> NewState: '),translate_bstate(NormalisedNewState,NStateStr),println_silent(NStateStr).
103
104 :- use_module(library(avl)).
105 cbc_model_check(OpName,InvOrAssertion,BeforeState,Operation,NewState) :-
106 (nonvar(OpName),
107 \+ b_is_operation_name(OpName), \+ b_is_initialisation_name(OpName)
108 -> add_error(constraint_based_check,'Operation does not exist: ',OpName), fail
109 ; true
110 ),
111 debug_println(9,operation_name(OpName)),
112 b_get_properties_from_machine(Properties),
113 b_get_invariant_from_machine(Invariant),
114 b_get_machine_variables(Variables),
115 b_get_machine_constants(Constants),
116 % print_message(extracted_invariant(Variables,Invariant)),
117
118 empty_state(EmptyState),
119 set_up_typed_localstate(Constants,_FreshVars1,TypedVals1,EmptyState,State1,positive),
120 b_global_sets:static_symmetry_reduction_for_global_sets(State1),
121 (b_is_initialisation_name(OpName)
122 -> State=State1,
123 BeforeState = concrete_constants(State), % Ideally we could use root if State==[];
124 % but ProB2 after prob2_invariant_check then tries to evaluate the invariants on it;
125 % TO DO: fix ProB2/ProB2-UI first
126 TypedVals=TypedVals1
127 ; BeforeState=State,
128 set_up_typed_localstate(Variables,_FreshVars2,TypedVals2,State1,State,positive),
129 append(TypedVals1,TypedVals2,TypedVals)
130 ),
131 init_wait_flags_with_call_stack(WF,[prob_command_context(cbc_model_check(OpName),unknown)]),
132
133 % print_message(' set up start state:'), print_message(State),
134 % translate:print_bexpr(Properties),
135 empty_avl(Ai),
136 b_test_boolean_expression(Properties,[],State,WF,Ai,A2), % A2 is used below for after state
137 % print_message(' set up properties for constants'),
138
139 get_target_pred(InvOrAssertion,OpName, Invariant, PriorPred,TargetPred),
140
141 %print('Prior: '),translate:print_bexpr(PriorPred),nl,
142 b_test_boolean_expression(PriorPred,[],State,WF,A2,_A3),
143 % print_message(' set up invariant for start state'),
144
145 set_up_transition_or_init(OpName,Operation,State1,State,NewState,_TransInfo,WF),
146 debug_print(9,' finished setting up target state for operation:'), debug_println(9,OpName),
147 %print_message(' target state:'), print_message(NewState),
148 % Note: we are not setting up an enumerator for NewState; here we would need to be careful as we cannot use tight enumeration for NewState
149
150 predicate_level_optimizations(TargetPred,OptTargetPred),
151
152 (debug_mode(on) -> translate:print_bexpr(OptTargetPred),nl ; true),
153 b_test_boolean_expression(OptTargetPred,[],NewState,WF,A2,_Ao), % not A3 but A2; as different State
154 debug_println(9,' finished setting up invariant of proven invariants and negation of invariant for target state'),
155
156 % print(enum(TypedVals)),nl,
157 b_tighter_enumerate_all_values(TypedVals,WF),
158
159 %(debug_mode(on) -> ground_wait_flag0(WF),portray_waitflags(WF),print_bt_message(grounding_wait_flags) ; true),
160 ground_wait_flags(WF).
161
162 % find target predicate for invariant or assertion checking
163 get_target_pred(invariant,OpName, Invariant, PriorPred, TargetPred) :-
164 (b_is_initialisation_name(OpName) -> create_texpr(truth,pred,[],PriorPred) ; PriorPred=Invariant),
165 % Retrieve Information on proof status of the invariant
166 (get_preference(use_po,true),get_proven_invariant(OpName,ProvenInvariant) -> true
167 ; create_texpr(truth,pred,[],ProvenInvariant), println_silent(no_proven_invariant_info)
168 ),
169 (get_preference(use_po,false) -> UncheckedInvariant=Invariant
170 ; b_specialized_invariant_for_op(OpName,UncheckedInvariant) -> true
171 ; UncheckedInvariant=Invariant, println_silent(no_specialized_invariant_info_for_op(OpName))
172 ),
173 %print_message('proven invariant:'),print(proven(ProvenInvariant)),
174 create_negation(UncheckedInvariant,NegUncheckedInvariant),
175 % we conjoin the predicates so that predicate-level optimizations can be applied (TO DO: also allow Properties to be used)
176 conjunct_predicates([ProvenInvariant,NegUncheckedInvariant],TargetPred).
177 get_target_pred(assertions,OpName, Invariant, PriorPred, TargetPred) :-
178 % TODO: deal with initialisation for PriorPred
179 get_unproven_assertion(UPA),
180 create_negation(UPA,NegUPA),
181 format('Trying to find Assertion Violation after ~w~n Target:',[OpName]),translate:print_bexpr(NegUPA),nl,nl,
182 conjunct_predicates([Invariant,UPA],PriorPred),
183 conjunct_predicates([Invariant,NegUPA],TargetPred).
184 % Note: in Rodin we should in principle only use assertions appearing before each theorem
185 % Also: it would make sense to assert Assertion before the test
186
187 get_unproven_assertion(UPA) :-
188 b_get_assertions(main,dynamic,Assertions),
189 (get_preference(use_po,true)
190 -> exclude(bmachine:is_discharged_assertion,Assertions,UnProvenAssertions)
191 ; UnProvenAssertions = Assertions
192 ),
193 conjunct_predicates(UnProvenAssertions,UPA).
194
195 set_up_transition_or_init(OpName,Operation,ConstantsState,State,NewState,TransInfo,WF) :-
196 b_is_initialisation_name(OpName),!,
197 State = [],
198 set_up_initialisation(ConstantsState,NewState,Operation,TransInfo,WF).
199 set_up_transition_or_init(OpName,Operation,ConstantsState,State,NewState,TransInfo,WF) :-
200 set_up_transition(OpName,Operation,ConstantsState,State,NewState,TransInfo,WF).
201
202 % set up constraints for an operation/event
203 set_up_transition(OpName,Operation,ConstantsState,State,NewState,TransInfo,WF) :-
204 is_event_b_transition(OpName),!,
205 b_get_machine_variables(Variables),
206 create_target_state(Variables,_Values,ConstantsState,NewState,WF),
207 copy_unmodified_variables(Variables,OpName,State,NewState),
208 event_b_transition(OpName,Operation,State,NewState,TransInfo,WF).
209 set_up_transition(OpName,Operation,ConstantsState,State,NewState,TransInfo,WF) :-
210 b_is_operation_name(OpName),!,
211 % classical B
212 append(ConstantsState,State,InState),
213 append(ConstantsState,NewState,OutState),
214 b_get_machine_variables(Variables),
215 if(set_up_target_store(InState,OutState),true,
216 (add_internal_error('Call failed: ',set_up_target_store(InState,OutState)),fail)),
217 copy_unmodified_variables(Variables,OpName,InState,OutState),
218 b_execute_top_level_operation_wf(OpName,Operation,_Paras,_Results,InState,OutState,TransInfo,WF).
219 set_up_transition(OpName,_,_,_,_,_,_) :-
220 add_internal_error('Unknown operation: ',set_up_transition(OpName)),fail.
221
222
223 is_event_b_transition(OpName) :-
224 b_get_machine_operation(OpName,[],_Parameters,_TEvent,eventb_operation(_ChangeSet,_Values,_Operation),_),!.
225 event_b_transition(OpName,Operation,State,NewState,TransInfo,WF) :-
226 b_get_machine_operation(OpName,[],Parameters,TEvent,eventb_operation(ChangeSet,Values,Operation),_),
227 copy_variable_store(State,ChangeSet,_,NewState),
228 b_event_constraints(TEvent,Parameters,Values,State,NewState,TransInfo,WF).
229
230 create_target_state(Variables,Values,ConstantsState,NewState,WF) :-
231 set_up_typed_localstate(Variables,Values,TypedVals,ConstantsState,NewState,positive),
232 b_tighter_enumerate_all_values(TypedVals,WF).
233
234 % TODO[DP, 7.4.2011]: refactor, see b_interpreter:b_execute_operation3/13
235 set_up_initialisation(ConstantsState,NewState,Operation,TransInfo,WF) :-
236 b_get_machine_variables(Variables),
237 create_target_state(Variables,Values,ConstantsState,NewState,WF),
238 store:l_expand_and_normalise_values(Values,NormalisedValues),
239 safe_univ(Operation,['$initialise_machine'|NormalisedValues]),
240 b_safe_get_initialisation_from_machine(Body,OType),
241 set_up_initialisation2(OType,Body,Variables,ConstantsState,NewState,TransInfo,WF).
242 set_up_initialisation2(classic,Body,Variables,ConstantsState,NewState,[path(Path)],WF) :-
243 set_up_undefined_localstate(Variables,ConstantsState,PreInitState),
244 empty_state(EmptyState),
245 b_execute_top_level_statement(Body,EmptyState,PreInitState,Updates,WF,Path,output_required),
246 save_updates_in_existing_store(Updates,NewState).
247 set_up_initialisation2(eventb_operation(_,_,_),Body,_Variables,ConstantsState,NewState,TransInfo,WF) :-
248 b_event_constraints(Body,[],_Values,ConstantsState,NewState,TransInfo,WF).
249
250 set_up_target_store([],Out) :-
251 (var(Out) -> Out=[]
252 ; true % OutStore already set up by somebody else
253 ).
254 set_up_target_store([bind(V,_)|In],OutStore) :-
255 nonvar(OutStore),!, % OutStore already set up by somebody else
256 (OutStore=[bind(VV,_)|T], V==VV
257 -> set_up_target_store(In,T)
258 ; add_binding(OutStore,V), set_up_target_store(In,OutStore)).
259 set_up_target_store([bind(V,_)|In],[bind(V,_)|Out]) :-
260 set_up_target_store(In,Out).
261
262 add_binding(List,V) :- var(List), !, List = [bind(V,_)|_].
263 add_binding([],V) :- add_internal_error(add_binding,'Variable does not appear in store: ',V,unknown).
264 add_binding([bind(VV,_)|T],V) :-
265 (V==VV -> true /* ok, found the variable */
266 ; add_binding(T,V)).
267
268 % copy over the variables that are not changed by the operation from OldStore to NewStore
269 copy_unmodified_variables(Variables,OpName,OldStore,NewStore) :-
270 ( get_operation_info(OpName,SubstitutionInfo) ->
271 ( memberchk(modifies(ModIDs),SubstitutionInfo) ->
272 get_texpr_ids(Variables,Ids),
273 exclude(is_modified_var(ModIDs),Ids,UnmodifiedIds),
274 maplist(copy_var(OldStore,NewStore),UnmodifiedIds)
275 ;
276 add_internal_error('Operation/Event has no modifies info: ',
277 copy_unmodified_variables(Variables,OpName,OldStore,NewStore))
278 % assume that all variables modified: no copy_var calls
279 )
280 ; OpName = 'INITIALISATION' -> true % nothing to copy
281 ; OpName = 'SETUP_CONSTANTS' -> true % nothing to copy
282 ;
283 add_internal_error('Unknown Operation/Event:', copy_unmodified_variables(Variables,OpName,OldStore,NewStore)),
284 fail
285 ).
286 is_modified_var(ModIDs,Id) :-
287 memberchk(Id,ModIDs).
288 copy_var(OldStore,NewStore,Id) :-
289 lookup_value(Id,OldStore,V),lookup_value(Id,NewStore,VNew),
290 equal_object(V,VNew).
291
292
293 /* --------------------------------------------------------- */
294 % a database of available CBC checks:
295 cbc_check('INV_NO_RED',
296 'INV_NO_RED: Find invariants which are redundant',
297 Call,Res,Ok) :- Call = (tcltk_find_redundant_invariants(Res,Ok)).
298 cbc_check('INV_AXM_SAT',
299 'INV_AXM_SAT: Check if there exists a state that satisfies the INVARIANT and the PROPERTIES (AXIOMS)',
300 Call,Res,Ok) :-
301 Call = (b_set_up_valid_state(State) -> Ok=true,translate_bstate(State,Res) ; Ok=false, Res='NO_VALID_STATE_FOUND').
302 cbc_check('DLK',
303 'DLK: Check that INVARIANT does not allow a deadlocking state',
304 Call,Res,Ok) :-
305 Call = (cbc_deadlock_freedom_check(State) -> Ok=false,translate_bstate(State,Res) ; Ok=true, Res='NO_DEADLOCK_FOUND').
306 cbc_check('THM_STATIC',
307 'THM_STATIC: Check that static ASSERTIONS (THEOREMS) follow from PROPERTIES (AXIOMS)',
308 Call,TclRes,Ok) :-
309 Call = (cbc_static_assertions_check(Res),translate_result(Res,Ok),functor(Res,TclRes,_)).
310 %cbc_check('INV/INITIALISATION',
311 % 'INV/INITIALISATION: Check if INITIALISATION can violate INVARIANT',
312 % Call,TclRes,Ok) :-
313 % Call = (tcltk_constraint_based_check_op('$initialise_machine',invariant,Res) -> translate_result(Res,Ok),functor(Res,TclRes,_) ; Ok=true).
314 cbc_check(INVO,
315 Label,
316 Call,Res,Ok) :-
317 b_top_level_operation(OpName),
318 ajoin(['INV/',OpName],INVO),
319 ajoin(['INV/',OpName,': Check that ',OpName,' preserves INVARIANT'],Label),
320 Call = (state_model_check(OpName,invariant,_State,_Operation,NewState)
321 -> Ok=false,translate_bstate(NewState,Res) ; Ok=true, Res='NO_INVARIANT_violation_found').
322 % TO DO: maybe dynamically generate cbc_checks (inv preservation per event); disable certain checks
323
324 :- public translate_result/2. % used above
325 translate_result(no_counterexample_found,Ok) :- !, Ok=true.
326 translate_result(no_counterexample_exists,Ok) :- !, Ok=true.
327 translate_result(no_counterexample_exists(_,_,_),Ok) :- !, Ok=true.
328 translate_result(time_out,Ok) :- !, Ok=time_out.
329 translate_result(_,false).
330
331 tcltk_perform_cbc_check(ID,Text,Result,Ok) :-
332 %print(tcltk_perform_cbc_check(ID,Text,Result,Ok)),nl,
333 if(cbc_check(ID,Text,Call,Res,Ok),
334 (println_silent(Text),
335 call(Call),
336 Result=Res,
337 println_silent(result(Ok,Result))
338 ),
339 (add_internal_error('Illegal CBC check: ',tcltk_perform_cbc_check(ID,Text,Result,Ok)),
340 fail)
341 ).
342 % enum_warning:enter_new_error_scope(ScopeID), event_occurred_in_error_scope(enumeration_warning(_,_,_,_)), exit_error_scope(ScopeID,ErrOcc),ErrOcc=true
343
344
345 :- use_module(probsrc(bsyntaxtree),[conjunction_to_list/2]).
346 :- public tcltk_find_redundant_invariants/2.
347 tcltk_find_redundant_invariants(list(Res),Ok) :-
348 cbc_find_redundant_invariants(Invs,Timeout_occured),
349 (Invs=[] -> Res = ['NO REDUNDANT INVARIANTS'], Ok=true
350 ; Timeout_occured=true -> Res = ['REDUNDANT INVARIANTS (OR WITH TIME-OUT):'|Invs], Ok=false
351 ; Res = ['REDUNDANT INVARIANTS:'|Invs], Ok=false).
352
353
354 :- dynamic timeout_occured/0.
355 cbc_find_redundant_invariants(RedundantInvs,Timeout_occured) :-
356 retractall(timeout_occured),
357 findall(RI,
358 (b_find_redundant_invariant(RedInv,_,R,EnumWarning,ErrOcc),
359 translate:translate_bexpression(RedInv,InvString),
360 generate_explanation(R,EnumWarning,ErrOcc,InvString,RI),
361 (R==time_out -> assertz(timeout_occured) ; true)
362 ),
363 RedundantInvs),
364 (timeout_occured -> Timeout_occured = true ; Timeout_occured=false).
365
366 generate_explanation(R,EnumWarning,ErrOcc,InvString,Res) :-
367 (EnumWarning=true -> L1=[' /* ENUM WARNING */ '|L2] ; L1=L2),
368 (ErrOcc=true -> L2=[' /* REQUIRED FOR WELL-DEFINEDNESS */ '] ; L2=[]),
369 (R=redundant -> ajoin([InvString|L1],Res)
370 ; R=useful -> EnumWarning=true, ajoin(['ENUMERATION WARNING (POSSIBLY USEFUL): ',InvString|L2],Res)
371 ; R=time_out -> ajoin(['TIME OUT (POSSIBLY USEFUL): ',InvString|L1],Res)
372 ).
373
374 :- use_module(tools_timeout, [time_out_with_factor_call/3]).
375
376 b_find_redundant_invariant(RedundantInv,State,Redundant,EnumWarning,ErrOcc) :-
377 b_get_invariant_from_machine(Invariant),
378 conjunction_to_list(Invariant,InvList),
379 select(RedundantInv,InvList,RestInvariantList),
380 (silent_mode(on) -> true ;
381 print('CHECKING REDUNDANCY: '),translate:print_bexpr(RedundantInv),nl),
382 create_negation(RedundantInv,NegRed),
383 conjunct_predicates(RestInvariantList,AdaptedInvariant),
384 %translate:print_bexpr(AdaptedInvariant),nl,
385 enter_new_error_scope(ScopeID,b_find_redundant_invariant),
386 ( time_out_with_factor_call(predicate_satisfiable_relevant_ids(NegRed,AdaptedInvariant,State),5,
387 TO=time_out)
388 -> (TO==time_out -> Redundant=time_out ; Redundant=useful)
389 ; Redundant = redundant),
390 (critical_enumeration_warning_occured_in_error_scope -> EnumWarning=true
391 ; EnumWarning=false),
392 exit_error_scope(ScopeID,ErrOcc,b_find_redundant_invariant),
393 printsilent('RESULT: '),printsilent(Redundant),nls.
394
395
396
397 /* --------------------------------------------------------- */
398
399
400
401 b_set_up_valid_state(State) :- b_set_up_valid_state_with_pred(State,b(truth,pred,[]),true,none).
402
403 b_set_up_valid_state_with_pred(NormalisedState,Pred) :-
404 b_set_up_valid_state_with_pred(NormalisedState,Pred,true,none).
405 b_set_up_valid_state_with_pred(NormalisedState,Pred,UseInvariant,UseConstantsFromStateID) :-
406 %enter_new_error_scope(ScopeID,cbc_find_state),
407 predicate_satisfiable_all_ids(Pred,State,UseInvariant,UseConstantsFromStateID),
408 normalise_store(State,NormalisedState).
409
410 % find a state satisfying the invariant but violating the Assertions
411 b_find_dynamic_assertion_violation(NormalisedState) :-
412 get_unproven_assertion(UPA),
413 create_negation(UPA,NegUPA),
414 b_set_up_valid_state_with_pred(NormalisedState,NegUPA,true,none).
415
416 % the same as above, but with time-out
417 cbc_dynamic_assertions_check(Result) :-
418 enter_new_error_scope(ScopeID,cbc_dynamic_assertions_check),
419 start_ms_timer(Timer),
420 ( time_out_with_factor_call(b_find_dynamic_assertion_violation(State),10,TO=time_out) ->
421 (TO==time_out -> Result = time_out ; Result = counterexample_found(State))
422 ; critical_enumeration_warning_occured_in_error_scope -> Result = no_counterexample_found
423 ; Result = no_counterexample_exists
424 ),
425 (debug_mode(on) -> print('cbc_dynamic_assertions_check: '),stop_ms_timer(Timer) ; true),
426 exit_error_scope(ScopeID,_ErrOcc,cbc_dynamic_assertions_check).
427
428 /* ---------------------- */
429 /* DEADLOCK FREEDOM CHECK */
430 /* ---------------------- */
431
432 :- use_module(bsyntaxtree,[predicate_identifiers/2]).
433 :- use_module(b_ast_cleanup,[predicate_level_optimizations/2]).
434
435 :- public cbc_deadlock_freedom_check/1. % used above
436 cbc_deadlock_freedom_check(State) :-
437 create_texpr(truth,pred,[],True), Filter=0,
438 cbc_deadlock_freedom_check(State,True,Filter).
439
440 % if Filter=1 we filter out guards which are inconsistent with the goal before solving the full predicate
441 cbc_deadlock_freedom_check(State,Goal,Filter) :-
442 debug_println(19,cbc_deadlock_freedom_check(State,Filter)),flush_output,
443 ( is_truth(Goal) ->
444 get_all_guards_false_pred(Target)
445 ;
446 print('Adding additional goal predicate: '),nl,
447 print_bexpr(Goal),nl,
448 ( Filter=1 ->
449 get_all_guards_false_pred(AllGFalse,Goal)
450 ;
451 get_all_guards_false_pred(AllGFalse)),
452 conjunct_predicates([AllGFalse,Goal],Target)
453 ),!,flush_output,
454 statistics(runtime,[Start,_]),
455 statistics(walltime,[WStart,_]),
456 cbc_deadlock_freedom_check2(Target,RState,Start,WStart,false,TO), % TO DO: control SkipIrrelevantComponents by preference or GUI
457 (TO==time_out -> State=time_out ; State=RState).
458 cbc_deadlock_freedom_check2(Target,NormalisedState,Start,WStart,SkipIrrelevantComponents,TO) :-
459 get_texpr_expr(Target,T), T \= falsity,
460 b_get_properties_from_machine(Properties),
461 b_get_invariant_from_machine(Invariant),
462 conjunct_predicates([Properties,Invariant,Target],Pred1),
463 b_get_machine_variables(Variables),
464 b_get_machine_constants(Constants), append(Constants,Variables,CV),
465
466 apply_kodkod_or_other_optimisations(CV,Pred1,Pred),
467 %predicate_level_optimizations(Pred2,Pred), % detect set partitions, etc..., now done inside b_interpreter_components
468
469 set_up_typed_localstate_for_pred(CV,Pred,TypedVals,State),
470 b_interpreter_components:reset_component_info(false),
471 (debug_mode(on) -> translate:nested_print_bexpr_as_classicalb(Pred) ; true),
472 %%visualize_graph:print_predicate_dependency_as_graph_for_dot(Pred,'~/Desktop/pdg.dot'),
473 (SkipIrrelevantComponents==true
474 -> predicate_identifiers(Target,TargetIds) % Warning: can skip over obvious inconsistencies TRUE:BOOL
475 ; TargetIds=all),
476 println_silent(target(TargetIds)),
477 b_global_sets:static_symmetry_reduction_for_global_sets(State),
478 time_out_with_factor_call(
479 b_interpreter_components:b_trace_test_components(Pred,State,TypedVals,TargetIds),
480 10, (nl,TO=time_out)),
481 statistics(runtime,[Stop,_]), Time is Stop - Start,
482 statistics(walltime,[WStop,_]), WTime is WStop - WStart,
483 (TO==time_out -> println_silent(time_out_during_deadlock_checking(Time)), NormalisedState=State
484 ; TO=no_time_out, println_silent(deadlock_counter_example_found(Time,WTime)),
485 normalise_store(State,NormalisedState)
486 ).
487 cbc_deadlock_freedom_check2(Target,_State,Start,WStart,_,no_time_out) :-
488 (get_texpr_expr(Target,falsity) -> println_silent('Disjunction of guards obviously true') ; true),
489 statistics(runtime,[Stop,_]), Time is Stop - Start,
490 statistics(walltime,[WStop,_]), WTime is WStop - WStart,
491 println_silent(no_deadlock_counter_example_found(Time,WTime)), %print_silent
492 fail.
493
494 % test if a predicate can be satisfied for some instantiation of constants and variables
495 predicate_satisfiable(P) :- predicate_satisfiable(P,_),!, print('SATISFIABLE'),nl,nl.
496 predicate_satisfiable(_) :- print('*UNSATISFIABLE*'),nl,nl,fail.
497 predicate_satisfiable(Predicate,State) :-
498 b_get_invariant_from_machine(Invariant),
499 predicate_satisfiable_relevant_ids(Predicate,Invariant,State).
500
501 predicate_satisfiable_all_ids(Predicate,State,UseInvariant,UseConstantsFromStateID) :-
502 (UseInvariant=true -> b_get_invariant_from_machine(Invariant) ; create_texpr(truth,pred,[],Invariant)),
503 predicate_satisfiable5(Predicate,Invariant,State,all,UseConstantsFromStateID). % all: look at all variables/constants: we want a complete solution
504
505 predicate_satisfiable_relevant_ids(Predicate,Invariant,State) :-
506 predicate_identifiers(Predicate,RelevantIds), % only look at relevant ids for Predicate; skip over components not involving them
507 predicate_satisfiable5(Predicate,Invariant,State,RelevantIds,none).
508
509 :- use_module(b_global_sets,[add_prob_deferred_set_elements_to_store/3]).
510 :- use_module(state_space,[get_constants_state_for_id/2]).
511 predicate_satisfiable5(Predicate,Invariant,State,RelevantIds,UseConstantsFromStateID) :-
512 (number(UseConstantsFromStateID),
513 get_constants_state_for_id(UseConstantsFromStateID,UseCState)
514 -> % instead of finding solutions to constants we re-use the constants found in an existing state
515 Constants=[], ReuseConstants=true,
516 debug_format(19,'Reusing constant values from state id ~w~n',[UseConstantsFromStateID]),
517 Properties = b(truth,pred,[]) % no need to check properties
518 ; b_get_properties_from_machine(Properties),
519 b_get_machine_constants(Constants),
520 UseCState=[], ReuseConstants=false
521 ),
522 conjunct_predicates([Properties,Invariant,Predicate],TotPred0),
523 b_get_machine_variables(Variables),
524 append(Constants,Variables,CV),
525 set_up_typed_localstate_for_pred(CV,TotPred0,TypedVals,State0),
526 append(UseCState,State0,State),
527 apply_kodkod_or_other_optimisations(CV,TotPred0,TotPred),
528 %predicate_level_optimizations(TotPred1,TotPred), %now done inside b_interpreter_components
529 b_interpreter_components:reset_component_info(false),
530 (debug_mode(off) -> true ; translate:nested_print_bexpr_as_classicalb(Predicate)),
531 (ReuseConstants==false
532 -> b_global_sets:static_symmetry_reduction_for_global_sets(State)
533 % we could check if there is just a single solution for constants,
534 ; true
535 ),
536 add_prob_deferred_set_elements_to_store(State,State1,visible),
537 % TO DO: catch time-outs
538 b_interpreter_components:b_trace_test_components(TotPred,State1,TypedVals,RelevantIds).
539
540 % we could call solve_components in solver_interface or solve_predicate directly
541 % we could provide options to call setlog, Z3, WD prover, ...
542 % we could also integrate this into apply_kodkod_or_other_optimisations
543 % should we merge with solve_cbc_predicate_over_constants
544
545 % --------------
546
547 % set up a predicate which is true if all guards are false
548 get_all_guards_false_pred(AllGuardsFalsePred) :-
549 findall(NegGuard,
550 (b_is_operation_name(OpName),
551 get_negated_guard(OpName,_,NegGuard)), ListOfNegGuards),
552 conjunct_and_sort_smt_predicates(ListOfNegGuards,AllGuardsFalsePred).
553 get_all_guards_false_pred(AllGuardsFalsePred,FilterPred) :-
554 findall(NegGuard,
555 (b_is_operation_name(OpName),
556 get_negated_guard(OpName,Guard,NegGuard),
557 conjunct_predicates([Guard,FilterPred],FGuard),
558 nls,printsilent('---> CHECKING IF GUARD SATISFIABLE: '), printsilent(OpName),nls,
559 predicate_satisfiable(FGuard) % if Guard not satisfiable given FilterPred: remove it
560 ), ListOfNegGuards),
561 conjunct_and_sort_smt_predicates(ListOfNegGuards,AllGuardsFalsePred).
562
563 % the following is useful, e.g., for graphical visualization
564 get_unsorted_all_guards_false_pred(AllGuardsFalsePred) :-
565 findall(NegGuard,
566 (b_is_operation_name(OpName),
567 get_negated_guard(OpName,_,NegGuard)), ListOfNegGuards),
568 conjunct_predicates(ListOfNegGuards,AllGuardsFalsePred).
569
570 conjunct_and_sort_smt_predicates(List,Result) :-
571 debug_println(9,'Counting basic predicates'),
572 empty_avl(Ai), count(List,2,Ai,Ao),
573 % portray_avl(Ao),nl,
574 sort_smt_predicates(List,Ao,SList),
575 %nl,print(sorted(SList)),nl,
576 conjunct_smt_predicates(SList,Result) , debug_println(9,finished).
577
578 conjunct_smt_predicates([],b(truth,pred,[])).
579 conjunct_smt_predicates([P|T],Res) :- conjunct_smt_predicates(T,TRes),
580 extract_info(P,TRes,Info), % extract e.g., wd condition info
581 conjoin(P,TRes,[try_smt|Info],Res). % try_smt currently no longer useful ?
582
583 % Count the number of occurences of given basic predicates
584 count(b(Pred,pred,_Info),Rel,Ai,Ao) :- !,count2(Pred,Rel,Ai,Ao).
585 count([],_,Ai,Ao) :- !,Ao=Ai.
586 count([H|T],Rel,Ai,Ao) :- !,count(H,Rel,Ai,Aii), count(T,Rel,Aii,Ao).
587 count(R,_,_,_) :- add_error_fail(count,'Illegal argument to count: ',R).
588
589 count2(negation(Pred),Rel,Ai,Ao) :- !, count(Pred,Rel,Ai,Ao).
590 count2(conjunct(A,B),Rel,Ai,Ao) :- !, count(A,Rel,Ai,Aii), count(B,Rel,Aii,Ao).
591 count2(Pred,Rel,Ai,Ao) :- disjunctive_pred(Pred,A,B),!,
592 (Rel>1
593 -> R1 is Rel-1, count(A,R1,Ai,Aii), count(B,R1,Aii,Ao)
594 ; Ai=Ao).
595 count2(Pred,Rel,Ai,Ao) :- smt_predicate(Pred),!, norm_pred(Pred,NP),
596 (avl_fetch(NP,Ai,C1) -> Count is C1+Rel ; Count = Rel),
597 avl_store(NP,Ai,Count,Ao).
598 count2(_Pred,_Rel,A,A).
599
600 disjunctive_pred(disjunct(A,B),A,B).
601 disjunctive_pred(implication(A,B),A,B).
602 disjunctive_pred(equivalence(A,B),A,B).
603
604
605 sort_smt_predicates(b(Pred,pred,Info),Ai,b(SP,pred,Info)) :- sort_smt_predicates2(Pred,Ai,SP).
606 sort_smt_predicates([],_,[]).
607 sort_smt_predicates([H|T],Ai,[SH|ST]) :- sort_smt_predicates(H,Ai,SH), sort_smt_predicates(T,Ai,ST).
608
609 sort_smt_predicates2(negation(Pred),AVL,negation(SPred)) :- !,sort_smt_predicates(Pred,AVL,SPred).
610 sort_smt_predicates2(implication(A,B),AVL,implication(SA,SB)) :- !,
611 sort_smt_predicates(A,AVL,SA), sort_smt_predicates(B,AVL,SB).
612 sort_smt_predicates2(equivalence(A,B),AVL,equivalence(SA,SB)) :- !,
613 sort_smt_predicates(A,AVL,SA), sort_smt_predicates(B,AVL,SB).
614 sort_smt_predicates2(disjunct(A,B),AVL,disjunct(SA,SB)) :- !, % To do: also sort disjuncts
615 sort_smt_predicates(A,AVL,SA), sort_smt_predicates(B,AVL,SB).
616 sort_smt_predicates2(conjunct(A,B),AVL,Res) :- !,
617 conjunction_to_count_list(b(conjunct(A,B),pred,[]),AVL,CountList),
618 sort(CountList,SC),
619 reverse(SC,SortedCList), % to do : use samsort with custom order
620 project_count_list(SortedCList,PR),
621 conjunct_smt_predicates(PR,BRes),
622 (debug_mode(on) -> translate:print_bexpr(BRes),nl ; true),
623 BRes = b(Res,pred,_).
624 sort_smt_predicates2(X,_,X).
625
626 project_count_list([],[]).
627 project_count_list([count(_,P)|T],[P|PT]) :- project_count_list(T,PT).
628
629 conjunction_to_count_list(C,AVL,List) :- is_a_conjunct(C,LHS,RHS),!,
630 conjunction_to_count_list(LHS,AVL,L1),
631 conjunction_to_count_list(RHS,AVL,R1),
632 append(L1,R1,List). % TO DO: improve, use Difference Lists
633 conjunction_to_count_list(b(Pred,pred,Info),AVL,[count(Count,b(Pred,pred,Info))]) :- smt_predicate(Pred),!,
634 norm_pred(Pred,NX),
635 (avl_fetch(NX,AVL,Count) -> true ; Count=0).
636 conjunction_to_count_list(P,_AVL,[count(0,P)]).
637
638 smt_predicate(equal(_,_)).
639 smt_predicate(not_equal(_,_)).
640 smt_predicate(member(_,_)).
641 smt_predicate(not_member(_,_)).
642 smt_predicate(less(_,_)).
643 smt_predicate(less_equal(_,_)).
644 smt_predicate(greater(_,_)).
645 smt_predicate(greater_equal(_,_)).
646
647 norm_pred(equal(A,B),Res) :- !,norm_equal(A,B,Res).
648 norm_pred(not_equal(A,B),Res) :- !,norm_equal(A,B,Res).
649 norm_pred(member(A,B),member(AA,BB)) :- !,norm_pred(A,AA),norm_pred(B,BB).
650 norm_pred(not_member(A,B),member(AA,BB)) :- !,norm_pred(A,AA),norm_pred(B,BB).
651 norm_pred(less(A,B),less(AA,BB)) :- !,norm_pred(A,AA),norm_pred(B,BB).
652 norm_pred(greater(A,B),less(BB,AA)) :- !,norm_pred(A,AA),norm_pred(B,BB).
653 norm_pred(less_equal(A,B),less(BB,AA)) :- !,norm_pred(A,AA),norm_pred(B,BB).
654 norm_pred(greater_equal(A,B),less(AA,BB)) :- !,norm_pred(A,AA),norm_pred(B,BB).
655 norm_pred(b(B,_,_),Res) :- !, norm_pred(B,Res).
656 norm_pred(set_extension(L),Res) :- !, Res=set_extension(NL), norm_pred(L,NL).
657 norm_pred(integer(A),Res) :- !,Res=A.
658 norm_pred(identifier(A),Res) :- !,Res=A.
659 norm_pred([],Res) :- !, Res=[].
660 norm_pred([H|T],Res) :- !, Res=[NH|NT], norm_pred(H,NH), norm_pred(T,NT).
661 norm_pred(X,X).
662
663
664 norm_equal(b(identifier(ID),_,_),_B,Res) :- !,Res=ID.
665 norm_equal(A,B,Res) :- norm_pred(A,AA),norm_pred(B,BB),
666 (AA==boolean_false -> AAA=boolean_true ; AAA=AA),
667 (BB==boolean_false -> BBB=boolean_true ; BBB=BB),
668 (BBB @< AAA -> Res = equal(AAA,BBB) ; Res= equal(BBB,AAA)).
669 /*
670 operation_satisfiable(OpName,FilterPred) :- get_machine_operation(OpName,_,_,_),
671 get_negated_guard(OpName,Guard,_NegGuard),
672 conjunct_predicates([Guard,FilterPred],FGuard),
673 print('CHECKING IF GUARD SATISFIABLE: '), print(OpName),nl,
674 predicate_satisfiable(FGuard).*/
675
676 % Optionally: Remove certain complicated parts from the guards
677 /*
678 simplify_guard(b(Pred,pred,Info),SPred) :- simplify_guard2(Pred,Info,SPred).
679 simplify_guard2(conjunct(A,B),Info,Res) :- !,
680 simplify_guard(A,SA), simplify_guard(B,SB),
681 conjoin(SA,SB,Info,Res).
682 simplify_guard2(exists(P,B),_Info,R) :- !, R=b(truth,pred,[]),
683 print('REMOVED: '),translate:print_bexpr(b(exists(P,B),pred,[])),nl.
684 simplify_guard2(X,Info,b(X,pred,Info)).
685 */
686
687 conjoin(b(truth,_,_),B,_,R) :- !,R=B.
688 conjoin(b(falsity,_,_),_B,_,R) :- !,R=b(falsity,pred,[]).
689 conjoin(A,b(truth,_,_),_,R) :- !,R=A.
690 conjoin(_A,b(falsity,_,_),_,R) :- !,R=b(falsity,pred,[]).
691 conjoin(A,B,Info,b(conjunct(A,B),pred,Info)).
692
693 get_negated_guard(OpName,Guard,NegationOfGuard) :- get_negated_guard(OpName,Guard,NegationOfGuard,_Precise).
694 get_negated_guard(OpName,Guard,NegationOfGuard,Precise) :-
695 get_guard_and_precision(OpName,Guard,Precise),
696 SGuard=Guard,
697 %simplify_guard(Guard,SGuard), %% comment in to remove complicated parts
698 create_negation(SGuard,NegationOfGuard). % we used to add try_smt Info; no longer relevant !?
699
700
701 :- use_module(b_operation_guards,[get_simplified_operation_enabling_condition/5]).
702 %:- use_module(b_ast_cleanup, [clean_up/3]).
703 :- use_module(b_interpreter_components,[construct_optimized_exists/3]).
704
705 % get a guard, by translating all parameters into existential quantifiers
706 get_guard(OpName,Guard) :- get_guard_and_precision(OpName,Guard,_).
707 get_guard_and_precision(OpName,Guard,Precise) :-
708 get_simplified_operation_enabling_condition(OpName,Parameters,EnablingCondition,_BecomesSuchVars,Precise),
709 % Precise is either precise or imprecise
710 % TO DO: partition; avoid lifting becomes_such_that conditions
711 % (in EventB the feasibility PO will ensure that Guard => BecomeSuchThat is ok)
712 construct_optimized_exists(Parameters,EnablingCondition,Guard).
713
714 /* --------------------------------------------------------- */
715
716 :- use_module(tools_printing,[print_error/1]).
717 b_check_valid_state(State) :-
718 (b_valid_state(State) -> true
719 ; print_error('Invalid State:'),
720 print_error(State)
721 ).
722
723 b_valid_state(State) :-
724 b_get_machine_variables(Variables),
725 b_check_variable_types(Variables,State).
726
727
728 % TODO(DP,6.5.2008): removed type check
729 :- assert_pre(b_state_model_check:b_check_variable_types(V,S), (list_skeleton(V),list_skeleton(S))).
730 % (list_skeleton(V),list_skeleton(VT),list_skeleton(S))).
731 :- assert_post(b_state_model_check:b_check_variable_types(_V,_S),true).
732
733 b_check_variable_types([],_).
734 b_check_variable_types([Var|VT],State) :-
735 def_get_texpr_id(Var,VarID), get_texpr_type(Var,Type),
736 (store:lookup_value_for_existing_id(VarID,State,Val),
737 Val\==fail
738 -> (kernel_objects:basic_type(Val,Type)
739 -> true
740 ; print_error('Type Error ! Variable,Value,Type: '),print_error(VarID),
741 print_error(Val),print_error(Type)
742 ),
743 b_check_variable_types(VT,State)
744 ; add_error(b_check_variable_types,'Variable not defined in state: ', VarID),
745 add_error(b_check_variable_types,'Be sure that INITIALISATION initialises the variable: ', VarID),
746 print_error(State)
747 ).
748
749 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
750 % constraint based assertion check
751 :- use_module(preferences).
752
753 cbc_static_assertions_check(Result) :- cbc_static_assertions_check(Result,[]).
754 % currently supported options: tautology_check : check that assertions are tautologies
755 cbc_static_assertions_check(Result,Options) :-
756 ? get_cbc_assertions_predicate_to_solve(Options, Constants, TotalPredicate,true,_),
757 enter_new_error_scope(ScopeID,cbc_static_assertions_check),
758 start_ms_timer(Timer),
759 (member(observe_state,Options) -> external_functions:observe_state(State) ; true),
760 ( time_out_with_factor_call(cbc_static_assertions_check2(State,Constants, TotalPredicate),10,TO=time_out)
761 % counter example was found or time out reached:
762 -> (TO==time_out -> Result = time_out ; Result = counterexample_found(State))
763 % cbc_static_assertions check did not find a counter exmaple:
764 ; critical_enumeration_warning_occured_in_error_scope -> Result = no_counterexample_found
765 ; get_elapsed_walltime(Timer,WTime),
766 cbc_static_assertions_contradiction_check(Constants,TotalPredicate,Result,Options,WTime)
767 ),
768 (debug_mode(on) -> print('cbc_static_assertions_check: '),stop_ms_timer(Timer) ; true),
769 exit_error_scope(ScopeID,_ErrOcc,cbc_static_assertions_check).
770
771 % in case of proof: check if we can establish a contradiction in the hypotheses
772 cbc_static_assertions_contradiction_check(Constants,TotalPredicate,Result,Options,_) :-
773 member(contradiction_check,Options),
774 println_silent('Looking for contradiction in hypothesis'),
775 get_cbc_assertions_predicate_to_solve(Options, Constants, TotalPredicate2,false,Goal),
776 start_ms_timer(Timer),
777 (time_out_with_factor_call(cbc_static_assertions_check2(_,Constants, TotalPredicate2),10,TO=time_out)
778 -> debug_println(no_contradiction(TO)),fail ; true),
779 get_elapsed_walltime(Timer,WTime),
780 (critical_enumeration_warning_occured_in_error_scope
781 -> print(no_contradiction(enumeration_warning)),nl,fail ; true),
782 !,
783 println_silent('*** CONTRADICTION IN HYPOTHESIS FOUND !'),
784 translate:translate_bexpression_with_limit(Goal,GS),
785 add_warning(contradiction_in_hypotheses,
786 'Prover double check result: Contradiction in hypotheses (or Bug) detected for goal: ',GS),
787 compute_unsat_core_if_requested(Options,TotalPredicate2,WTime),
788 Result = no_counterexample_exists(Constants,TotalPredicate,[contradiction_in_hypotheses]).
789 cbc_static_assertions_contradiction_check(Constants,TotalPredicate,Result,Options,WTime) :-
790 compute_unsat_core_if_requested(Options,TotalPredicate,WTime),
791 Result = no_counterexample_exists(Constants,TotalPredicate,[]).
792
793 cbc_static_assertions_check2(concrete_constants(NormalisedState),Constants, TotalPredicate) :-
794 solve_cbc_predicate_over_constants(Constants,TotalPredicate,NormalisedState).
795
796
797 %:- use_module(smt_solvers_interface(smt_solvers_interface),[smt_solve_predicate/4]).
798 %solve_cbc_predicate_over_constants(_TypedConstants,TotalPredicate,NormalisedState) :-
799 % %print(TypedConstants),nl,
800 % translate:nested_print_bexpr(TotalPredicate),nl,
801 % Solver=z3,
802 % smt_solve_predicate(Solver,TotalPredicate,NormalisedState,Result),
803 % % possible results: contradiction_found, no_solution_found(Reason), time_out, solution(_)
804 % print(solver_res(Solver,Result)),nl,
805 % (Result = contradiction_found -> !, fail ; Result = solution(_) -> !).
806 solve_cbc_predicate_over_constants(Constants,TotalPredicate,NormalisedState) :-
807 empty_state(EmptyState),
808 set_up_typed_localstate(Constants,_FreshVars1,TypedVals,EmptyState,State,positive),
809 b_global_sets:static_symmetry_reduction_for_global_sets(State),
810 apply_kodkod_or_other_optimisations(Constants,TotalPredicate,TotPred),
811 %predicate_level_optimizations(TotPred1,TotPred), % now done inside b_interpreter_components
812 b_interpreter_components:reset_component_info(false),
813 % TO DO: prioritise components containing parts/variables from Assertions (see set_projection_on_static_assertions/)
814 b_interpreter_components:b_trace_test_components(TotPred,State,TypedVals,all),
815 normalise_store(State,NormalisedState).
816
817
818
819 % input Options: output: list of identifiers over which predicate solved + predicate itself
820 get_cbc_assertions_predicate_to_solve(Options, Constants, TotalPredicate,NegateGoal,NegGoal) :-
821 ? get_cbc_assertions_sequent(Options, Constants, Properties, GoalToProve),
822 conjunct_predicates(GoalToProve,GoalC),
823 (debug_mode(on) -> print('Trying to prove goal: '),nl,translate:nested_print_bexpr_as_classicalb(GoalC) ; true),
824 (NegateGoal=true -> create_negation(GoalC,NegGoal) ; NegGoal=GoalC),
825 %% print('Using Hypotheses: '),nl,translate:nested_print_bexpr_as_classicalb(Properties), %%
826 conjunct_predicates([NegGoal,Properties],TotalPredicate).
827
828 % ------------------------
829
830 get_cbc_assertions_sequent(Options, Constants, Properties, GoalToProve) :-
831 b_get_machine_constants(AllConstants),
832 (member(specific(Label),Options) -> WhichAss=specific(Label)
833 ; member(main_assertions,Options) -> WhichAss=main
834 ; WhichAss=all),
835 ? b_get_assertions(WhichAss,static,Assertions),
836 (get_preference(use_po,true), nonmember(tautology_check,Options)
837 -> exclude(bmachine:is_discharged_assertion,Assertions,UnProvenAssertions)
838 ; UnProvenAssertions = Assertions
839 ),
840 (member(tautology_check,Options)
841 % used for ProB as an Atelier-B disprover/prover: the ASSERTIONS are an implication
842 -> find_identifier_uses_l(UnProvenAssertions,[],Ids),
843 include(id_mem(Ids),AllConstants,Constants), % only include constants used in tautology
844 construct_sequent(UnProvenAssertions,Properties,GoalToProve)
845 ; % Sequent: Properties |- UnProvenAssertions
846 b_get_properties_from_machine(Properties),
847 Constants = AllConstants,
848 GoalToProve = UnProvenAssertions
849 ).
850
851 construct_sequent([IMPLICATION],HYP,[RHS]) :-
852 is_an_implication(IMPLICATION,HYP,RHS),!.
853 construct_sequent([b(negation(HYP),pred,I)],HYP,[RHS]) :- % relevant for test 1451
854 member(was(implication),I),
855 !,
856 RHS=b(falsity,pred,[]).
857 construct_sequent(UPAssertions,b(truth,pred,[]),UPAssertions).
858
859 id_mem(IDList,TID) :- get_texpr_id(TID,ID), member(ID,IDList).
860
861 :- use_module(extrasrc(unsat_cores),[unsat_core_list_with_time_limit/5]).
862 compute_unsat_core_if_requested(Options,Predicate,WTime) :-
863 member(unsat_core,Options),!,
864 format('Computing UNSAT CORE (~w ms to find initial contradiction)~n',[WTime]),
865 UCOptions=[],
866 unsat_core_list_with_time_limit(Predicate,WTime,UCOptions,no_solution_found,CorePredicates),
867 nl,print('UNSAT CORE: '),nl,
868 print('--------'),nl,
869 translate:nested_print_bexpr_as_classicalb(CorePredicates),
870 print('--------'),nl.
871 compute_unsat_core_if_requested(_,_,_).
872
873
874 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
875
876 copy_binding_skel(bind(Id,_),bind(Id,_)).
877
878 execute_operation_by_predicate_in_state(InVarsState,OpName,Predicate,Operation,OutVariablesState) :-
879 execute_operation_by_predicate_in_state_with_pos(InVarsState,OpName,Predicate,Operation,OutVariablesState,unknown).
880
881 :- use_module(state_space,[visited_expression/2]).
882 % execute an operation in a state with an additional predicate
883 % the predicate can talk about parameters, return values, the after state
884 % and the before state using $0 identifiers.
885 % Predicate usually parsed by b_parse_machine_operation_pre_post_predicate
886 execute_operation_by_predicate_in_state_with_pos(const_and_vars(ID,InVariablesState),OpName,Predicate,Operation,
887 const_and_vars(ID,OutVariablesState),Pos) :- !,
888 visited_expression(ID,concrete_constants(ConstantsState)),
889 execute_operation_by_predicate_in_state2(ConstantsState,InVariablesState,OpName,Predicate,
890 Operation,OutVariablesState,Pos).
891 execute_operation_by_predicate_in_state_with_pos(InVariablesState,OpName,Predicate,Operation,OutVariablesState,Pos) :-
892 execute_operation_by_predicate_in_state2([],InVariablesState,OpName,Predicate,Operation,OutVariablesState,Pos).
893
894 :- use_module(b_global_sets,[add_prob_deferred_set_elements_to_store/3]).
895 :- use_module(specfile,[b_or_z_mode/0,xtl_mode/0,get_local_state_for_operation_transition/3]).
896 execute_operation_by_predicate_in_state2(ConstantsState,InVariablesState,OpName,Predicate,
897 Operation,NormalisedOutVariablesState,PositionInfo) :-
898 b_or_z_mode, !,
899 b_get_machine_variables(Variables),
900 maplist(copy_binding_skel,InVariablesState,OutVariablesState),
901 copy_unmodified_variables(Variables,OpName,InVariablesState,OutVariablesState),
902 % format(' ** Copied for ~w: ~w~n',[OpName,OutVariablesState]),
903 init_wait_flags_with_call_stack(WF,[operation_call(OpName,ParamValues,PositionInfo)]),
904 add_prob_deferred_set_elements_to_store(ConstantsState,ConstantsState1,visible),
905 append(ConstantsState1,InVariablesState,In),
906 append(ConstantsState1,OutVariablesState,Out),
907 % for Event-B we have to add b_machine_temp_predicate
908 % b_execute_operation_with_parameters(Name,LocalState,InState,Results,Parameters,OutState,ParamValues,ResultValues,Path,Info,WF,OR)
909 b_execute_top_level_operation_wf(OpName,Operation,ParamValues,ResultValues,In,Out,_TransInfo,WF),
910 % format(' ** Exec for ~w (~w) --> ~w: ~w~n',[OpName,ParamValues,ResultValues,OutVariablesState]),
911 setup_local_state_for_operation(OpName,ParamValues,ResultValues,OpLocalState),
912 maplist(create_primed_binding,InVariablesState,PrimedVars),
913 append(PrimedVars,Out,PredState),
914 % format(' ** LS for ~w: ~w~n',[OpName,OpLocalState]),
915 % format(' ** PredState for ~w: ~w~n',[OpName,PredState]),
916 % print(predicate(Predicate)),nl,
917 b_test_boolean_expression(Predicate,OpLocalState,PredState,WF),
918 % print(grounding_waitflags),nl,
919 ground_wait_flags(WF),
920 normalise_store(OutVariablesState,NormalisedOutVariablesState).
921 execute_operation_by_predicate_in_state2([],State,OpName,Predicate,OpTerm,NewState,PosInfo) :-
922 xtl_execute_operation_by_predicate_in_state([],State,OpName,Predicate,OpTerm,NewState,PosInfo).
923
924 :- use_module(xtl_interface,[xtl_transition/3,xtl_transition_with_symbolic/3,xtl_transition_parameters/2]).
925 % special variant for XTL; allows to pass additional static bindings in addition to raw state (used by VisB)
926 xtl_execute_operation_by_predicate_in_state(ExtraBinds,RawState,OpName,Predicate,OpTerm,NewState,PosInfo) :-
927 xtl_mode, !,
928 (xtl_transition_parameters(OpName,ParaNames)
929 -> same_length(ParaNames,ParamValues) % registered OpName, set up uninstantiated OpTerm
930 ; xtl_transition(RawState,OpTerm,NewState)), % unregistered OpName, try to find a non-symbolic transition
931 init_wait_flags_with_call_stack(WF,[operation_call(OpName,ParamValues,PosInfo)]),
932 OpTerm =.. [OpName|ParamValues], % skeleton with uninstantiated parameter values
933 get_local_state_for_operation_transition(OpName,OpTerm,LocState),
934 maplist(to_term_binds_for_b_pred,LocState,TLocState),
935 append(TLocState,ExtraBinds,ETLocState),
936 b_test_boolean_expression(Predicate,ETLocState,NewState,WF), % instantiate parameters, FIXME: e.g. STATE_PROPERTY is evaluated in current state, not post state; use set_current_state_for_external_fun
937 xtl_transition_with_symbolic(RawState,OpTerm,NewState), % instantiated OpTerm, check if a matching transition exists
938 ground_wait_flags(WF).
939
940 to_term_binds_for_b_pred(bind(ID,Val),bind(ID,term(Val))). % for XTL we compare b(term(S),string,Infos) expressions
941
942 gen_bind(TID,Val,bind(ID,Val)) :- def_get_texpr_id(TID,ID).
943
944 :- use_module(probsrc(bmachine),[b_get_machine_operation_for_animation/4]).
945 % generate an environment where operation parameters and results are stored:
946 setup_local_state_for_operation(OpName,ParamValues,ResultValues,LocalState) :-
947 b_get_machine_operation_for_animation(OpName,Results,Parameters,_Body),
948 maplist(gen_bind,Parameters,ParamValues,ParamBindings),
949 maplist(gen_bind,Results,ResultValues,ResultBindings),
950 append(ResultBindings,ParamBindings,LocalState).
951
952
953 :- use_module(btypechecker,[prime_atom0/2]).
954 create_primed_binding(bind(ID,Val),bind(PID,Val)) :- prime_atom0(ID,PID).
955
956
957 % ------------------------------------
958
959 % Determinacy Check for Constants
960 % check if the values of the constants are forced to have one value
961
962 :- use_module(bsyntaxtree, [safe_create_texpr/3, get_texpr_id/2]).
963 cbc_constants_det_check(UseConstantsFromStateID) :-
964 cbc_constants_det_check(UseConstantsFromStateID,[print_explanation],_,_,_,_),
965 fail.
966 cbc_constants_det_check(_).
967
968 :- use_module(state_space,[is_concrete_constants_state_id/1]).
969 tcltk_cbc_constants_det_check(list([list(['CONSTANT','FORCED', 'VALUE', 'Explanation', 'Source']) | Res ])) :-
970 is_concrete_constants_state_id(StateID),!,
971 set_unicode_mode,
972 call_cleanup(
973 findall(list([ID,FS,VS,CoreStr,CoreSrc]),
974 (cbc_constants_det_check(StateID,[],ConstantID,Forced,ValStr,CorePred),
975 get_core_str(Nr,CorePred,CoreStr,CoreSrc),
976 (Nr=1 -> ID=ConstantID, VS = ValStr, FS = Forced ; ID = '', VS = '', FS = '')),
977 Res),
978 unset_unicode_mode).
979 tcltk_cbc_constants_det_check(list([list(['SETUP_CONSTANTS first'])])) :- b_machine_has_constants,!.
980 tcltk_cbc_constants_det_check(list([list(['MODEL HAS NO CONSTANTS'])])).
981
982 :- use_module(error_manager,[get_tk_table_position_info/2]).
983 :- use_module(bsyntaxtree,[conjunction_to_list/2, get_texpr_expr/2,get_texpr_id/2]).
984 get_core_str(Nr,CorePred,TS,Src) :-
985 (conjunction_to_list(CorePred,CL), CL \= [] -> true ; CL = [CorePred]),
986 nth1(Nr,CL,P),
987 get_preference(translation_limit_for_table_commands,Limit),
988 translate_bexpression_with_limit(P,Limit,TS),
989 get_tk_table_position_info(P,Src).
990
991 :- use_module(bsyntaxtree,[predicate_components/2]).
992 cbc_constants_det_check(UseConstantsFromStateID,Options,ConstantID,Forced,ValStr,CorePred) :-
993 % we need one solution to start from (TODO: we could look at all set_constant solutions found)
994 get_constants_state_for_id(UseConstantsFromStateID,UsedCState),
995 format('~nChecking if value of constants in state ~w are forced~n',[UseConstantsFromStateID]),
996
997 b_get_properties_from_machine(Properties),
998 b_get_machine_constants(Constants),
999 predicate_components(Properties,Components),
1000 nth1(Nr,Components,component(ComponentPred,CompIds)), % select component via backtracking
1001 CompIds \= [],
1002 format('Checking component ~w over identifiers ~w~n',[Nr,CompIds]),
1003
1004 empty_state(EmptyState),
1005 set_up_typed_localstate(Constants,_FreshVars1,TypedVals1,EmptyState,State1,positive),
1006 init_wait_flags_with_call_stack(WF,[prob_command_context(cbc_constants_det_check,unknown)]),
1007 empty_avl(Ai),
1008 b_test_boolean_expression(ComponentPred,[],State1,WF,Ai,A2), % A2 is used below for after state
1009 b_tighter_enumerate_all_values(TypedVals1,WF),
1010
1011 member(ConstantID,CompIds),
1012 member(bind(ConstantID,CVal),UsedCState),
1013 nl,
1014 member(TID,Constants), def_get_texpr_id(TID,ConstantID),
1015 get_texpr_type(TID,Type),
1016 safe_create_texpr(not_equal(TID,b(value(CVal),Type,[])),pred,NotEqual),
1017 (b_test_boolean_expression(NotEqual,[],State1,WF,A2,_),
1018 ground_wait_flags(WF)
1019 -> format_with_colour_nl(user_output,[green],'--- CONSTANT ~w can take on another value',[ConstantID]),
1020 Forced='FALSE', ValStr = '',
1021 CorePred = b(truth,pred,[])
1022 ; translate_bvalue_with_limit(CVal,50,ValStr),
1023 format_with_colour_nl(user_output,[blue],'*** CONSTANT ~w has the forced value ~w',[ConstantID,ValStr]),
1024 Forced='TRUE',
1025 (get_preference(cbc_provide_explanations,false)
1026 -> CorePred = b(unknown_truth_value(no_explanation_computed),pred,[])
1027 ; write('Generating explanation '),
1028 unsat_cores:unsat_chr_core_with_fixed_conjuncts_auto_time_limit(ComponentPred,NotEqual,1000,CorePred)
1029 -> (member(print_explanation,Options) -> translate:nested_print_bexpr_as_classicalb(CorePred) ; true)
1030 ; CorePred = b(unknown_truth_value(fail),pred,[])
1031 )
1032 ).
1033
1034
1035