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