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(state_space,
6		[get_state_space_stats/3, get_state_space_stats/4,
7		gen_new_state_id/1,
8		history/1, forward_history/1,
9		get_action_trace/1, % old trace/1
10		get_action_trace_with_limit/2,
11		get_action_term_trace/1,
12		op_trace_ids/1, add_to_op_trace_ids/1, remove_from_op_trace_ids/1, reset_op_trace_ids/0,
13		get_state_id_trace/1,
14		current_state_id/1, current_expression/2,
15		set_current_state_id/1,
16		current_options/1, set_current_options/1,
17		get_current_predecessor_state_id/1,
18
19		add_id_at_front/1, add_id_at_end/1,
20		add_id_random/1, /* from state_space_open_nodes_c */
21		add_id_with_weight/2, add_id_to_process/3,
22		pop_id_from_front/1, pop_id_from_end/1, pop_id_oldest/1,
23		retract_open_node/1, open_ids_empty/0,
24		top_front_id/1, top_front_weight/1,
25
26		visited_expression/3, visited_expression/2, visited_expression_id/1,
27		find_hashed_packed_visited_expression/3,
28		retract_visited_expression/2,
29		not_all_transitions_added/1,
30		not_invariant_checked/1, set_invariant_checked/1,
31		invariant_not_yet_checked/1, invariant_still_to_be_checked/1,
32		not_interesting/1, % nodes ignored because they do not satisfy a user-provided scope predicate
33		mark_as_not_interesting/1,
34		max_reached_for_node/1,
35		max_reached_or_timeout_for_node/1,
36		use_no_timeout/1, time_out_for_node/1, time_out_for_node/3,
37		hash_to_id/2,id_to_marker/2, hash_to_nauty_id/2,
38		invariant_violated/1, time_out_for_invariant/1, time_out_for_assertions/1,
39		set_invariant_violated/1,
40
41		state_error_exists/0, state_error/3, store_state_error/3,
42		set_context_state/1, set_context_state/2,
43		update_context_state/1, clear_context_state/0, get_current_context_state/1,
44		store_error_for_context_state/2,
45		copy_current_errors_to_state/2,
46		store_abort_error_for_context_state_if_possible/4,
47		abort_error_exists_in_context_state/1,
48
49		transition/3,transition/4, any_transition/3,
50		store_transition/4,
51		deadlocked_state/1, % no outgoing edge
52		is_initial_state_id/1, is_concrete_constants_state_id/1,
53		multiple_concrete_constants_exist/0,
54		get_constants_state_for_id/2, get_constants_state_id_for_id/2,
55		try_get_unique_constants_state/1,
56		get_constants_id_for_state_id/2,
57		get_variables_state_for_id/2,
58		out_degree/2,
59		operation_not_yet_covered/1, operation_name_not_yet_covered/1,
60		get_operation_name_coverage_infos/4,
61		mark_operation_as_covered/1,
62		initialise_operation_not_yet_covered/0,
63
64		transition_info/2, store_transition_infos/2,
65		keep_transition_info/1,
66		compute_transitions_if_necessary/1,
67
68		state_space_initialise/0, state_space_initialise_with_stats/0,
69		state_space_reset/0,
70		state_space_add/2, state_space_packed_add/2,
71		delete_node/1,
72
73		current_state_corresponds_to_initialised_b_machine/0,
74		current_state_corresponds_to_fully_setup_b_machine/0,
75		current_state_corresponds_to_setup_constants_b_machine/0,
76		visited_state_corresponds_to_initialised_b_machine/1,
77		visited_state_corresponds_to_setup_constants_b_machine/1,
78
79		specialized_inv/2, %reuse_operation/4,
80		assert_max_reached_for_node/1, assert_time_out_for_node/3,
81		assert_time_out_for_invariant/1, assert_time_out_for_assertions/1,
82
83		set_max_nr_of_new_impl_trans_nodes/1,
84		get_max_nr_of_new_impl_trans_nodes/1,
85		impl_trans_term/3, impl_trans_term_all/2,
86		impl_trans_id/4,
87		compute_transitions_if_necessary_saved/1,
88		max_nr_of_new_nodes_limit_not_reached/0,
89
90		find_trace_to_initial_state/2, find_initialised_states/1,
91
92		tcltk_save_state_space/1, tcltk_load_state/1,
93		compute_full_state_space_hash/1,
94
95		execute_id_trace_from_current/3,
96		set_trace_by_transition_ids/1, try_set_trace_by_transition_ids/1,
97		extend_trace_by_transition_ids/1,
98		extract_term_trace_from_transition_ids/2,
99
100		add_counterexample_node/1, add_counterexample_op/1,
101		reset_counterexample/0, set_counterexample_by_transition_ids/1,
102		counterexample_node/1, counterexample_op/1 % specific predicates to register counter examples
103		]).
104
105		:- use_module(library(lists)).
106
107		:- use_module(self_check).
108		:- use_module(error_manager).
109		:- use_module(gensym).
110		:- use_module(preferences).
111		:- use_module(tools).
112		%:- use_module(state_space_exploration_modes,[compute_hash/3]).
113
114		:- use_module(extension('counter/counter'),
115		[counter_init/0, new_counter/1, get_counter/2, inc_counter/1, inc_counter/2, inc_counter_by/2, reset_counter/1, set_counter/2]).
116
117		:- use_module(module_information).
118		:- module_info(group,state_space).
119		:- module_info(description,'This module keeps track of the visited states by the animator/model checker.').
120
121		% ----------------------------------
122
123		:- load_files(library(system), [when(compile_time), imports([environ/2])]).
124		:- if((environ(prob_myheap,false) ; \+ predicate_property(load_foreign_resource(_), _))).
125		:- use_module(state_space_open_nodes). %% comment in to use only Prolog datastructures
126		:- else.
127		:- use_module(state_space_open_nodes_c). %% comment in to use C++ multimap queue; can make use of HEURISTIC_FUNCTION
128		:- endif.
129
130		% ----------------------------------
131
132		get_state_space_stats(NrNodes,NrTransitions,ProcessedNodes) :-
133		get_counter(states,N), NrNodes is N+1,
134		get_counter(transitions,NrTransitions),
135		get_counter(processed_nodes,ProcessedNodes).
136
137		get_state_space_stats(NrNodes,NrTransitions,ProcessedNodes,IgnoredNodes) :-
138		get_state_space_stats(NrNodes,NrTransitions,ProcessedNodes),
139		get_counter(not_interesting_nodes,IgnoredNodes).
140
141		gen_new_state_id(Nr) :-
142		inc_counter(states,N1), Nr is N1-1. % only one C call
143		%get_counter(states,Nr), inc_counter(states).
144		reset_state_counter :- reset_counter(states).
145		reset_state_counter(Nr) :- set_counter(states,Nr).
146
147		get_state_id_trace(StateIds) :-
148		history(History),
149		current_state_id(CurID),
150		reverse([CurID|History],StateIds).
151
152		get_current_predecessor_state_id(PriorID) :-
153		history([PriorID|_]).
154
155		:- dynamic history/1.
156		history([]).
157
158
159		:- dynamic forward_history/1.
160
161		:- dynamic current_state_id/1.
162		current_state_id(root).
163		/* INITIAL STATE, third arg: clp(fd) constraints as generated
164		by fd_copy_term */
165
166		current_expression(ID,State) :- current_state_id(ID),
167		visited_expression(ID,State).
168		current_packed_expression(ID,State) :- current_state_id(ID),
169		packed_visited_expression(ID,State).
170
171		:- use_module(specfile,[state_corresponds_to_initialised_b_machine/1,
172		state_corresponds_to_fully_setup_b_machine/1,
173		state_corresponds_to_set_up_constants/1]).
174		current_state_corresponds_to_initialised_b_machine :-
175		current_packed_expression(_,PS), unpack_state_top_level(PS,TLState),
176		state_corresponds_to_initialised_b_machine(TLState).
177		visited_state_corresponds_to_initialised_b_machine(ID) :-
178		packed_visited_expression(ID,PS), unpack_state_top_level(PS,TLState),
179		state_corresponds_to_initialised_b_machine(TLState).
180
181		current_state_corresponds_to_fully_setup_b_machine :-
182		current_packed_expression(_,PS), unpack_state_top_level(PS,TLState),
183		state_corresponds_to_fully_setup_b_machine(TLState).
184
185		current_state_corresponds_to_setup_constants_b_machine :-
186		current_packed_expression(_,PS), unpack_state_top_level(PS,TLState),
187		state_corresponds_to_set_up_constants(TLState).
188
189		visited_state_corresponds_to_setup_constants_b_machine(ID) :-
190		packed_visited_expression(ID,PS), unpack_state_top_level(PS,TLState),
191		state_corresponds_to_set_up_constants(TLState).
192
193		:- dynamic current_options/1.
194		current_options([]).
195
196		set_current_options(Options) :-
197		retractall( current_options(_) ),
198		assertz( current_options(Options) ).
199
200		:- dynamic packed_visited_expression/2.
201		%packed_visited_expression(v_0,true).
202
203		:- use_module(state_packing).
204
205		retract_visited_expression(ID,State) :- retract(packed_visited_expression(ID,PState)),
206		unpack_state(PState,State).
207
208		retractall_visited_expression(ID) :- retractall(packed_visited_expression(ID,_)).
209
210		state_space_packed_add(Id,PackedTerm) :- assertz(packed_visited_expression(Id,PackedTerm)).
211
212		state_space_add(Id,Term) :-
213		(pack_state(Term,PackedTerm) -> assertz(packed_visited_expression(Id,PackedTerm))
214		; add_internal_error('State packing failed: ',pack_state(Term,_)),
215		assertz(packed_visited_expression(Id,Term))).
216
217		% deprecated:
218		visited_expression(ID,State,true) :- visited_expression(ID,State).
219		% not call(CurBody); for the moment we always have true as last argument
220
221	?	visited_expression(A,B) :- packed_visited_expression(A,PB),
222		(unpack_state(PB,R) -> B=R ; add_internal_error('Unpacking state failed: ',unpack_state(PB,R)),R=A).
223
224		%visited_expression_id(A) :- packed_visited_expression(A,_). % avoid unpacking state
225		% even better: not to look up fact at all to avoid constructing state term, this is done below:
226		:- use_module(library(between),[between/3]).
227		visited_expression_id(ID) :- number(ID),!, ID>=0, get_counter(states,N), ID<N.
228		visited_expression_id(ID) :- ID==root,!.
229		visited_expression_id(root).
230	?	visited_expression_id(Nr) :- Nr \== root, get_counter(states,N), N1 is N-1, between(0,N1,Nr).
231
232		% given a hash and a packed state: find ID (fail if does not exist)
233		find_hashed_packed_visited_expression(Hash,PackedState,ID) :-
234		hash_to_id(Hash,ID),
235		(packed_visited_expression(ID,PackedState)
236		-> true /* warning: may instantiate State if not ground */
237		; print(hash_collision(Hash,ID)),nl,fail
238		).
239
240
241		:- dynamic not_invariant_checked/1.
242		set_invariant_checked(ID) :- %print(inv_checked(ID)),nl,
243		retract(not_invariant_checked(ID)).
244
245		invariant_not_yet_checked(ID) :-
246		not_all_transitions_added(ID) ; /* assumption: if not all transitions added then we haven't checked invariant yet */
247		not_invariant_checked(ID) ;
248		not_interesting(ID). % assumption: if a node is marked as not interesting it will not be examined
249
250		% difference with invariant_not_yet_checked: not interesting nodes not reported and cannot be backtracked
251		invariant_still_to_be_checked(ID) :-
252		(not_all_transitions_added(ID) -> true ; not_invariant_checked(ID) -> true).
253
254		:- dynamic not_interesting/1.
255		%not_interesting(v_0).
256
257		:- dynamic max_reached_for_node/1.
258		/* true if not all outgoing transistions were computed due to the limit
259		on the number of operations/initialisations computed */
260		:- dynamic time_out_for_node/3, use_no_timeout/1, time_out_for_invariant/1, time_out_for_assertions/1.
261
262		time_out_for_node(ID) :- (var(ID) -> visited_expression_id(ID) ; true),
263		(time_out_for_node(ID,_,_) -> true ; fail).
264
265		:- dynamic transition/4.
266		%transition(v_0,a,1,v_1).
267
268		store_transition(Org,Action,Dest,Id) :-
269		%get_counter(transitions,Id), inc_counter(transitions),
270		inc_counter(transitions,Id1), Id is Id1-1, % only one C call
271		assertz(transition(Org,Action,Id,Dest)).
272
273	?	deadlocked_state(Origin) :- \+ any_transition(Origin,_,_).
274
275		is_concrete_constants_state_id(ID) :-
276	?	transition(root,_,ID),
277		packed_visited_expression(ID,concrete_constants(_)).
278
279		% check if we have multiple constant setups
280		multiple_concrete_constants_exist :-
281	?	is_concrete_constants_state_id(ID),
282	?	is_concrete_constants_state_id(ID2), ID2 \= ID,!.
283
284
285		is_initial_state_id(InitialStateID) :-
286		transition(root,_,State),
287		packed_visited_expression(State,P),
288		(P = concrete_constants(_) % also covers '$partial_setup_constants'
289		-> state_space:transition(State,_,InitialStateID)
290		; InitialStateID=State).
291
292		% get the constants for a state (if there are constants)
293		get_constants_state_for_id(ID,ConstantsState) :-
294		visited_expression(ID,State), % TO DO: use packed_visited_expression for performance
295		get_constants_state_aux(State,ConstantsState).
296		get_constants_state_aux(concrete_constants(ConstantsState),ConstantsState).
297		get_constants_state_aux(const_and_vars(ID,_),State) :- get_constants_state_for_id(ID,State).
298
299		% get the staet id for associated constants state for a state (if there are constants)
300		get_constants_state_id_for_id(ID,CstID) :-
301		visited_expression(ID,State), % TO DO: use packed_visited_expression for performance
302		get_constants_id_for_id_aux(State,ID,CstID).
303		get_constants_id_for_id_aux(concrete_constants(_),ID,ID).
304		get_constants_id_for_id_aux(const_and_vars(ID,_),_,ID).
305
306		get_variables_state_for_id(ID,VarState) :-
307		visited_expression(ID,State),
308		get_vars_aux(State,VarState).
309		%get_vars_aux(concrete_constants(ConstantsState),[]).
310		get_vars_aux(const_and_vars(_,Vars),State) :- !, State=Vars.
311		get_vars_aux([],[]).
312		get_vars_aux([H|T],[H|T]).
313
314		% check if there is a unique constants state:
315		try_get_unique_constants_state(ConstantsState) :-
316		transition(root,_,_TransID,DestID),
317		\+ (transition(root,_,_,DestID2), DestID2 \= DestID), % no other transition exists
318		\+ max_reached_or_timeout_for_node(root),
319		DestID \= root, % DestID=root should never happen
320		get_constants_state_for_id(DestID,ConstantsState).
321
322		% returns id of constants state for a state (if it exists)
323		get_constants_id_for_state_id(ID,ConstID) :-
324		packed_visited_expression(ID,'$cst_vars'(ConstID,_)).
325
326	?	any_transition(Origin,TransID,Destination) :- transition(Origin,_,TransID,Destination).
327
328	?	transition(Origin,Action,Destination) :- transition(Origin,Action,_TransID,Destination).
329
330		:- dynamic transition_info/2.
331		store_transition_infos([],_TransId).
332		store_transition_infos([Info|Irest],TransId) :-
333		store_transition_info(Info,TransId),
334		store_transition_infos(Irest,TransId).
335		store_transition_info(Info,TransId) :- %print(info(Info,TransId)),nl,
336		(keep_transition_info(Info)
337		-> assertz(transition_info(TransId,Info))
338		; true).
339
340		% Do not store path info by default
341		keep_transition_info(path(_)) :- !,fail.
342		keep_transition_info(eventtrace(_)) :- !,preference(eventtrace,true).
343		keep_transition_info(event(_)) :- !,preference(store_event_transinfo,true).
344		keep_transition_info(_). % store everything else
345
346		reset_transition_store :-
347		retractall(transition(_,_,_,_)),
348		retractall(transition_info(_,_)),
349		reset_counter(transitions),
350		reset_counterexample.
351
352		/*
353		Version with packing of transitions:
354		store_transition(Org,Action,Dest,Id) :-
355		retract(transition_counter(Id)),
356		NewId is Id+1,
357		assertz(transition_counter(NewId)),
358		Action =.. [ActionName|Parameters],
359		pack_values(Parameters,PackedParameters),
360		assertz(packed_transition(Org,ActionName,PackedParameters,Id,Dest)).
361
362		transition(Origin,Action,TransID,Destination) :- nonvar(Action),!,
363		Action =.. [ActionName|Parameters],
364		packed_transition(Origin,ActionName,PackedParameters,TransID,Destination),
365		unpack_values(PackedParameters,Parameters).
366		transition(Origin,Action,TransID,Destination) :-
367		packed_transition(Origin,ActionName,PackedParameters,TransID,Destination),
368		unpack_values(PackedParameters,Parameters),
369		Action =.. [ActionName|Parameters].
370		any_transition(Origin,TransID,Destination) :- packed_transition(Origin,_,_,TransID,Destination).
371		*/
372
373		% compute out-degree of a node
374		out_degree(ID,OutDegree) :- findall(0, transition(ID,_,_,_), L), length(L,OutDegree).
375
376		operation_name_not_yet_covered(OpName) :- operation_not_yet_covered(OpName).
377
378
379		get_operation_name_coverage_infos(PossibleNr,FeasibleNr,UncovNr,UncoveredList) :-
380		findall(ON, specfile:get_possible_event(ON), Possible), length(Possible,PossibleNr),
381		findall(OF, specfile:get_feasible_event(OF), Feasible), length(Feasible,FeasibleNr),
382		findall(OpName, state_space: operation_name_not_yet_covered(OpName), UncoveredList),
383		length(UncoveredList,UncovNr).
384
385
386		:- dynamic operation_not_yet_covered/1.
387		%operation_not_yet_covered(b).
388
389		:- use_module(probsrc(debug),[formatsilent/2]).
390		mark_operation_as_covered(OpName) :-
391		(retract(operation_not_yet_covered(OpName))
392		-> (preferences:get_preference(provide_trace_information,true)
393		-> print(cover(OpName)),nl ; true),
394	?	(operation_not_yet_covered(_) -> true ; formatsilent('~nALL OPERATIONS COVERED~n',[]))
395		; true
396		).
397
398
399		:- use_module(bmachine,[b_top_level_operation/1]).
400		:- use_module(debug,[debug_println/1]).
401		:- use_module(probcspsrc(haskell_csp),[channel/2]).
402		initialise_operation_not_yet_covered :- retractall(operation_not_yet_covered(_)),
403		b_or_z_mode,
404	?	b_top_level_operation(Name),
405		% b_get_machine_operation(Name,_,Par,_), length(Par,Arity), functor(Op,Name,Arity),
406		% Note: no '-->' added
407		assertz(operation_not_yet_covered(Name)),
408		debug_println(operation_not_yet_covered(Name)),
409		fail.
410		/* Missing: treat operations with return values */
411		initialise_operation_not_yet_covered :- csp_mode, \+ csp_with_bz_mode,
412		channel(Name,_),
413		assertz(operation_not_yet_covered(Name)),
414		debug_println(operation_not_yet_covered(Name)),
415		fail.
416		initialise_operation_not_yet_covered.
417
418		state_error_exists :- state_error(_,_,_),!.
419		:- dynamic state_error/3.
420
421		%state_error([],invariant_violated).
422
423		reset_next_state_error_id_counter :- reset_counter(next_state_error_id).
424		:- use_module(tools_printing, [print_error/1, format_error_with_nl/2]).
425		:- use_module(error_manager,[print_error_span/1]).
426		store_state_error(State,Error,Id) :- state_error(State,Id,Error),!. % do not store identical error twice
427		store_state_error(State,Error,Id) :-
428		%retract( next_state_error_id(Id) ),
429		inc_counter(next_state_error_id,Id),
430		% tools_printing:print_term_summary(Error),nl, tools_printing:nested_print_term(Error),nl,
431		assertz( state_error(State,Id,Error) ).
432		store_error_for_context_state(Error,Id) :-
433		( context_state(State,Errs) ->
434		(Errs<25
435		-> store_state_error(State,Error,Id), E1 is Errs+1,
436		%assertz(context_state(State,E1))
437		set_context_number_of_errors(E1)
438		; store_state_error(State,max_state_errors_reached(25),Id)
439		)
440		;
441		add_internal_error('No known context when calling store_error_for_context_state: ',store_error_for_context_state(Error,Id)),
442		fail).
443
444		% check if we already have a certain type of error in the current context state
445		abort_error_exists_in_context_state(ErrType) :- get_current_context_state(State),
446		Error = abort_error(ErrType,_Msg,_Term,_Pos),
447		state_error(State,_Id,Error).
448
449		% copy current errors from error_manager to state errors
450		copy_current_errors_to_state(StateID,Context) :-
451		% error_manager:logged_error(Source,ErrMsg,_Context,Span), % will not retract
452		error_manager:get_error_with_span(Source,ErrMsg,Span), % will retract
453		store_state_error(StateID,abort_error(Source,ErrMsg,'',span_context(Span,Context)),SID),
454		% TO DO: use other error class
455		debug_println(stored(Source,SID,_Context,ErrMsg)),
456		fail.
457		copy_current_errors_to_state(_,_).
458
459		store_abort_error_for_context_state_if_possible(ErrType,Msg,Term,Span) :-
460		%print(store(Msg,Term,Span)),nl,
461		( get_current_context_state(State) ->
462		error_manager:get_error_context(Context),
463		(abort_error_for_same_location_exists(State,Id1,ErrType,Msg,Span),
464		abort_error_for_same_location_exists(State,Id2,ErrType,Msg,Span),
465		Id2>Id1
466		-> /* two errors of same type, for same state and same source location exists */
467		/* TO DO: maybe merge state errors */
468		simplify_span(Span,Span1),
469		compress_span(Span1,Span2),
470		store_state_error(State,abort_error(ErrType,'Further identical errors occurred (not stored !)',Term,span_context(Span2,Context)),_)
471		;
472		format_error_with_nl('! An error occurred in state ~w: ~w !',[State,ErrType]),
473		% usual errors: precondition_error, while_invariant_violation, while_variant_error,
474		% assert_error, well_definedness_error, card_overflow_error
475		print_error(Msg),
476		print_error_term(Term,Span),
477		% print_error(context_state_id(State)), % printed by print_error_context
478		print_error_context,
479		(debug_mode(on),visited_expression(State,S) -> translate:translate_bstate(S,O),print_error(O) ; true),
480		compress_span(Span,Span2),
481		print_error_span(Span2),
482		store_state_error(State,abort_error(ErrType,Msg,Term,span_context(Span2,Context)),_)
483		),
484		(add_new_event_in_error_scope(abort_error(ErrType)) -> true ; true), % should we use well_definedness_error?
485		assert_real_error_occurred(abort_error) % Note that in this case the error manager list of errors maybe empty even though real_error_occured is true. (see ProB2 kernel test de.prob.cli.integration.rules.RulesMachineTest > testReuseStateSpace)
486		; % no current context_state exists:
487		compress_span(Span,Span2),
488		add_error(ErrType,Msg,Term,Span2)
489		).
490
491
492		:- use_module(bsyntaxtree, [find_identifier_uses/3]).
493		compress_span(span_context(Span,C),span_context(CS,C)) :- !,
494		compress_span(Span,CS).
495		compress_span(pos_context(Span1,C,Span2),pos_context(CS1,C,CS2)) :- !,
496		compress_span(Span1,CS1),
497		compress_span(Span2,CS2).
498		compress_span(span_predicate(Pred,LS,S),Res) :- find_identifier_uses(Pred,[],Ids),
499		sort(Ids,SIds),
500		filter_state(LS,SIds,FLS),
501		filter_state(S,SIds,FS), % TODO: do we need to store the global state? we can reconstruct it ?
502		% format('Compressed span_predicate (~w)~n',[Ids]),
503		!,
504		Res = span_predicate(Pred,FLS,FS).
505		compress_span(S,S).
506		% avoid storing large useless values
507		% TO DO: probably we should stop storing spans when a certain threshold of number of errors is reached
508
509
510		:- use_module(library(ordsets),[ord_member/2]).
511		filter_state([],_,[]).
512		filter_state([bind(ID,L)|T],Vars,Res) :-
513		(ord_member(ID,Vars) -> Res = [bind(ID,L)|RT] ; Res=RT),
514		filter_state(T,Vars,RT).
515
516
517		:- use_module(translate, [translate_error_term/3]).
518		print_error_term(T,S) :- (var(T);var(S)),!,
519		print_error('### VARIABLE error term or span:'), print_error(print_error_term(T,S)).
520		print_error_term(Term,Span) :- translate_error_term(Term,Span,S),
521		(S='' -> true ; print_error(S)).
522
523		abort_error_for_same_location_exists(State,Id,ErrType,Msg,Span) :-
524		state_error(State,Id,abort_error(ErrType,Msg,_Term2,span_context(Span2,_Ctxt2))),
525		same_span_location(Span2,Span).
526		% should be moved to error_manager ?
527		same_span_location(span_context(Span1,C),span_context(Span2,C)) :- !, same_span_location(Span1,Span2).
528		same_span_location(pos_context(Span1,C,_),pos_context(Span2,C,_)) :- !,
529		same_span_location(Span1,Span2). % should we check second span?
530		same_span_location(span_predicate(Pred1,_,_),span_predicate(Pred2,_,_)) :- !,Pred1=Pred2.
531		same_span_location(X,X).
532
533		:- dynamic saved_nested_context_state/2.
534		save_nested_context_state(_S) :-
535		bb_get(state_space_context_state,ID),
536		bb_get(state_space_context_errors,Errs),!,
537		%print(saving_context_state(_S,ID,Errs)),nl,
538		asserta(saved_nested_context_state(ID,Errs)).
539		save_nested_context_state(_).
540
541		% actually pops context state
542		clear_context_state :-
543		retract(saved_nested_context_state(ID,Errs)),!, %print(restoring_nested(ID,Errs)),nl,
544		bb_put(state_space_context_state,ID),
545		bb_put(state_space_context_errors,Errs).
546		clear_context_state :-
547		(bb_delete(state_space_context_state,_) -> true ; true).
548		%(retract(context_state(_,_)) -> true ; true). % retractall seems to be slowing down with use
549
550		% Note: Each Prolog module maintains its own blackboard for bb_get/bb_put
551		context_state(ID,Errs) :-
552		bb_get(state_space_context_state,ID), bb_get(state_space_context_errors,Errs).
553
554		% sets a new context state; pushing the previous one if necessary
555		set_context_state(State) :- %print(set_id(State)),nl,
556		save_nested_context_state(State),
557		bb_put(state_space_context_state,State),
558		bb_put(state_space_context_errors,0).
559
560		set_context_state(State,_Context) :- % Context can be used for debugging later
561		set_context_state(State).
562
563		% update current context state, without storing nested states
564		update_context_state(State) :-
565		bb_put(state_space_context_state,State),
566		bb_put(state_space_context_errors,0).
567
568		get_current_context_state(ID) :- bb_get(state_space_context_state,ID).
569		%get_current_context_state(ID) :- context_state(ID,_).
570
571		set_context_number_of_errors(Errs) :- bb_put(state_space_context_errors,Errs).
572
573		retractall_invariant_violated(State) :-
574		retractall(state_error(State,_,invariant_violated)).
575		invariant_violated(State) :-
576		state_error(State,_,invariant_violated).
577		set_invariant_violated(State) :-
578		( invariant_violated(State) -> true
579		; time_out_for_invariant(ID) -> print('Timeout for node: '), print(ID),nl,
580		print('Not setting invariant violation status'),nl
581		; store_state_error(State,invariant_violated,_)
582		).
583
584		%:- set_invariant_violated([]). % why is this ??
585
586
587		:- dynamic hash_to_id/2.
588		:- dynamic id_to_marker/2.
589
590		:- dynamic hash_to_nauty_id/2. % used in nauty mode to map nauty id's to hash values
591
592		:- dynamic specialized_inv/2. /* stores whether for a node a specialized invariant
593		version could be computed */
594
595		% :- dynamic reuse_operation/4. /* when for a state and given operation name we can reuse the operation computed for another state */
596		% used to be used for OPERATION_REUSE TRUE
597
598		:- use_module(hashing).
599		state_space_startup :- % call once at startup to ensure all counters exist
600		counter_init,
601		new_counter(states), new_counter(processed_nodes), new_counter(transitions),
602		new_counter(next_state_error_id),
603		new_counter(not_interesting_nodes),
604		reset_open_ids. % also calls myheap init
605		state_space_initialise :- counter_init, reset_gennum, reset_gensym,
606		new_counter(states), new_counter(processed_nodes), new_counter(transitions),
607		new_counter(next_state_error_id), new_counter(not_interesting_nodes),
608		reset_state_counter, reset_processed_nodes_counter, reset_next_state_error_id_counter,
609		retractall_visited_expression(_),
610		reset_open_ids,
611		reset_stored_values, % state_packing
612		retractall(not_invariant_checked(_)),
613		reset_not_interesting,
614		retractall(max_reached_for_node(_)),
615		retractall(time_out_for_node(_,_,_)),
616		retractall(time_out_for_invariant(_)),
617		retractall(time_out_for_assertions(_)),
618		retractall(use_no_timeout(_)),
619		retractall(state_error(_,_,_)),
620		clear_context_state,
621		reset_transition_store,
622		retractall(operation_not_yet_covered(_)),
623		retractall(hash_to_id(_,_)),
624		retractall(hash_to_nauty_id(_,_)),
625		retractall(id_to_marker(_,_)),
626		retractall(specialized_inv(_,_)),
627		%retractall(reuse_operation(_,_,_,_)),
628		state_space_add(root,root),
629		add_id_at_front(root),
630		my_term_hash(root,RootHash),
631		assertz(hash_to_id(RootHash,root)),
632		%assertz(not_invariant_checked(root)),
633		state_space_reset.
634
635		:- use_module(eventhandling,[register_event_listener/3]).
636		:- register_event_listener(startup_prob,state_space_startup,
637		'Initialise Statespace Counters.').
638		:- register_event_listener(reset_specification,state_space_initialise,
639		'Reset Statespace.').
640		:- register_event_listener(change_of_animation_mode,state_space_initialise,
641		'Reset Statespace.').
642		:- register_event_listener(specification_initialised,initialise_operation_not_yet_covered,
643		'Init coverage info.').
644		:- register_event_listener(reset_prob,state_space_initialise,
645		'Reset Statespace.').
646
647		/* A version of reset which checks how much memory is used by each fact */
648		/* state_space:init_with_stats */
649		state_space_initialise_with_stats :-
650		reset_gennum, reset_gensym, reset_state_counter, reset_processed_nodes_counter,
651		reset_next_state_error_id_counter,
652		retract_open_ids_with_statistics,
653		retract_with_statistics(state_space,[packed_visited_expression(_,_),
654		not_invariant_checked(_),
655		not_interesting(_),
656		max_reached_for_node(_),
657		time_out_for_node(_,_,_),
658		time_out_for_invariant(_),
659		time_out_for_assertions(_),
660		use_no_timeout(_),
661		state_error(_,_,_),
662		transition(_,_,_,_),
663		transition_info(_,_),
664		operation_not_yet_covered(_),
665		hash_to_id(_,_),
666		hash_to_nauty_id(_,_),
667		id_to_marker(_,_),
668		specialized_inv(_,_),
669		%reuse_operation(_,_,_,_),
670		history(_), forward_history(_), op_trace_ids(_)]),
671		reset_not_interesting,
672		retract_stored_values_with_statistics,
673		clear_context_state,
674		reset_transition_store,
675		state_space_add(root,root),
676		add_id_at_front(root),
677		%assertz(not_invariant_checked(root)),
678		state_space_reset,
679		initialise_operation_not_yet_covered.
680
681
682
683		:- dynamic op_trace_ids/1.
684		reset_trace :- retractall(op_trace_ids(_)), assertz(op_trace_ids([])).
685		get_action_trace(T) :- trace(T).
686		get_action_term_trace(PT) :- get_action_trace_with_limit(0,T), project_on_action_term(T,PT).
687		trace(Trace) :- get_action_trace_with_limit(500,Trace).
688		get_action_trace_with_limit(Limit,Trace) :-
689		op_trace_ids(IDT), reverse(IDT,RIDT),
690		extract_trace_from_transition_ids(RIDT,root,Limit,[],Trace).
691
692		reset_op_trace_ids :- retractall(op_trace_ids(_)), assertz(op_trace_ids([])).
693		add_to_op_trace_ids(OpID) :- retract(op_trace_ids(OpIDS)), assertz(op_trace_ids([OpID|OpIDS])).
694		remove_from_op_trace_ids(OpID) :- retract(op_trace_ids(OpIDS)),
695		(OpIDS = [R|Rest]
696		-> assertz(op_trace_ids(Rest)), OpID = R
697		; assertz(op_trace_ids(OpIDS)), fail).
698
699		% translate a list of transition ids (from root) into a list of operation terms
700		extract_term_trace_from_transition_ids(TransIDListFromRoot,Trace) :-
701		extract_trace_from_transition_ids(TransIDListFromRoot,root,0,[],ActionTrace),
702		reverse_and_project_on_action_term(ActionTrace,[],Trace).
703
704		reverse_and_project_on_action_term([],A,A).
705		reverse_and_project_on_action_term([action(_,Term)|T],Acc,Res) :- !,
706		reverse_and_project_on_action_term(T,[Term|Acc],Res).
707		reverse_and_project_on_action_term([H|T],Acc,Res) :-
708		add_error(reverse_and_project_on_action_term,'Illegal action: ',H),
709		reverse_and_project_on_action_term(T,[H|Acc],Res).
710
711		project_on_action_term([],[]).
712		project_on_action_term([action(_,Term)|T],Res) :- !, Res=[Term|TR],
713		project_on_action_term(T,TR).
714		project_on_action_term([H|T],Res) :-
715		add_error(project_on_action_term,'Illegal action: ',H),
716		project_on_action_term(T,Res).
717
718		extract_trace_from_transition_ids([],_CurrentState,_,Trace,Trace).
719		extract_trace_from_transition_ids([TransId|Rest],CurrentState,Limit,AccTrace,Trace) :-
720		compute_op_string(TransId,CurrentState,Limit,OpTerm,OpString,DestState),!,
721		extract_trace_from_transition_ids(Rest,DestState,Limit,
722		[action(OpString,OpTerm)|AccTrace],Trace).
723		extract_trace_from_transition_ids([TransId|_],CurrentState,_,_,_Trace) :-
724		add_error(state_space,'Could not execute transition id: ', TransId:from(CurrentState)),fail.
725
726		:- use_module(translate,[translate_event_with_src_and_target_id/5]).
727		compute_op_string(jump(TO),_CurID,_,Term,String,DestID) :- !, Term=jump,String=jump,DestID=TO.
728		compute_op_string(TransId,CurID,Limit,Term,String,DestID) :- transition(CurID,Term,TransId,DestID),
729		translate_event_with_src_and_target_id(Term,CurID,DestID,Limit,String).
730
731		% reset history and forward history, but not state-space itself
732		state_space_reset :-
733		reset_trace,
734		retractall(history(_)),
735		retractall(forward_history(_)),
736		retractall(current_state_id(_)),
737		retractall(current_options(_)),
738		assertz(history([])),
739		assertz(current_state_id(root)).
740
741		reset_not_interesting :- retractall(not_interesting(_)), reset_counter(not_interesting_nodes).
742
743		mark_as_not_interesting(ID) :- assertz(not_interesting(ID)), inc_counter(not_interesting_nodes).
744
745		set_current_state_id(ID) :- (retract(current_state_id(_)) -> true ; true),
746		assertz(current_state_id(ID)).
747
748		state_space_clean_all :-
749		retractall(state_space_version_in_file(_)),
750		retractall_visited_expression(_),
751		reset_open_ids,
752		retractall(not_invariant_checked(_)),
753		reset_not_interesting,
754		retractall(max_reached_for_node(_)),
755		retractall(time_out_for_node(_,_,_)),
756		retractall(time_out_for_invariant(_)),
757		retractall(time_out_for_assertions(_)),
758		retractall(use_no_timeout(_)),
759		retractall(state_error(_,_,_)),
760		clear_context_state,
761		reset_transition_store,
762		retractall(operation_not_yet_covered(_)),
763		retractall(hash_to_id(_,_)),
764		retractall(hash_to_nauty_id(_,_)),
765		retractall(id_to_marker(_,_)),
766		retractall(specialized_inv(_,_)),
767		%retractall(reuse_operation(_,_,_,_)),
768		retractall(history(_)),
769		retractall(forward_history(_)),
770		retractall(op_trace_ids(_)),
771		retractall(current_state_id(_)),
772		retractall(current_options(_)).
773
774		% this is only used from within the Tcl/Tk animator at the moment:
775		delete_node(ID) :- print(deleting(ID)),nl,
776		retractall_visited_expression(ID),
777		retractall_invariant_violated(ID),
778		retract_open_node_and_update_processed_nodes(ID),
779		retractall(not_invariant_checked(ID)),
780		(retract(not_interesting(ID)) -> inc_counter_by(not_interesting_nodes,-1) ; true),
781		retractall(max_reached_for_node(ID)),
782		retractall(time_out_for_node(ID,_,_)),
783		retractall(time_out_for_invariant(ID)),
784		retractall(time_out_for_assertions(ID)),
785		retractall(use_no_timeout(ID)),
786		retractall(state_error(ID,_,_)),
787		retractall(transition(ID,_,_,_)),
788		% to do: check if operation_not_yet_covered(_) changes
789		retract_hash(ID),
790		retractall(id_to_marker(ID,_)).
791
792		retract_hash(ID) :- retract(hash_to_id(Hash,ID)), retractall(hash_to_nauty_id(_TermHash,Hash)),fail.
793		retract_hash(_).
794
795		assert_max_reached_for_node(Id) :- %print_message(max_reached_for_node(Id)),
796		(max_reached_for_node(Id) -> true ; assertz(max_reached_for_node(Id))).
797
798		:- use_module(probsrc(debug),[debug_mode/1]).
799		assert_time_out_for_node(Id,OpName,TypeOfTimeOut) :-
800		(debug_mode(off),functor(TypeOfTimeOut,virtual_time_out,_) -> true % can easily happen when parameters are unbounded
801		; print_message(time_out_for_node(Id,OpName,TypeOfTimeOut))),
802		(time_out_for_node(Id,OpName,_) -> true ; assertz(time_out_for_node(Id,OpName,TypeOfTimeOut))).
803		assert_time_out_for_invariant(Id) :- print_message(time_out_for_invariant(Id)),
804		(time_out_for_invariant(Id) -> true ; assertz(time_out_for_invariant(Id))).
805		assert_time_out_for_assertions(Id) :- print_message(time_out_for_assertions(Id)),
806		(time_out_for_assertions(Id) -> true ; assertz(time_out_for_assertions(Id))).
807
808		max_reached_or_timeout_for_node(Id) :-
809		(max_reached_for_node(Id) ; time_out_for_node(Id,_,_)).
810		/* ---------------------- */
811		/* state space saving */
812		/* ---------------------- */
813
814		:- dynamic state_space_version_in_file/1. %
815		state_space_version(1).
816
817		check_state_space_version :- state_space_version(V),
818		(state_space_version_in_file(F) -> true ; F=0),
819		(V>F -> add_message(state_space,'Warning: saved state_space may be incompatible with current version: ',F:V) ; true).
820
821		% save all infos of state space (transitions, evaluated invariants, ...)
822		tcltk_save_state_space(File) :-
823		print('% saving full state space to: '), print(File),nl,
824		open(File,write,Stream,[encoding(utf8)]),
825		print_state_space(Stream),
826		close(Stream),
827		print_message(done).
828
829
830		:- use_module(tools_printing, [print_dynamic_fact/2,print_dynamic_pred/4]).
831		print_state_space(Stream) :-
832		state_space_version(V),
833		print_dynamic_fact(Stream,state_space_version_in_file(V)),
834		% TO DO: maybe also save some important preferences, and warn user and/or propose to adapt preferences ?
835		print_dynamic_pred(Stream,state_space,history,1),
836		print_dynamic_pred(Stream,state_space,forward_history,1),
837		print_dynamic_pred(Stream,state_space,op_trace_ids,1),
838		print_dynamic_pred(Stream,state_space,current_state_id,1),
839		print_dynamic_pred(Stream,state_space,current_options,1),
840		print_dynamic_pred(Stream,state_space,packed_visited_expression,2),
841		print_dynamic_pred(Stream,state_space,not_invariant_checked,1),
842		print_dynamic_pred(Stream,state_space,not_interesting,1),
843		print_dynamic_pred(Stream,state_space,max_reached_for_node,1),
844		print_dynamic_pred(Stream,state_space,time_out_for_node,3),
845		print_dynamic_pred(Stream,state_space,use_no_timeout,1),
846		print_dynamic_pred(Stream,state_space,transition,4),
847		print_dynamic_pred(Stream,state_space,transition_info,2),
848		print_dynamic_pred(Stream,state_space,operation_not_yet_covered,1),
849		print_dynamic_pred(Stream,state_space,state_error,3),
850		print_state_space_open_nodes(Stream),
851		print_stored_values(Stream),
852		get_counter(states,X),
853		write_term(Stream,saved_gennum_count(X),[quoted(true)]),write(Stream,'.'),nl(Stream).
854
855		saved_gennum_count(99999).
856
857		/* ---------------------- */
858		/* state space loading */
859		/* ---------------------- */
860
861		tcltk_load_state(File) :- state_space_clean_all,
862		print('Loading: '), print(File),nl,
863		user_consult_without_redefine_warning(File), % this will read in bind_skeleton/2, ..., next_value_id/1
864		check_state_space_version,
865		print('Generating open node info'),nl,
866		transfer_open_node_info,
867		print('Transfer state packing info'),nl,
868		transfer_state_packing_info,
869		print('Recomputing hash index'),nl,
870		recompute_all_hash,
871		(saved_gennum_count(X) -> reset_state_counter(X) ; true),
872		reset_processed_nodes_counter, % TO DO: restore or save it
873		reset_next_state_error_id_counter, % DITTO
874		print('Done'),nl,!.
875		tcltk_load_state(File) :-
876		add_error(tcltk_load_state,'Could not load state from file: ',File),
877		state_space_initialise.
878
879		:- dynamic not_all_z_saved/1, not_all_transitions_added_saved/1.
880		:- dynamic bind_skeleton/2, stored_value/2, stored_value_hash_to_id/2, next_value_id/1.
881
882		% transfer facts read into state_space into other modules:
883		transfer_open_node_info :- retract(not_all_z_saved(X)), %print(not_all_z(X)),nl,
884		assert_not_all_z(X),fail.
885		transfer_open_node_info :- retract(not_all_transitions_added_saved(X)),
886		assert_not_all_transitions_added(X),fail.
887		transfer_open_node_info.
888		% now for transferring to state_packing module info generated by print_stored_values
889		transfer_state_packing_info :- retract(bind_skeleton(X,Y)), %print(skel(X)),nl,
890		assertz(state_packing:bind_skeleton(X,Y)),fail.
891		transfer_state_packing_info :- retract(stored_value(X,Y)),
892		assertz(state_packing:stored_value(X,Y)),fail.
893		transfer_state_packing_info :- retract(stored_value_hash_to_id(X,Y)),
894		assertz(state_packing:stored_value_hash_to_id(X,Y)),fail.
895		transfer_state_packing_info :- retract(next_value_id(X)),
896		state_packing:set_next_value_id(X),fail.
897		transfer_state_packing_info.
898
899		recompute_all_hash :-
900		retractall(hash_to_id(_,_)),retractall(id_to_marker(_,_)),
901		retractall(hash_to_nauty_id(_,_)),
902		visited_expression(ID,StateTemplate),
903		state_space_exploration_modes:compute_hash(StateTemplate,Hash,Marker),
904		assertz(hash_to_id(Hash,ID)),
905		assertz(id_to_marker(ID,Marker)),
906		fail.
907		recompute_all_hash.
908
909		:- use_module(hashing,[my_term_hash/2]).
910		% generates a hash for the entire state space not depending on the order in which states where added
911		compute_full_state_space_hash(Hash) :-
912		%listing(hash_to_id/2), listing(packed_visited_expression/2),
913		findall(Hash,hash_to_id(Hash,_),ListOfHashCodes),
914		sort(ListOfHashCodes,SortedList),
915		my_term_hash(SortedList,Hash).
916		% TO DO: also provide transition hashes
917
918		:- use_module(tools_meta,[safe_on_exception/3]).
919		user_consult_without_redefine_warning(File) :-
920		get_set_optional_prolog_flag(redefine_warnings, Old, off),
921		get_set_optional_prolog_flag(single_var_warnings, Old2, off),
922		(safe_on_exception(Exc,
923		%consult(File), %
924		load_files([File], [load_type(source),compilation_mode(consult),encoding(utf8)]),
925		(nl,print('Exception occurred:'),print(Exc),nl,fail))
926		-> OK=true ; OK=false),
927		get_set_optional_prolog_flag(redefine_warnings, _, Old),
928		get_set_optional_prolog_flag(single_var_warnings, _, Old2),
929		OK=true.
930
931
932
933		execute_id_trace_from_current(ID,OpIDL,StateIDList) :-
934		current_state_id(CurID),
935		reverse([CurID|StateIDList],Rev),
936		Rev = [Dest|TRev], (Dest==ID -> true ; print(not_eq(Dest,ID)),nl),
937		retract(history(H)),
938		update_forward_history(OpIDL), % check if OpIDL conforms to forward history and keep it
939		append(TRev,H,NewH),
940		assertz(history(NewH)),
941		retract(op_trace_ids(OldTrace)),
942		reverse(OpIDL,NewTrace),
943		append(NewTrace,OldTrace,Trace),
944		assertz(op_trace_ids(Trace)),
945		retractall(current_state_id(_)),
946		assertz(current_state_id(ID)).
947		%execute_trace_to_node(OpL,StateIDList). /* <----- BOTTLENECK FOR LONG SEQUENCES */
948		%generate_trace([],Acc,Acc).
949		%generate_trace([OpTerm|T],Acc,Res) :-
950		% translate:translate_event(OpTerm,OpString),
951		% generate_trace(T,[action(OpString,OpTerm)|Acc],Res).
952
953		update_forward_history(TransitionIds) :-
954		(retract(forward_history(Forward)),
955		prune_forward_history(TransitionIds,Forward,NewForward)
956		-> assert(forward_history(NewForward))
957		; true).
958		% try and prune forward history if it matches operation trace
959		prune_forward_history([],ForwardHistory,ForwardHistory).
960		prune_forward_history([TransID|T],[forward(_,TransID)|TF],Res) :-
961		prune_forward_history(T,TF,Res).
962
963		try_set_trace_by_transition_ids(TransIds) :-
964		(set_trace_by_transition_ids(TransIds) -> true
965		; add_internal_error('Call failed:',set_trace_by_transition_ids(TransIds))).
966
967		set_trace_by_transition_ids(TransitionIds) :-
968		extract_history_from_transition_ids(TransitionIds,root,[],[],Last,History,OpTrace),
969		%visited_expression(Last,LastState,LastCond),
970		retractall(history(_)),
971		retractall(forward_history(_)), % TODO: we could try and recover a new forward history if transition ids match current history^forward history
972		update_forward_history(TransitionIds),
973		retractall(current_state_id(_)),
974		retractall(op_trace_ids(_)),
975		assertz(history(History)),
976		assertz(op_trace_ids(OpTrace)),
977		assertz(current_state_id(Last)).
978
979
980		extract_history_from_transition_ids([],CurrentState,History,Trace,CurrentState,History,Trace).
981		extract_history_from_transition_ids([TransId|Rest],CurrentState,AccHist,AccTrace,Last,History,Trace) :-
982		transition(CurrentState,_,TransId,DestState),!,
983		extract_history_from_transition_ids(Rest,DestState,[CurrentState|AccHist],
984		[TransId|AccTrace],Last,History,Trace).
985		extract_history_from_transition_ids([TransId|_],CurrentState,_,_,_,_,_Trace) :-
986		add_error(state_space,'Could not execute transition id: ', TransId:from(CurrentState)),fail.
987
988		% extend trace from current state
989		extend_trace_by_transition_ids(TransitionIds) :-
990		current_state_id(CurID),
991		history(OldH), op_trace_ids(OldOT),
992		extract_history_from_transition_ids(TransitionIds,CurID,OldH,OldOT,Last,History,OpTrace),
993		retractall(history(_)), retractall(forward_history(_)),
994		retractall(current_state_id(_)),
995		retractall(op_trace_ids(_)),
996		assertz(history(History)),
997		assertz(op_trace_ids(OpTrace)),
998		assertz(current_state_id(Last)).
999
1000		/* --------------------------------- */
1001		:- dynamic max_nr_of_new_nodes/1.
1002
1003		% negative number or non-number signifies no limit
1004		set_max_nr_of_new_impl_trans_nodes(MaxNrOfNewNodes) :-
1005		retractall(max_nr_of_new_nodes(_)),
1006		(number(MaxNrOfNewNodes), MaxNrOfNewNodes>=0
1007		-> assertz(max_nr_of_new_nodes(MaxNrOfNewNodes))
1008		; true). % no need to store limit; we will explore as much as needed
1009
1010		get_max_nr_of_new_impl_trans_nodes(MaxNrOfNewNodes) :-
1011		(max_nr_of_new_nodes(Max) -> MaxNrOfNewNodes=Max; MaxNrOfNewNodes = 0).
1012
1013		% used e.g., in refinement or ltl checker
1014		impl_trans_term(From,ActionAsTerm,To) :-
1015		compute_transitions_if_necessary_saved(From),
1016		transition(From,ActionAsTerm,_TID,To).
1017
1018		% a variation also giving the transition id:
1019		impl_trans_id(From,ActionAsTerm,TransitionID,To) :-
1020		compute_transitions_if_necessary_saved(From),
1021		transition(From,ActionAsTerm,TransitionID,To).
1022
1023		impl_trans_term_all(From,Ops) :-
1024		compute_transitions_if_necessary_saved(From),
1025		findall(op(Id,ActionAsTerm,To),
1026		transition(From,ActionAsTerm,Id,To),
1027		Ops).
1028
1029		compute_transitions_if_necessary_saved(From) :-
1030		catch(
1031		compute_transitions_if_necessary(From),
1032		error(forced_interrupt_error('User has interrupted the current execution'),_),
1033		user_interrupts:process_interrupted_error_message).
1034
1035		:- use_module(tcltk_interface,[compute_all_transitions_if_necessary/2]).
1036		compute_transitions_if_necessary(From) :-
1037		not_all_transitions_added(From),!,
1038		decrease_max_nr_of_new_nodes(From),
1039		compute_all_transitions_if_necessary(From,false).
1040		compute_transitions_if_necessary(_From).
1041
1042		decrease_max_nr_of_new_nodes(ID) :-
1043		retract(max_nr_of_new_nodes(Max)),!,
1044		( Max>0 ->
1045		NewMax is Max-1,
1046		assertz(max_nr_of_new_nodes(NewMax))
1047		; Max=0 -> NM is -1,
1048		assertz(max_nr_of_new_nodes(NM)),
1049		add_warning(state_space,'Maximum number of new nodes reached for CTL/LTL/refinement check, node id = ',ID),
1050		fail
1051		; % negative number: re-assert and fail
1052		assertz(max_nr_of_new_nodes(Max)),
1053		fail).
1054		decrease_max_nr_of_new_nodes(_). % no limit stored; just proceed
1055
1056		% will be called from TCL/TK side
1057		max_nr_of_new_nodes_limit_not_reached :-
1058		max_nr_of_new_nodes(N),N>0.
1059
1060		:- use_module(specfile,[b_or_z_mode/0, csp_mode/0, csp_with_bz_mode/0]).
1061		retract_open_node(NodeID) :- retract_open_node_and_update_processed_nodes(NodeID),
1062		(b_or_z_mode -> assertz(not_invariant_checked(NodeID)) ; true).
1063
1064		reset_processed_nodes_counter :- reset_counter(processed_nodes).
1065		%reset_processed_nodes_counter(Nr) :- set_counter(processed_nodes,Nr).
1066
1067		retract_open_node_and_update_processed_nodes(NodeID) :-
1068		retract_open_node_direct(NodeID),
1069		inc_processed.
1070
1071		inc_processed :-
1072		inc_counter(processed_nodes).
1073
1074		pop_id_from_front(ID) :- pop_id_from_front_direct(ID), inc_processed.
1075		pop_id_from_end(ID) :- pop_id_from_end_direct(ID), inc_processed.
1076	?	pop_id_oldest(ID) :- pop_id_oldest_direct(ID), inc_processed.
1077
1078
1079
1080		/* --------------------------------- */
1081
1082		% find initialised states; very similar to is_initial_state_id/1
1083		% but is used by ltl/ctl/sap
1084		% TO DO: merge these two variations of the same concept
1085
1086		:- use_module(specfile,[animation_mode/1]).
1087
1088		find_initialised_states(Init) :-
1089		animation_mode(Mode),
1090		( init_states_mode_cst_init(Mode) ->
1091		findall(I,find_init1(root,I,_),Init)
1092		; init_states_mode_one_step(Mode) ->
1093		next_states_from_root(Init)
1094		;
1095		fail).
1096
1097		% find trace to some initialised state
1098		find_trace_to_initial_state(Target,Trace) :- animation_mode(Mode),
1099		find_aux(Mode,Target,Trace).
1100		find_aux(Mode,Target,[root,Target]) :-
1101		init_states_mode_one_step(Mode).
1102		find_aux(Mode,Target,[root|Trace]) :-
1103		init_states_mode_cst_init(Mode),
1104		find_init1(root,Target,Trace).
1105
1106
1107		init_states_mode_cst_init(b).
1108		init_states_mode_cst_init(z).
1109		init_states_mode_cst_init(csp_and_b).
1110
1111		init_states_mode_one_step(csp).
1112		init_states_mode_one_step(cspm).
1113		init_states_mode_one_step(xtl).
1114		%init_states_mode_one_step(promela).
1115
1116		next_states_from_root(States) :-
1117		impl_trans_term_all(root,Ops),
1118		findall(S, member(op(_Id,_,S),Ops), States).
1119
1120		find_init1(Start,Init,Trace) :- Start==Init,!,Trace=[]. % usually called with Start=Init=root
1121		find_init1(Start,Init,[State|Rest]) :-
1122		impl_trans_term(Start,O,State),
1123		find_init2(O,State,Init,Rest).
1124		find_init2(O,Init,Init,[]) :-
1125		has_functor_and_maybe_tau(O,'$initialise_machine').
1126		find_init2(O,State,Init,Path) :-
1127		has_functor_and_maybe_tau(O,'$setup_constants'),
1128		find_init1(State,Init,Path).
1129		find_init2(start_cspm_MAIN,State,Init,Path) :-
1130		find_init1(State,Init,Path).
1131		find_init2(start_cspm(_Proc),State,Init,Path) :-
1132		find_init1(State,Init,Path).
1133
1134		% has_functor_and_maybe_tau(Term,Functor)
1135		% checks if Term has the form "Functor(...)" or "tau(Functor(...))"
1136		% this is used for CSP||B specification where the initialisation is wrapped with
1137		% in a tau operator
1138		has_functor_and_maybe_tau(tau(Term),Functor) :-
1139		has_functor_and_maybe_tau(Term,Functor),!.
1140		has_functor_and_maybe_tau(Term,Functor) :-
1141		functor(Term,Functor,_).
1142
1143
1144		/* --------------------------------- */
1145
1146		%
1147		% Code to compute equivalence classes
1148		% using the standard DFA minimization algorithm
1149
1150		:- dynamic equivalent/2.
1151		% state_space:compute_equivalence_classes
1152		:- public compute_equivalence_classes/0.
1153
1154		compute_equivalence_classes :- init_equi,
1155		split_equivalence_classes,nl,
1156		print_equi.
1157
1158		print_equi :- state_space:equivalent(A,B), visited_expression(A,State),
1159		visited_expression(B,StateB),
1160		nl,
1161		print(A), print(' : '), print(State),nl,
1162		print(B), print(' : '), print(StateB),nl,fail.
1163		print_equi.
1164
1165		init_equi :- retractall(equivalent(_,_)),
1166		packed_visited_expression(ID,_State),
1167		\+ not_all_transitions_added(ID),
1168		findall(Action,transition(ID,Action,_,_),List),
1169		packed_visited_expression(ID2,_S2), ID2 @> ID,
1170		\+ not_all_transitions_added(ID2),
1171		findall(Action,transition(ID2,Action,_,_),List),
1172		assertz(equivalent(ID,ID2)), % they have the same signature
1173		%print(equivalent(ID,ID2)),nl,
1174		fail.
1175		init_equi :- print(finished_initialising),nl.
1176
1177		split_equivalence_classes :- retractall(echange),
1178		equivalent(ID1,ID2),
1179		transition(ID1,A,_,Dest1),
1180		transition(ID2,A,_,Dest2),
1181		\+ check_equi(Dest1,Dest2),
1182		retract(equivalent(ID1,ID2)), % splitting class
1183		% print(diff(ID1,ID2, A, Dest1, Dest2)),nl,
1184		assert_echange,
1185		fail.
1186		split_equivalence_classes :- echange -> split_equivalence_classes ; true.
1187
1188		:- dynamic echange/0.
1189		assert_echange :- echange -> true ; assertz(echange),print('.'),flush_output.
1190
1191		check_equi(A,B) :- A=B -> true ; A @<B -> equivalent(A,B) ; equivalent(B,A).
1192
1193		/*
1194		% benchmark how much time it takes to copy the state space state_space:bench_state_space.
1195		bench_state_space :-
1196		statistics(walltime,_),
1197		(state_space:packed_visited_expression(ID,S), assertz(pve(ID,S)),fail ; true),
1198		statistics(walltime,[_,Delta]), format('Time to copy packed_visited_expression: ~w ms~n',[Delta]),
1199		(state_space:transition(A,B,C,D), assertz(tr(A,B,C,D)),fail ; true),
1200		statistics(walltime,[_,Delta2]), format('Time to copy transition: ~w ms~n',[Delta2]),
1201		(state_packing:stored_value(A,B), assertz(sv(A,B)),fail ; true),
1202		(state_packing:stored_value_hash_to_id(A,B), assertz(svhi(A,B)),fail ; true),
1203		statistics(walltime,[_,Delta3]), format('Time to copy stored_value: ~w ms~n',[Delta3]).
1204		*/
1205
1206		:- public portray_state_space/0.
1207		portray_state_space :- packed_visited_expression(ID,S), functor(S,F,N),
1208		format('State ~w : ~w/~w~n',[ID,F,N]), fail.
1209		portray_state_space :- transition(ID,Action,TransID,DestID),
1210		format(' ~w: ~w -- ~w --> ~w~n',[TransID,ID,Action,DestID]),fail.
1211		portray_state_space.
1212
1213		bench_state_space :- statistics(walltime,[W1,_]),
1214		(packed_visited_expression(_,_), fail ; true),
1215		statistics(walltime,[W2,_]), T1 is W2-W1,
1216		format('Time to inspect all states: ~w ms walltime~n',[T1]),
1217		(visited_expression(_,_), fail ; true),
1218		statistics(walltime,[W3,_]), T2 is W3-W2,
1219		format('Time to inspect and unpack all states: ~w ms walltime~n',[T2]),
1220		(transition(_,_,_,_), fail ; true),
1221		statistics(walltime,[W4,_]), T3 is W4-W3,
1222		format('Time to inspect all transitions: ~w ms walltime~n',[T3]),
1223		(visited_expression(_,E), my_term_hash(E,_), fail ; true),
1224		statistics(walltime,[W5,_]), T4 is W5-W4,
1225		format('Time to inspect, unpack and hash all states: ~w ms walltime~n',[T4]).
1226
1227		% ----------------------------
1228		% COUNTER EXAMPLE MANAGEMENT
1229
1230		% store counter example nodes and transition ids; used by LTL model checking for example
1231
1232
1233		:- dynamic counterexample_node/1.
1234		:- dynamic counterexample_op/1.
1235
1236		add_counterexample_node(NodeID) :- assertz(counterexample_node(NodeID)).
1237		add_counterexample_op(TransID) :-
1238		(counterexample_op(TransID) -> true ; assertz(counterexample_op(TransID))).
1239
1240
1241		reset_counterexample :-
1242		retractall(counterexample_node(_)),
1243		retractall(counterexample_op(_)).
1244
1245		:- register_event_listener(play_counterexample,reset_counterexample,
1246		'Reset marked nodes from previous counterexamples.').
1247
1248		set_counterexample_by_transition_ids(TransIds) :-
1249		set_trace_by_transition_ids(TransIds),
1250		maplist(add_counterexample_op,TransIds),
1251		extract_history_from_transition_ids(TransIds,root,[],[],_Last,History,_OpTrace),
1252		maplist(add_counterexample_node,History).