1		% (c) 2009-2024 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2		% Heinrich Heine Universitaet Duesseldorf
3		% This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5		:- module(b_interpreter_eventb,
6		[ b_execute_event/7
7		, b_execute_event_with_change_set_wf/9
8		, b_event_constraints/7
9		]).
10
11		:- use_module(tools).
12		:- use_module(bsyntaxtree).
13		:- use_module(store).
14		:- use_module(bmachine).
15		:- use_module(kernel_objects).
16		:- use_module(error_manager).
17		:- use_module(kernel_waitflags).
18		:- use_module(b_enumerate).
19		:- use_module(state_space).
20
21		:- use_module(b_interpreter).
22
23		:- use_module(debug).
24
25		:- use_module(module_information,[module_info/2]).
26		:- module_info(group,interpreter).
27		:- module_info(description,'This is an Event-B specific part of the interpreter. It contains the interpreter rules for events (as opposed to operations in classical B.').
28
29		%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
30		% Event-B multilevel execution
31		%
32		% used shortcuts: IS=InState, OS=OutState, LS=LocalState
33
34		% execute an Event:
35		% difference with b_execute_event_with_change_set_wf : OutState already setup
36		% used for initialisation from b_interpreter
37		b_execute_event(Name,TBody,Parameters,NormalisedParaValues,InState,OutState,Path) :-
38		get_texpr_expr(TBody,Event),
39		init_wait_flags_with_call_stack(WF,[operation_call(Name,Parameters,unknown)]),
40		b_event_with_change_set_aux(Event,Parameters,NormalisedParaValues,InState,no_change_set_available,OutState,Path,WF),
41		ground_wait_flags(WF).
42
43
44		:- use_module(store,[copy_variable_store/4]).
45		% a version of b_event which gets the operation ChangeSet passed
46		b_execute_event_with_change_set_wf(TBody,Parameters,NormalisedParaValues,InState,ChangeSet,Updates,
47		Path,WF,_OutputReq) :-
48		get_texpr_expr(TBody,Event),
49		b_event_with_change_set_aux(Event,Parameters,NormalisedParaValues,InState,ChangeSet,Updates,Path,WF).
50
51		/* TO DO:
52		b_event_with_change_set_aux(lazy_let_subst(Id,IdExpr,TBody),Parameters,NormalisedParaValues,InState,ChangeSet,Updates,Path,WF) :- !,
53		add_lazy_let_id_and_expression(Id,IdExpr,LocalState,InState,NewLocalState,WF),
54		b_event_with_change_set(TBody,Parameters,NormalisedParaValues,InState,ChangeSet,Updates,Path,WF). */
55		b_event_with_change_set_aux(Event,Parameters,NormalisedParaValues,InState,ChangeSet,Updates,Path,WF) :-
56		extract_event(Event,Name,Section,Guard,PostCond),
57		setup_event_state(Parameters,ParaValues,NormalisedParaValues,ParamTypedVals,LS),
58		% evaluate the event's guard
59		evaluate_predicate_if_necessary(Guard,ParamTypedVals,LS,InState,WF),
60		% execute the event
61		init_trace_of_event(Name,Section,Parameters,ParaValues,Guard,Path,RestPath,Desc),
62		(ChangeSet==no_change_set_available -> OutState=Updates
63		; copy_variable_store(InState,ChangeSet,Updates,OutState)),
64		% post condition, mainly for trace replay of initialisation
65		b_test_boolean_expression(PostCond,LS,OutState,WF),
66		execute_event_body_wf(Event,InState,LS,OutState,RestPath,Desc,WF).
67
68		:- use_module(preferences,[get_preference/2]).
69		evaluate_predicate_if_necessary(Guard,ParamTypedVals,LS,InState,WF) :-
70		(ParamTypedVals==[], get_preference(ltsmin_do_not_evaluate_top_level_guards,full) ->
71		% if we already know that the event is enabled
72		% in the current state, we don't need to evaluate the guard here
73		debug_println(9,guard_will_not_be_evaluated_b_event)
74		;
75		enumerate_predicate_wf(Guard,ParamTypedVals,LS,InState,WF)
76		%evaluate_predicate(Guard,ParamTypedVals,LS,InState,event_guard)
77		).
78
79		% TO DO: add support for lazy_let_subst by calling add_lazy_let_id_and_expression
80		extract_event(Event,Name,Section,FullGuard,AdditionalPostCondition) :-
81		Event = rlevent(Name,Section,_Status,_Params,Guard,_Thms,_Actions,_VWitnesses,_PWitnesses,_Unmod,_AbstractEvents),
82		!,
83		extract_event_aux(Name,Guard,FullGuard,AdditionalPostCondition).
84		extract_event(Event,Name,Section,FullGuard,PostCond) :-
85		add_internal_error('Illegal Event-B Event: ',extract_event(Event,Name,Section,FullGuard,PostCond)),fail.
86
87		extract_event_aux('INITIALISATION',Guard,FullGuard,AdditionalPostCondition) :- !, FullGuard=Guard,
88		(bmachine:b_machine_temp_predicate(TempPred)
89		% The guard is evaluated on the state before ! It should be executed on the state after ! %% TO DO
90		-> AdditionalPostCondition = TempPred
91		; AdditionalPostCondition = b(truth,pred,[])).
92		extract_event_aux(_Name,Guard,FullGuard,b(truth,pred,[])) :-
93		% check for user-defined additional guard
94		full_guard(Guard,_,FullGuard).
95
96		full_guard(Guard,TempPred,FullGuard) :-
97		bmachine:b_machine_temp_predicate(TempPred),!,
98		conjunct_predicates([TempPred,Guard],FullGuard).
99		full_guard(Guard,b(truth,pred,[]),Guard).
100
101		setup_event_state(Parameters,ParaValues,NormalisedParaValues,ParamTypedVals,LS) :-
102		empty_state(EmptyState),
103		set_up_typed_localstate(Parameters,ParaValues,ParamTypedVals,EmptyState,LS,positive),
104		store:l_expand_and_normalise_values(ParaValues,NormalisedParaValues,Parameters).
105
106		init_trace_of_event(Name,Section,Parameters,ParaValues,FullGuard,[event(Path),eventtrace(Trace)],RestPath,D2) :-
107		Path = [event(Name,ParaValues)|RestPath],
108		eventtrace_init(Name,Desc,Trace),
109		eventtrace_add(event(Name,Section),Desc,D1),
110		eventtrace_add(true_guard(Parameters,ParaValues,FullGuard),D1,D2).
111
112
113		execute_event_body_wf(Event,InState,LS,OutState,AbstractPath,D,WF) :-
114		get_enumeration_finished_wait_flag(WF,WFE), % TO DO: pass WF instead and possibly to b_execute_eventb_actions
115		execute_event_body_block(WFE,Event,InState,LS,OutState,AbstractPath,D).
116		:- block execute_event_body_block(-,?,?,?,?,?,?).
117		execute_event_body_block(_,Event,InState,LS,OutState,AbstractPath,D) :-
118		execute_event_body(Event,InState,LS,OutState,AbstractPath,D).
119
120		execute_event_body(Event,InState,LS,OutState,AbstractPath,D) :-
121		Event = rlevent(Name,_Section,Status,_Params,_Guard,Theorems,
122		Actions,VWitnesses,PWitnesses,Unmodifiables,AbstractEvents),
123		% for convergent/anticipated events: check if the variant is non-negative
124		check_event_entry_status(Status,InState,LS,VariantValue,D,D2),
125		% check if the theorems hold
126		check_event_theorems(Theorems,Name,InState,LS,D2,D3),
127		% execute the actions
128		b_execute_eventb_actions(Actions,Name,InState,LS,OutState,D3,D4),
129		% for convergent/anticipated events: check if the variant has decreased/not increased
130		check_event_exit_status(VariantValue,Status,OutState,LS,D4,D5),
131		check_if_invalid_vars_are_modified(Unmodifiables,InState,OutState,D5),
132		go_for_abstract_events(Name,AbstractEvents,VWitnesses,PWitnesses,InState,LS,OutState,AbstractPath,D5).
133
134
135		go_for_abstract_events(_Name,[],_VWit,_PWit,_IS,_LS,_OS,[],D) :-
136		% no more refined level exists, stop here
137		!, eventtrace_finalise(D,_).
138		go_for_abstract_events(_Name,AbstractEvents,[],[],IS,LS,OS,AbstractPath,Din) :-
139		!, % optimisation: If no witness has to be evaluated, do not copy primed variables
140		execute_abstract_events(AbstractEvents,[],[],IS,LS,OS,AbstractPath,Din).
141		go_for_abstract_events(Name,AbstractEvents,VWitnesses,PWitnesses,IS,LS,OS,AbstractPath,Din) :-
142		% copy a primed version of all values in the outstate into the local state
143		copy_primed(OS,LS,NewLS),
144		% evaluate witnesses for dropped abstract vars
145		evaluate_witnesses_for_abstract_vars(VWitnesses,Name,IS,NewLS,OS,Din,D1),
146		% evaluate witnesses for dropped parameters
147		evaluate_witnesses_for_abstract_parameters(PWitnesses,Name,IS,NewLS,AbsLS,Params,PValues,D1,D2),
148		% continue with the next refinement level
149		execute_abstract_events(AbstractEvents,Params,PValues,IS,AbsLS,OS,AbstractPath,D2).
150
151		check_event_entry_status(TStatus,IS,LS,VariantValue,Din,Dout) :-
152		get_texpr_expr(TStatus,Status),
153		check_event_entry_status2(Status,IS,LS,VariantValue,Din,Dout).
154		check_event_entry_status2(ordinary,_IS,_LS,-,D,D).
155		check_event_entry_status2(anticipated(Variant),IS,LS,Val,Din,Dout) :-
156		variant_is_not_negative(Variant,anticipated,IS,LS,Val,Din,Dout).
157		check_event_entry_status2(convergent(Variant),IS,LS,Val,Din,Dout) :-
158		variant_is_not_negative(Variant,convergent,IS,LS,Val,Din,Dout).
159		variant_is_not_negative(Variant,_CType,IS,LS,Value,Din,Dout) :-
160		get_texpr_type(Variant, set(_)),!,
161		% if variant is of type set, it cannot be negative
162		% nevertheless, we compute its value here to check later if the set has been decreased
163		if( b_compute_expression_nowf(Variant,LS,IS,Value,'variant (set)',0),
164		% Daniel: why are LS & IS swapped ?
165		Din=Dout,
166		eventtrace_store_event_error(event_wd_error(Variant,variant),Din,Dout)).
167		variant_is_not_negative(Variant,CType,IS,LS,Value,Din,Dout) :-
168		if( b_compute_expression_nowf(Variant,LS,IS,Value,'variant (not negative check)',0),
169		% Daniel: why are LS & IS swapped ?
170		( less_than(Value, int(0)) ->
171		eventtrace_store_event_error(variant_negative(CType,Variant,Value),Din,Dout)
172		; eventtrace_add(variant_checked_pre(CType,Variant,Value),Din,Dout)),
173		eventtrace_store_event_error(event_wd_error(Variant,variant),Din,Dout)).
174
175
176		check_event_exit_status(-,_TStatus,_OS,_LS,D,D) :- !.
177		check_event_exit_status(EntryValue,TStatus,OS,LS,Din,Dout) :-
178		get_texpr_expr(TStatus,Status),
179		% Status is convergent(VariantExpr) or anticipated(VariantExpr)
180		functor(Status,CType,1),arg(1,Status,VariantExpr),
181		get_texpr_type(VariantExpr,Type),
182		if( b_compute_expression_nowf(VariantExpr,LS,OS,ExitValue,'variant (exit)',0),
183		( variant_condition(CType,Type,EntryValue,ExitValue) ->
184		eventtrace_add(variant_checked_post(CType,VariantExpr,EntryValue,ExitValue),Din,Dout)
185		;
186		eventtrace_store_event_error(invalid_variant(CType,VariantExpr,EntryValue,ExitValue),Din,Dout)),
187		eventtrace_store_event_error(event_wd_error(VariantExpr,variant_after_event),Din,Dout)).
188
189
190		variant_condition(anticipated, integer, Pre, Post) :- !, less_than_equal(Post,Pre).
191		variant_condition(anticipated, set(_), Pre, Post) :- !, check_subset_of(Post,Pre).
192		variant_condition(convergent, integer, Pre, Post) :- !, less_than(Post,Pre).
193		variant_condition(convergent, set(_), Pre, Post) :- !, strict_subset_of(Post,Pre).
194
195		check_event_theorems([],_Name,_State,_LState,D,D).
196		check_event_theorems([Theorem|Trest],Name,State,LState,Din,Dout) :-
197		check_event_theorem(Theorem,Name,State,LState,Din,Dinter),
198		check_event_theorems(Trest,Name,State,LState,Dinter,Dout).
199		check_event_theorem(Theorem,Name,State,LState,Din,Dout) :-
200		( evaluate_predicate(Theorem,[],LState,State,event_theorem(Name)) ->
201		Din = Dout
202		%eventtrace_add(theorem_checked(Theorem),Din,Dout)
203		;
204		eventtrace_store_event_error(invalid_theorem_in_guard(Theorem),Din,Dout)
205		).
206
207		% check if variables that are not modified by an abstract event or newly introduced into
208		% the current refinement level are modified.
209		check_if_invalid_vars_are_modified([],_IS,_OS,_D).
210		check_if_invalid_vars_are_modified([Unmod|UnmodRest],IS,OS,D) :-
211		check_unmodifiable(Unmod,IS,OS,D),
212		check_if_invalid_vars_are_modified(UnmodRest,IS,OS,D).
213		check_unmodifiable(Var,IS,OS,D) :-
214		def_get_texpr_id(Var,Id),
215		lookup_value(Id,IS,Pre),!,
216		lookup_value(Id,OS,Post),!,
217		(equal_object(Pre,Post) -> true ; eventtrace_failure(invalid_modification(Var,Pre,Post),D)).
218
219		evaluate_witnesses_for_abstract_parameters(Witnesses,Name,IS,LS,AbsLS,Params,PValues,Din,Dout) :-
220		evaluate_witnesses_for_abstract_parameters2(Witnesses,Name,IS,LS,LS,AbsLS,Params,PValues,Din,Dout).
221		evaluate_witnesses_for_abstract_parameters2([],_Name,_State,_OrigLS,LS,LS,[],[],D,D).
222		evaluate_witnesses_for_abstract_parameters2([Witness|WRest],Name,State,OrigLS,LS,AbsLS,
223		[TId|Params],[Value|PValues],Din,Dout) :-
224		witness_substate(Witness,OrigLS,LS,TId,Value,Predicate,TypedVals,WitnessLS,ExtLS),
225		if( evaluate_predicate(Predicate,TypedVals,WitnessLS,State,event_parameter_witness(Name)),
226		( eventtrace_add(eval_witness(parameter,TId,Value,Predicate),Din,D1),
227		evaluate_witnesses_for_abstract_parameters2(WRest,Name,State,OrigLS,ExtLS,AbsLS,Params,PValues,D1,Dout)),
228		eventtrace_failure(no_witness_found(parameter,TId,Predicate), Din) ).
229
230		witness_substate(Witness,OrigLS,LS,TId,Value,Predicate,TypedVals,WitnessLS,ExtLS) :-
231		extract_witness(Witness,TId,Id,_Type,Predicate),
232		set_up_typed_localstate([TId],[Value],TypedVals,LS,ExtLS,positive),
233		add_var_to_localstate(Id,Value,OrigLS,WitnessLS).
234
235		extract_witness(Witness,TId,Id,Type,Predicate) :-
236		get_texpr_expr(Witness,witness(TId,Predicate)),
237		def_get_texpr_id(TId,Id),
238		get_texpr_type(TId,Type).
239
240		eventtrace_init(EventName, desc(EventName,D,D), D).
241		eventtrace_add( Entry, desc(EN,D,[Entry|L]), desc(EN,D,L) ).
242		eventtrace_name( desc(EN,_,_), EN).
243		eventtrace_finalise(desc(_EN,D,[]),D).
244		eventtrace_store_event_error(Error,Din,Dout) :-
245		eventtrace_name(Din, EventName),
246		copy_term(Din,Dcopy),
247		eventtrace_add(Error,Dcopy,Dc1),
248		eventtrace_finalise(Dc1,D),
249		store_error_for_context_state(eventerror(EventName,Error,D),Id),
250		eventtrace_add(error(Error,Id),Din,Dout).
251		eventtrace_failure(Error,Desc) :-
252		eventtrace_name(Desc,EventName),
253		eventtrace_add(Error,Desc,D1),
254		eventtrace_finalise(D1,D),
255		%translate:explain_state_error(eventerror(EventName,Error,D),unknown,Out), format(user_error,'~s~n',[Out]),
256		store_error_for_context_state(eventerror(EventName,Error,D),_Id),
257		fail.
258
259		evaluate_predicate(Predicate,TypedVals,LS,State,Context) :-
260		init_wait_flags_with_call_stack(WF,[prob_command_context(Context,unknown)]),
261		enumerate_predicate_wf(Predicate,TypedVals,LS,State,WF),
262		ground_wait_flags(WF).
263
264		enumerate_predicate_wf(Predicate,TypedVals,LS,State,WF) :-
265		b_test_boolean_expression(Predicate,LS,State,WF),
266		b_tighter_enumerate_values_in_ctxt(TypedVals,Predicate,WF). % moved this later for performance, see PerformanceTests/ParameterEnumeration_mch.eventb
267
268		execute_abstract_events(Events,Params,PValues,IS,LS,OS,[event(Name,PValues)|Path],Din) :-
269		if( select_event(Events,Params,PValues,IS,LS,Event,Name,Din,D1),
270		execute_event_body(Event,IS,LS,OS,Path,D1),
271		( generate_simulation_error(Events,Error), eventtrace_failure(Error,Din) )).
272
273		generate_simulation_error(Events,simulation_error(FailedEvents)) :-
274		generate_simulation_error2(Events,FailedEvents).
275		generate_simulation_error2([],[]).
276		generate_simulation_error2([TEvent|Erest],[event(Name,Section,Guard)|Srest]) :-
277		get_texpr_expr(TEvent,Event),
278		Event = rlevent(Name,Section,_Status,_Params,Guard,_Thms,_Actions,_VWitnesses,_PWitnesses,_Unmodifiables,_AbstractEvents),
279		generate_simulation_error2(Erest,Srest).
280
281		select_event(Events,Params,PValues,IS,LS,Event,Name,Din,Dout) :-
282		member(TEvent,Events),
283		get_texpr_expr(TEvent,Event),
284		Event = rlevent(Name,Section,_Status,_Params,Guard,_Thms,_Act,_VWit,_PWit,_Unmod,_Evt),
285		b_test_boolean_expression_cs(Guard,LS,IS,'event guard',Name),
286		eventtrace_add(event(Name,Section),Din,D1),
287		eventtrace_add(true_guard(Params,PValues,Guard),D1,Dout).
288
289		evaluate_witnesses_for_abstract_vars([],_Name,_IS,_LS,_OS,D,D).
290		evaluate_witnesses_for_abstract_vars([Witness|WRest],Name,IS,LS,OS,Din,Dout) :-
291		extract_witness(Witness,TId,Id,Type,Predicate),
292		if( (init_wait_flags_with_call_stack(WF,[prob_command_context(event_abstract_variable_witness(Name),unknown)]),
293		b_enumerate_values_in_store([Id],[Type],[Value],LS,WF),
294		b_test_boolean_expression(Predicate,LS,IS,WF),
295		ground_wait_flags(WF)),
296		( eventtrace_add(eval_witness(variable,TId,Value,Predicate),Din,D1),
297		evaluate_witnesses_for_abstract_vars(WRest,Name,IS,LS,OS,D1,Dout)),
298		eventtrace_failure(no_witness_found(variable,TId,Predicate),Din) ).
299
300		b_execute_eventb_actions([],_Name,_IS,_LS,_OS,D,D).
301		b_execute_eventb_actions([TAction|ARest],Name,IS,LS,OS,Din,Dout) :-
302		get_texpr_expr(TAction,Action),
303		(get_texpr_pos(TAction,Pos) -> true ; Pos=unknown),
304		if( ( init_wait_flags_with_call_stack(WF,[b_operator_call(Name,LS,Pos)]),
305		b_execute_eventb_action(Action,IS,LS,OS,WF,Step),
306		ground_wait_flags(WF)),
307		( eventtrace_add(Step,Din,D1),
308		b_execute_eventb_actions(ARest,Name,IS,LS,OS,D1,Dout)),
309		((abort_error_occured_in_error_scope,
310		\+ always_well_defined(TAction) % all actions are evaluated in the same error scope; just check
311		-> WDERR=wd_error_possible; WDERR=no_wd_error),
312		eventtrace_failure(action_not_executable(TAction,WDERR),Din))).
313		%get_assigned_vars(TAction,Assigned) :-
314		% get_texpr_info(TAction,Info),
315		% member(assigned_after(Assigned),Info),!.
316		b_execute_eventb_action(assign(Lhs,Exprs),IS,LS,OS,WF,Step) :- !,
317		b_interpreter:b_compute_expressions(Exprs,LS,IS,VALs,WF), % VALs - a list of computed values
318		b_interpreter:b_assign_values_or_functions(Lhs,VALs,LS,IS,NewValues,WF,output_required),
319		eventb_store_new_values(NewValues,OS),
320		Step = action(Lhs,Exprs,VALs).
321		b_execute_eventb_action(becomes_element_of(Lhs,Rhs),IS,LS,OS,WF,Step) :- !,
322		convert_pairs_into_list(Lhs,Val,ValList), % EventB/Rodin seems to allow only a single id here
323		get_texpr_types(Lhs,Types),
324		b_compute_expression(Rhs,LS,IS,ValueSet,WF),
325		check_element_of_wf(Val,ValueSet,WF),
326		b_enumerate_typed_values(ValList,Types,WF),
327		% ground_det_wait_flag(WF),
328		b_interpreter:b_assign_values_or_functions(Lhs,ValList,LS,IS,NewValues,WF,output_required),
329		eventb_store_new_values(NewValues,OS),
330		Step = action_set(Lhs,Rhs,ValueSet,ValList).
331		b_execute_eventb_action(becomes_such(Ids,Pred),IS,LS,OS,WF,Step) :- !,
332		Info=[],
333		b_interpreter:b_execute_becomes_such(Ids,Pred,Info,LS,IS,OutputValues,IdsValues,_Path,WF),
334		eventb_store_new_values(OutputValues,OS),
335		Step = action_pred(Ids,Pred,IdsValues).
336		b_execute_eventb_action(Action,IS,LS,OS,WF,Step) :-
337		add_internal_error('Unknown Event-B action: ',b_execute_eventb_action(Action,IS,LS,OS,WF,Step)),fail.
338		%b_execute_eventb_action(evb2_becomes_such(Ids,Pred),IS,LS,OS,WF,Step) :- % is now translated to becomes_such
339		% add_primed_vars(Ids,OS,LS,NewLS,TypedVals,Values),
340		% b_tighter_enumerate_all_values(TypedVals,WF),b_test_boolean_expression(Pred,NewLS,IS,WF),
341		% Step = action_pred(Ids,Pred,Values).
342
343		%primed vars always trigger an enum warning
344		%this might be split up depending on where they are introduced
345		%add_primed_vars([],_State,LS,LS,[],[]).
346		%add_primed_vars([TId|IRest],State,In,Out,[typedval(Value,Type,Id,trigger_true(Primed))|TypeValRest],[Value|Vrest]) :-
347		% def_get_texpr_id(TId,Id), get_texpr_type(TId,Type),
348		% lookup_value(Id,State,Value),
349		% atom_concat(Id,'\'',Primed),
350		% add_var_to_localstate(Primed,Value,In,Inter),
351		% add_primed_vars(IRest,State,Inter,Out,TypeValRest,Vrest).
352
353		eventb_store_new_values([],_Store).
354		eventb_store_new_values([bind(Id,Value)|IRest],Store) :-
355		(lookup_value(Id,Store,Res) -> StoreValue=Res
356		; add_internal_error('Cannot find Event-B identifier:',Id:Store),fail),
357		equal_object(StoreValue,Value),
358		eventb_store_new_values(IRest,Store).
359
360
361		% copy_primed(+Store, +InStore, -OutStore)
362		% copies and primes all variables from Store
363		% TO DO: maybe only copy those that are really used as primed variables in witnesses,...
364		copy_primed([], InStore, InStore).
365		copy_primed([bind(OldVar,Value)|Srest], InStore, OutStore) :-
366		atom_concat(OldVar,'\'',NewVar), % is faster than caching this using a dynamic fact
367		copy_primed(Srest,[bind(NewVar,Value)|InStore], OutStore).
368
369		%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
370		% Multilevel-animation: Version that is intended to set up constraints
371		% between two states and not to find errors in one event
372
373		% part below only used for cbc/state_model_check
374
375		b_event_constraints(TBody,Parameters,NormalisedParaValues,IS,OS,Path,WF) :-
376		get_texpr_expr(TBody,Event),
377		b_event_constraints_aux(Event,Parameters,NormalisedParaValues,IS,OS,Path,WF).
378
379		b_event_constraints_aux(Event,Parameters,NormalisedParaValues,IS,OS,Path,WF) :-
380		extract_event(Event,Name,Section,Guard,Post),
381		(is_truth(Post) -> true
382		; add_error_wf(b_event_constraints,'Ignoring additional post condition: ',Post,Post,WF)),
383		setup_event_state(Parameters,ParaValues,NormalisedParaValues,ParamTypedVals,LS),
384		% evaluate guard
385		enumerate_predicate_wf(Guard,ParamTypedVals,LS,IS,WF),
386		% execute the event
387		init_trace_of_event(Name,Section,Parameters,ParaValues,Guard,Path,RestPath,Desc),
388		RestPath = [],
389		event_body_constraints(Event,IS,LS,OS,Desc,WF).
390
391		event_body_constraints(Event,IS,LS,OS,D,WF) :-
392		Event = rlevent(_Name,_Section,_Status,_Params,_Guard,_Thms,Actions,VWitnesses,PWitnesses,_Unmodifiables,AbstractEvents),
393		% for convergent/anticipated events: check if the variant is non-negative
394		% check_event_entry_status(Status,IS,LS,VariantValue,D,D2),
395		eventb_actions_constraints(Actions,IS,LS,OS,D,D2,WF),
396		% for convergent/anticipated events: check if the variant has decreased/not increased
397		% check_event_exit_status(VariantValue,Status,OS,LS,D3,D4),
398		% check_if_invalid_vars_are_modified(Unmodifiables,IS,OS,D4),
399		abstract_event_constraints(AbstractEvents,VWitnesses,PWitnesses,IS,LS,OS,D2,WF).
400
401		eventb_actions_constraints([],_IS,_LS,_OS,D,D,_WF).
402		eventb_actions_constraints([TAction|ARest],IS,LS,OS,Din,Dout,WF) :-
403		get_texpr_expr(TAction,Action),
404		b_execute_eventb_action(Action,IS,LS,OS,WF,Step),
405		eventtrace_add(Step,Din,D1),
406		eventb_actions_constraints(ARest,IS,LS,OS,D1,Dout,WF).
407
408		abstract_event_constraints([],_VWit,_PWit,_IS,_LS,_OS,D,_WF) :-
409		% no more refined level exists, stop here
410		!, eventtrace_finalise(D,_).
411		abstract_event_constraints(AbstractEvents,VWitnesses,PWitnesses,IS,LS,OS,Din,WF) :-
412		% copy a primed version of all values in the outstate
413		% into the local state
414		copy_primed(OS,LS,NewLS),
415		% evaluate witnesses for dropped abstract vars
416		abstract_var_witnesses_constraints(VWitnesses,IS,NewLS,OS,Din,D1,WF),
417		% evaluate witnesses for dropped parameters
418		abstract_parameter_witnesses_constraints(PWitnesses,IS,NewLS,AbsLS,_Params,_PValues,D1,D2,WF),
419		% continue with the next refinement level
420		execute_abstract_events_with_constraints(AbstractEvents,IS,AbsLS,OS,D2,WF).
421
422		abstract_var_witnesses_constraints([],_IS,_LS,_OS,D,D,_WF).
423		abstract_var_witnesses_constraints([Witness|WRest],IS,LS,OS,Din,Dout,WF) :-
424		extract_witness(Witness,TId,Id,Type,Predicate),
425		b_enumerate_values_in_store([Id],[Type],[Value],LS,WF),
426		b_test_boolean_expression(Predicate,LS,IS,WF),
427		eventtrace_add(eval_witness(variable,TId,Value,Predicate),Din,D1),
428		abstract_var_witnesses_constraints(WRest,IS,LS,OS,D1,Dout,WF).
429
430		abstract_parameter_witnesses_constraints(Witnesses,IS,LS,AbsLS,Params,PValues,Din,Dout,WF) :-
431		abstract_parameter_witnesses_constraints2(Witnesses,IS,LS,LS,AbsLS,Params,PValues,Din,Dout,WF).
432		abstract_parameter_witnesses_constraints2([],_State,_OrigLS,LS,LS,[],[],D,D,_WF).
433		abstract_parameter_witnesses_constraints2([Witness|WRest],State,OrigLS,LS,AbsLS,[TId|Params],[Value|PValues],Din,Dout,WF) :-
434		witness_substate(Witness,OrigLS,LS,TId,Value,Predicate,TypedVals,WitnessLS,ExtLS),
435		enumerate_predicate_wf(Predicate,TypedVals,WitnessLS,State,WF),
436		eventtrace_add(eval_witness(parameter,TId,Value,Predicate),Din,D1),
437		abstract_parameter_witnesses_constraints2(WRest,State,OrigLS,ExtLS,AbsLS,Params,PValues,D1,Dout,WF).
438
439		execute_abstract_events_with_constraints(AbstractEvents,IS,LS,OS,D,WF) :-
440		% This introduces a choicepoint when there are more than one abstract event.
441		% But the usual case is just one abstract event
442		member(TEvent,AbstractEvents),
443		get_texpr_expr(TEvent,Event),
444		event_body_constraints(Event,IS,LS,OS,D,WF).