1 % (c) 2009-2025 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
2 % Heinrich Heine Universitaet Duesseldorf
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5 %:- set_prolog_flag(source_info,on).
6 % comment in if you want source location, e.g., for exceptions,...
7 % you can also comment in a line in remove_debugging_calls in debugging_calls_te.pl to see location of nl/0
8 % (and ensure debugging_calls.pl is loaded below and in term_expansion hook is set in debugging_calls_te.pl)
9 % with ?- trace, leash(off). one can creep without entering return in the debugger; with leash([redo]) the debugger only stops at the Redo-Port. Use @<RETURN> to enter Prolog commands in the debugger.
10 % leash(exception) also useful
11 % Note: to run probcli from source for ProB2 change change probcli.sh: PROBCOMMAND=probproxy and start probsli -s 8888
12
13 :- module(prob_cli, [go_cli/0,
14 run_probcli/2, run_probcli_with_argv_string/1,
15 reset_cli/0, recognised_cli_option/4, recognised_option/2, go_proxy/0,
16 print_version/1, cli_print_statistics/1]).
17
18 :- set_prolog_flag(double_quotes, codes).
19
20 :- if(predicate_property(expects_dialect(_), _)).
21 :- expects_dialect(sicstus4).
22 :- endif.
23
24 :- multifile user:portray_message/2.
25 user:portray_message(informational, imported(_Nr,_M1,_M2)) :- !.
26 user:portray_message(informational, loading(_Nr,_,_File)) :- !.
27 %user:portray_message(informational, loaded(_Nr,compiled,_File,M,MS,_)) :- !, format('~w ms for ~w~n',[MS,M]).
28 user:portray_message(informational, loaded(_Nr,_CompiledLoaded,_File,_Module,_TimeMS,_Bytes)) :- !.
29 user:portray_message(informational, foreign_resource(_Nr,_Status,_File,_Mod)) :- !.
30 user:portray_message(informational, chr_banner) :- !.
31 %user:portray_message(informational, halt) :- !.
32 %user:portray_message(informational, prompt(off,0,user,off,off,off)) :- !.
33 %user:portray_message(informational, M) :- !, write(M),nl,nl.
34
35
36 :- meta_predicate if_option_set(-,0).
37 :- meta_predicate if_option_set(-,0,0).
38 :- meta_predicate if_options_set(-,0).
39 :- meta_predicate if_option_set_loaded(-,-,0).
40 :- meta_predicate ifm_option_set(-,0).
41 :- meta_predicate ifm_option_set(-,-,0).
42 :- meta_predicate ifm_option_set_loaded(-,-,0).
43
44
45 % patch for SICStus 4.3.3 performance issue
46 % sprm_14972_patch.pl BEGIN
47 :- if((current_prolog_flag(dialect, sicstus),
48 current_prolog_flag(version_data, sicstus(4,3,3,_,_)))).
49 prolog:wf_call_like_arg(A, B, C, D, E, F, G, H, I, _) :-
50 prolog:wellformed_body_iso(A, B, C, D, E, F, G, H, I, quiet),
51 !.
52 prolog:wf_call_like_arg(A, B, C, A, D, _, E, _, _, _) :-
53 F=E:A,
54 prolog:condense_layout(B, G),
55 prolog:comp_layout2(B, G, B, H),
56 C=call(F),
57 prolog:comp_layout1(B, H, D).
58 :- endif.
59 % sprm_14972_patch.pl END
60
61
62 %:- include('self_check_off.pl').
63
64 :- use_module(module_information).
65 :- module_info(group,cli).
66 :- module_info(description,'ProB start file in cli mode.').
67
68 %:- use_module(debugging_calls).
69 %:- register_debugging_calls([pp_mnf(*), pp_cll(*), mnf(*), mnf(-,*), det_call(*)]).
70 %:- disable_debugging_calls.
71
72 :- use_module(prob_startup, [startup_prob/0]).
73 %:- use_module(pathes,[set_search_pathes/0]). % called first to set_compile_time_search_pathes
74 :- use_module(tools,[string_concatenate/3,arg_is_number/2, print_memory_used_wo_gc/1, print_memory_used_wo_gc/0,
75 split_atom/3, get_options/5,
76 start_ms_timer/1, stop_ms_timer/1, stop_ms_timer/2, stop_ms_timer_with_msg/2]).
77 :- use_module(tools_printing,[print_error/1,format_with_colour/4, format_with_colour_nl/4]).
78 :- use_module(tools_strings,[atom_split/4,convert_atom_to_number/2]).
79 :- use_module(tools_meta,[safe_time_out/3]).
80 :- use_module(tools_lists,[count_occurences/2]).
81
82 :- use_module(preferences).
83 :- set_prob_application_type(probcli). %
84
85 :- use_module(library(lists)).
86 :- use_module(library(file_systems),[file_exists/1]).
87 :- use_module(library(system)).
88 :- use_module(library(codesio)).
89 :- use_module(library(between),[between/3]).
90 :- use_module(library(terms),[term_hash/2]).
91 :- use_module(library(random),[random/3, setrand/1]).
92
93 :- use_module(self_check,[disable_interaction_on_errors/0,
94 perform_self_check/2,turn_off_run_time_type_checks/0,turn_on_run_time_type_checks/0]).
95 :- use_module(debug).
96 :- use_module(error_manager).
97 :- use_module(translate,[pretty_type/2]).
98 :- use_module(tools,[safe_absolute_file_name/2, safe_absolute_file_name/3, convert_ms_time_to_string/2]).
99 :- use_module(extension('counter/counter'),
100 [counter_init/0, new_counter/1, get_counter/2, inc_counter/1, inc_counter/2, reset_counter/1]).
101 :- use_module(state_space,[current_expression/2]).
102
103
104 :- dynamic junit_mode/1.
105 :- use_module(junit_tests,[set_junit_dir/1, create_and_print_junit_result/4]).
106
107 :- use_module(b_trace_checking,[check_default_trace_for_specfile/1, tcltk_check_state_sequence_from_file/1,
108 tcltk_check_sequence_from_file/3, get_default_trace_file/3,
109 tcltk_save_history_as_trace_file/2,tcltk_save_history_as_trace_file/3]).
110 :- use_module(eventhandling,[store_virtual_event/1]).
111 :- use_module(bmachine,[b_set_initial_machine/0]).
112 :- use_module(specfile).
113 :- use_module(test_typechecker,[run_typecheck_testcase/2]).
114 :- use_module(basic_unit_tests). % basic unit tests
115 :- use_module(bsyntaxtree,[size_of_conjunction/2, get_texpr_id/2, get_texpr_description/2,
116 conjunction_to_list/2,
117 get_texpr_label/2, predicate_components/2, get_texpr_pos/2]).
118 :- use_module(bmachine,[b_write_machine_representation_to_file/3,
119 full_b_machine/1, b_write_eventb_machine_to_classicalb_to_file/1]).
120 :- use_module(state_space,[current_state_id/1, get_state_space_stats/4, compute_full_state_space_hash/1]).
121 :- use_module(xtl_interface,[set_cspm_main_process/1]).
122 :- use_module(extrasrc(meta_interface),[is_dot_command/1, call_dot_command_with_engine/4,
123 is_dot_command_for_expr/1,call_dot_command_with_engine_for_expr/5,
124 is_plantuml_command/1, is_plantuml_command_for_expr/1,
125 is_table_command/1, is_table_command_for_expr/1,
126 call_plantuml_command/2, call_plantuml_command_for_expr/4,
127 call_command/5, is_table_command/6, write_table_to_csv_file/3,
128 command_description/3]).
129 :- use_module(kodkodsrc(kodkod_test),[test_kodkod/1, compare_kodkod_performance/2]).
130 :- use_module(kodkodsrc(predicate_analysis),[test_predicate_analysis/0]).
131 :- use_module(b_show_history,[write_history_to_file/2,write_values_to_file/1,
132 write_all_values_to_dir/1,write_history_to_user_output/1]).
133 :- use_module(cbcsrc(sap), [write_all_deadlocking_paths_to_xml/1, test_generation_by_xml_description/1]).
134 :- use_module(smtlib_solver(smtlib2_cli),[smtlib2_file/2]).
135 :- use_module(disproversrc(disprover_test_runner), [run_disprover_on_all_pos/1,
136 load_po_file/1,print_disprover_stats/0, set_disprover_timeout/1,
137 set_disprover_options/1, reset_disprover_timeout/0]).
138 :- use_module(extrasrc(latex_processor), [process_latex_file/2]).
139 :- use_module(probltlsrc(ltl),[ltl_check_assertions/2,ltl_model_check/4]).
140 :- use_module(probltlsrc(ctl),[ctl_model_check/4]).
141
142 :- use_module(logger).
143 :- use_module(extension('zmq/master/master'),[start_master/8]).
144 :- use_module(extension('zmq/worker/worker'),[start_worker/5]).
145 :- use_module(extension('ltsmin/ltsmin'),
146 [start_ltsmin/4,ltsmin_init/3,ltsmin_loop/1,ltsmin_teardown/2,ltsmin_generate_ltlfile/2]).
147 :- use_module(extrasrc(coverage_statistics),[compute_the_coverage/5]).
148 :- use_module(value_persistance, [set_storage_directory/2, print_value_persistance_stats/0,
149 delete_cache_files_for_machine/1, delete_cache_files/0,
150 get_value_persistance_stats/1, show_cache_file_contents/1]).
151 :- use_module(prob_socketserver,[start_prob_socketserver/2]).
152 :- use_module(tcltk_interface).
153 %:- compile(gui_tcltk).
154 :- use_module(eclipse_interface).
155 :- use_module(prob2_interface,[start_animation/0, is_initialised_state/1, reset_animator/0,
156 set_eclipse_preference/2, update_preferences_from_spec/1,
157 load_cspm_spec_from_cspm_file/1, load_xtl_spec_from_prolog_file/1]).
158
159 start_probcli_timer(timer(T1,WT1)) :-
160 statistics(runtime,[T1,_]),
161 statistics(walltime,[WT1,_]).
162 stop_probcli_debug_timer(Timer,Msg) :- (debug_mode(on) -> stop_probcli_timer(Timer,Msg) ; true).
163 stop_probcli_timer(timer(T1,WT1),Msg) :- stop_probcli_timer(timer(T1,WT1),Msg,_).
164 stop_probcli_timer(timer(T1,WT1),Msg,WTotTime) :-
165 statistics(runtime,[T2,_]), TotTime is T2-T1,
166 statistics(walltime,[WT2,_]), WTotTime is WT2-WT1,
167 convert_ms_time_to_string(WT2,WTString),
168 format('~w ~w ms walltime (~w ms runtime), since start: ~w~n',[Msg,WTotTime,TotTime,WTString]),
169 !.
170 stop_probcli_timer(Timer,Msg,_) :- add_internal_error('Illegal timer call: ',stop_probcli_timer(Timer,Msg)).
171 print_total_probcli_timer :-
172 statistics(runtime,[T2,_]),
173 statistics(walltime,[WT2,_]),
174 format('Since start of probcli: ~w ms walltime (~w ms runtime)~n',[WT2,T2]).
175 get_probcli_elapsed_walltime(timer(_,WT1),WTotTime) :-
176 statistics(walltime,[WT2,_]), WTotTime is WT2-WT1.
177 get_probcli_elapsed_runtime(timer(RT1,_),RTotTime) :-
178 statistics(runtime,[RT2,_]), RTotTime is RT2-RT1.
179
180 :- meta_predicate timeout_call(0,-,-).
181 timeout_call(Call,NOW,PP) :- option(timeout(TO)),!,
182 statistics(runtime,[T1,_]),
183 safe_time_out(Call,TO,Res),
184 statistics(runtime,[T2,_]), Runtime is T2-T1,
185 formatsilent('Runtime for ~w: ~w ms~n',[PP,Runtime]),
186 (Res=time_out -> print('*** Timeout occurred: '), print(TO),nl,
187 print('*** Call: '), print(Call),nl,
188 nl,
189 writeln_log(timeout_occurred(NOW,Call))
190 ; true).
191 timeout_call(Call,_NOW,PP) :-
192 statistics(runtime,[T1,_]),
193 call(Call),
194 statistics(runtime,[T2,_]), Runtime is T2-T1,
195 formatsilent('Runtime for ~w: ~w ms~n',[PP,Runtime]).
196
197 set_junit_mode(X) :-
198 set_junit_dir(X),
199 retractall(junit_mode(_)),
200 statistics(runtime,[Start,_]),
201 assertz(junit_mode(Start)).
202
203 go_proxy :-
204 catch( run_probcli(['-s','8888'],[proxy]), halt(ExitCode),
205 ( nl,write('CLI halt prevented, exit code '),write(ExitCode),nl) ).
206
207 go_cli :-
208 % set_prob_application_type(probcli) is already done at compile_time
209 current_prolog_flag(argv,ArgV),
210 run_probcli_with_junit_check(ArgV).
211
212 initialise_cli :- counter_init,
213 new_counter(cli_execute_inits),
214 new_counter(cli_errors), new_counter(cli_warnings),
215 new_counter(cli_expected_errors).
216
217 % called from test_runner.pl:
218 reset_cli :-
219 announce_event(clear_specification),
220 announce_event(reset_prob),
221 reset_expected_error_occurred,
222 reset_optional_errors_or_warnings,
223 reset_counter(cli_errors), reset_counter(cli_warnings),
224 reset_counter(cli_expected_errors),
225 retractall(accumulated_infos(_,_,_)),
226 retractall(merged_individual_file_infos(_,_,_)),
227 retractall(individual_file_infos(_,_,_)),
228 (file_loaded(_)
229 -> clear_loaded_machines, % TODO: also treat by reset_prob eventhandling?
230 retractall(file_loaded(_,_)),
231 retractall(loaded_main_file(_,_))
232 ; true).
233
234 run_probcli_with_junit_check(ArgV) :-
235 catch( run_probcli(ArgV,[junit]),
236 halt(ExitCode),
237 ( ExitCode = 0 ->
238 true
239 ; ( junit_mode(S) ->
240 statistics(runtime,[E,_]), T is E - S,
241 create_and_print_junit_result(['Integration Tests'],ArgV,T,error([ExitCode]))
242 ; true),
243 throw(halt(ExitCode)))).
244
245
246 % a useful entry point for Jupyter to mimic probcli execution in notebooks
247 run_probcli_with_argv_string(ArgVAtom) :- split_argv_string(ArgVAtom,Atoms),
248 (Atoms = [probcli|Atoms2] -> true ; Atoms2=Atoms),
249 run_probcli(Atoms2,[run_probcli_with_argv_string]).
250
251 split_argv_string(ArgVAtom,Atoms) :- split_atom(ArgVAtom,[' '],Atoms). % TODO: treat quoting
252
253 run_probcli(ArgV,Context) :- % format(user_output,'~n* Starting probcli with argv: ~w~n~n',[ArgV]),
254 (catch(
255 run_probcli2(ArgV),
256 Exc,
257 process_exception(Exc,Context)
258 )
259 -> true
260 ; flush_output,
261 print_error('INTERNAL ERROR OCCURRED (run_probcli failed) !'),nl,
262 error_occurred(internal_error),
263 halt_exception(1)
264 ).
265
266 :- use_module(translate,[translate_error_term/2]).
267 %process_exception(Exception,_) :- write('Exception: '),write(Exception),nl,fail. % for debugging
268 process_exception(halt(A),_) :- !, throw(halt(A)).
269 process_exception('$aborted',_) :- !, throw('$aborted'). % thrown by SWI-Prolog on abort by user
270 process_exception(user_interrupt_signal,Context) :- !,
271 %add_error(probcli,'probcli interrupted by user (CTRL-C)').
272 statistics(walltime,[WStart,_]),
273 format_with_colour_nl(user_error,[red],'~nprobcli interrupted by user (CTRL-C), total walltime ~w ms',[WStart]),
274 (member(test_runner,Context)
275 -> throw(user_interrupt_signal) % will be caught by test_runner
276 ; error_occurred_with_msg(user_interrupt_signal,'probcli interrupted by user (CTRL-C)')
277 ).
278 process_exception(Exc,_) :-
279 (translate_error_term(Exc,S)
280 -> format_error_with_nl('Uncaught exception in probcli: ~w',[S])
281 ; true),
282 error_occurred(internal_error(exception(Exc))),fail.
283
284 no_command_issued :- \+ command_option(_).
285 command_option(X) :- option(X), \+ not_command_option(X).
286 not_command_option(verbose(_)).
287 not_command_option(profiling_on).
288 not_command_option(set_pref(_,_)).
289 not_command_option(set_preference_group(_,_)).
290 not_command_option(set_card(_,_)).
291 not_command_option(set_argv(_)).
292 not_command_option(silent).
293 not_command_option(strict_raise_error).
294 not_command_option(no_color).
295
296 probcli_startup :-
297 %print_total_probcli_timer,
298 startup_prob, % % startup_prob will already call init_preferences
299 %myheap_init,
300 initialise_cli.
301
302 :- load_files(library(system), [when(compile_time), imports([environ/2])]).
303 :- if(environ(prob_logging_mode,true)).
304 cli_set_options(ArgV,RemArgV) :-
305 cli_init_options(['-ll'|ArgV],RemArgV). %% adds -ll to have an automatically logging probcli to /tmp/prob_cli_debug.log
306 :- else.
307 cli_set_options(ArgV,RemArgV) :- cli_init_options(ArgV,RemArgV).
308 :- endif.
309
310 %:- use_module(extension('myheap/myheap')).
311 run_probcli2(ArgV) :- %print(probcli_startup),nl_time,
312 treat_important_options_beforehand(ArgV),
313 probcli_startup,
314 external_functions:reset_argv,
315 cli_set_options(ArgV,RemArgV), % recognise command-line options
316 %% cli_set_options(['-vv','-version'|ArgV],RemArgV), %% comment in to have an automatically verbose probcli
317 maplist(prob_cli:check_atom_looks_like_file,RemArgV),
318 (option(prolog_trace) -> error_manager:safe_trace ; true),
319 !,
320 run_probcli3(ArgV,RemArgV).
321
322 % treat important options beforehand, e.g., to enable debug prints straight-away, e.g., before probcli_startup
323 ?treat_important_options_beforehand(ArgV) :- member(Opt,ArgV),recognised_option(Opt,verbose(Nr)),!, verbose(Nr).
324 treat_important_options_beforehand(_).
325
326
327 run_probcli3(ArgV,RemArgV) :-
328 ( RemArgV=[File],no_command_issued,
329 get_filename_extension(File,Ext),
330 \+ do_not_execute_automatically(Ext)
331 % then assume we want to do -execute_all:
332 -> assert_option(execute(2147483647,false,current_state(1)))
333 ; true),
334 if_option_set(set_application_type(PAT),set_prob_application_type(PAT)),
335 if_option_set(test_mode,set_random_seed_to_deterministic_start_seed, set_new_random_seed),
336 ifm_option_set(verbose(VN),
337 verbose(VN), %tcltk_turn_debugging_on(5)),
338 tcltk_turn_debugging_off),
339 if_option_set(profiling_on,profiling_on),
340 debug_print(9,'Command Line Arguments: '),debug_println(9,ArgV),
341 (debug_level_active_for(5) -> print_options ; true),
342 debug_print(6,'Command Line File Args: '),debug_println(6,RemArgV),
343 debug_flush_output,
344 if_option_set(cache_storage(StorageDir,SetStorMode), set_storage_directory(StorageDir,SetStorMode)),
345 if_option_set(parsercp(ParserLoc),
346 (add_message(parsercp,'Command -parcercp PATH deprecated, use -p JAVA_PARSER_PATH PATH',''),
347 set_preference(path_to_java_parser,ParserLoc))
348 ),
349 if_option_set(parserport(ParserPort),
350 connect_to_external_console_parser_on_port(ParserPort)),
351 generate_time_stamp(Datime,NOW),
352 if_option_set(log(LogF,Mode),
353 cli_start_logging(LogF,Mode,NOW,Datime,RemArgV)),
354 if_option_set(runtimechecking,
355 turn_on_run_time_type_checks,
356 turn_off_run_time_type_checks),
357 if_option_set(junit(JUX),
358 set_junit_mode(JUX)),
359 set_prefs,
360 (option_verbose, (option(set_prefs_from_file(_)) ; option(set_preference_group(_,_))),
361 get_non_default_preferences(list(NDPrefs))
362 -> format('Non-default preferences:~n',[]),print_list(NDPrefs),nl ; true),
363 set_optional_errors,
364 check_unavailable_options,
365 cli_show_help(ArgV,RemArgV),
366 if_option_set(set_argv(ArgVStr),
367 set_argv(ArgVStr)),
368 if_option_set(selfcheck(_,_),
369 cli_start_selfcheck),
370 if_option_set(typechecker_test(Filename),
371 (run_typecheck_testcase(Filename,typesok) -> halt_prob(NOW,0); halt_prob(NOW,1))),
372 if_option_set(install_prob_lib(LIBTOINSTALL,INSTALLOPTS), install_prob_lib(LIBTOINSTALL,INSTALLOPTS)),
373 if_options_set(print_version(VERSIONKIND), print_version(VERSIONKIND)),
374 if_option_set(check_java_version, check_java_version),
375 (debug_level_active_for(5) -> preferences:print_preferences ; true),
376 if_option_set(zmq_worker(Identifier), zmq_start_worker(Identifier, NOW)),
377 %if_option_set(zmq_worker2(MasterIP, Port, ProxyID, Logfile), zmq_start_worker(MasterIP,Port,ProxyID,Logfile,NOW)),
378 % process remaining arguments as files to load
379 debug_println(6,processing(RemArgV)),
380 cli_load_files(RemArgV,NOW), % all CLI arguments which are not understood are supposed to be files to be treated
381 debug_println(19,finished_loading(RemArgV)),
382 if_option_set(socket(Port,Loopback),
383 cli_start_socketserver(Port,Loopback)),
384 % check_all_expected_errors_occurred(NOW), % is now checked for each file; socket_server should not generate errors ?
385 debug_println(20,'% probcli execution finished'),
386 cli_print_junit_results(ArgV),
387 debug_println(20,'% Stored Junit results'),
388 stop_xml_probcli_run(NOW),
389 debug_println(20,'% ProB Finished').
390
391 % finish logxml file by writing total number of errors and warnings
392 stop_xml_probcli_run(NOW) :-
393 get_counter(cli_errors,CErrs), get_counter(cli_warnings,CWarns), get_counter(cli_expected_errors,EErrs),
394 writeln_log_time(prob_finished(NOW,CErrs,CWarns)),
395 (EErrs>0
396 -> write_xml_element_to_log('probcli-errors',[errors/CErrs,warnings/CWarns,expected_errors/EErrs])
397 ; write_xml_element_to_log('probcli-errors',[errors/CErrs,warnings/CWarns])
398 ),
399 ((CErrs>0 ; CWarns>0) -> format(user_error,'! Total Errors: ~w, Warnings:~w~n',[CErrs,CWarns]) ; true),
400 stop_xml_group_in_log('probcli-run'). % Generating this tag means probcli ran to completion without segfault,...
401
402 % check if a cli argument looks like a proper filename
403 :- public check_file_arg/2. % is actually called when parsing options
404 check_file_arg(File,Command) :- normalise_option_atom(File,NF),
405 recognised_option(NF,_,_,_),!,
406 ajoin(['Command-line file argument for ', Command, ' looks like another probcli command: '],Msg),
407 add_warning(probcli,Msg,File).
408 check_file_arg(File,Command) :-
409 tools:check_filename_arg(File,Command).
410
411 % check if a remaining argument looks suspicious (e.g., like an unknown command)
412 check_atom_looks_like_file(Number) :- number(Number),!,
413 add_warning(probcli,'Command-line argument is a number (expected file name or probcli command): ',Number).
414 check_atom_looks_like_file(File) :- atom_codes(File,Codes),
415 check_codes_look_like_file(Codes,File).
416 check_codes_look_like_file(Codes,Arg) :-
417 check_codes_resembles_command(Codes,Arg),!.
418 check_codes_look_like_file([D|T],Arg) :- D >= 0'0, D =< 0'9,
419 nonmember(0'/,T), % detect things like 01_Jan/a.mch
420 !,
421 add_message(probcli,'Command-line argument looks like a number: ',Arg).
422 check_codes_look_like_file(_,_).
423
424 check_codes_resembles_command([45|_],Arg) :- !,
425 (get_possible_fuzzy_match_options(Arg,FuzzyMatches),
426 FuzzyMatches \= []
427 -> (FuzzyMatches=[FM]
428 -> ajoin(['Command-line argument ', Arg, ' looks like a probcli command! Did you mean: '],Msg),
429 add_warning(probcli,Msg,FM)
430 ; ajoin(['Command-line argument ', Arg, ' looks like a probcli command! Did you mean any of: '],Msg),
431 add_warning(probcli,Msg,FuzzyMatches)
432 )
433 ; get_possible_options_completion_msg(Arg,Completions)
434 -> ajoin(['Command-line argument ', Arg, ' looks like a probcli command! Did you mean: '],Msg),
435 add_warning(probcli,Msg,Completions)
436 ; add_message(probcli,'Command-line argument looks like an unknown probcli command: ',Arg)).
437
438 :- use_module(extrasrc(refinement_checker),[valid_failures_model/2]).
439 check_failures_mode(Shortcut,FailuresModel) :- valid_failures_model(FailuresModel,Shortcut),!.
440 check_failures_mode(Shortcut,trace) :-
441 add_warning(probcli,'Unrecognised refinement model flag (must be F, FD, T, R, RD, V, VD; using default trace model T): ',Shortcut).
442
443 % ----------
444
445 cli_init_options(ArgV,RemArgV) :- %print(argv(ArgV)),nl,
446 append(ProBArgV,['--'|BArgV],ArgV),!, % pass arguments after -- to B via external_functions
447 cli_init_options2(ProBArgV,RemArgV),
448 debug_println(20,set_argv_from_list(BArgV)),
449 external_functions:set_argv_from_list(BArgV).
450 cli_init_options(ArgV,RemArgV) :- cli_init_options2(ArgV,RemArgV).
451 cli_init_options2(ArgV,RemArgV) :-
452 reset_options,
453 %%assertz(option(log('/tmp/ProBLog.log'))), print('LOGGING'),nl, %% coment in to build a version of probcli that automatically logs
454 ( get_options(ArgV,recognised_cli_option,Options,RemArgV,throw(halt(1))) ->
455 assert_all_options(Options)
456 ;
457 print_error(get_options_failed(ArgV)),definite_error_occurred).
458 cli_show_help(ArgV,RemArgV) :-
459 ( (option(help) ; ArgV=[]) ->
460 print_help, (RemArgV=[] -> halt_exception ; true)
461 ; true).
462 cli_start_logging(F,Mode,NOW,Datime,RemArgV) :-
463 debug_print(20,'%logging to: '), debug_println(20,F),
464 set_log_file(F), set_logging_mode(Mode),
465 start_xml_group_in_log('probcli-run'),
466 writeln_log(start_logging(NOW,F)),
467 version(V1,V2,V3,Suffix), revision(Rev), lastchangeddate(LCD),
468 writeln_log(version(NOW,V1,V2,V3,Suffix,Rev,LCD)), % still used by log_analyser
469 current_prolog_flag(version,PV),
470 write_xml_element_to_log(version,[major/V1,minor/V2,patch/V3,suffix/Suffix,revision/Rev,lastchanged/LCD,prolog/PV]),
471 findall(Opt, option(Opt), Options),
472 write_prolog_term_as_xml_to_log(options(NOW,Options)),
473 write_prolog_term_as_xml_to_log(files(NOW,RemArgV)), %
474 datime(Datime,DateRecord),
475 writeln_log(date(NOW,DateRecord)),
476 (DateRecord=datime(Yr,Mon,Day,Hr,Min,Sec)
477 -> write_xml_element_to_log(date,[year/Yr,month/Mon,day/Day,hour/Hr,minutes/Min,seconds/Sec]) ; true).
478
479 cli_start_selfcheck :-
480 %clear_loaded_machines_wo_errors,
481 b_set_initial_machine,
482 set_animation_mode(b),
483 store_virtual_event(clear_specification), % TO DO: try and get rid of the need for this
484 start_animation,
485 option(selfcheck(ModuleCombo,Opts)),
486 (atom(ModuleCombo),
487 atom_split(Module,':',TestNrA,ModuleCombo)
488 -> convert_atom_to_number(TestNrA,TestNr),
489 Opts2=[run_only_nr(TestNr)|Opts]
490 ; Module=ModuleCombo, Opts2=Opts
491 ),
492 (option(silent) -> Opts3=[silent|Opts2] ; option_verbose -> Opts3=[verbose|Opts2] ; Opts3=Opts2),
493 (perform_self_check(Module,Opts3) -> true ; error_occurred(selfcheck)),
494 fail.
495 cli_start_selfcheck.
496
497
498 :- dynamic file_loaded/2.
499 file_loaded(Status) :- file_loaded(Status,_File).
500
501
502 cli_load_files([],NOW) :- % no files are provided
503 !,
504 ( options_allow_start_without_file
505 -> debug_format(19,'Using empty machine to process probcli command~n',[]),
506 cli_set_empty_machine
507 ; we_did_something -> true
508 ; print('No file to process'),nl),
509 writeln_log_time(start_processing_empty_machine(NOW)),
510 start_xml_feature(process_file,filename,'$EMPTY_MACHINE',FINFO),
511 cli_process_loaded_file(NOW,'$EMPTY_MACHINE'),
512 check_all_expected_errors_occurred(NOW), % check that all expected errors occurred; below they will be checked for each file
513 stop_xml_feature(process_file,FINFO),
514 (option(benchmark_info_csv_output(_,_,_)) -> print_accumulated_infos(0) ; true).
515 cli_load_files(RemArgV,NOW) :-
516 cli_load_files2(RemArgV,NOW,0).
517
518
519 cli_set_empty_machine :- % TO DO: do this more properly here and for initialise_required
520 set_animation_mode(b),
521 bmachine:b_set_empty_machine,
522 assertz(file_loaded(true,'$$empty_machine')).
523
524 empty_machine_loaded :- file_loaded(true,'$$empty_machine').
525
526
527 options_allow_start_without_file :- option(run_benchmark(_,_,_)).
528 options_allow_start_without_file :- option(eval_repl(_)).
529 options_allow_start_without_file :- option(eval_string_or_file(_,_,_,_,_)).
530 options_allow_start_without_file :- option(check_log(_)).
531 options_allow_start_without_file :- option(process_latex_file(_,_)).
532 options_allow_start_without_file :- option(socket(_,_)).
533
534 we_did_something :- option(print_version(_)).
535 we_did_something :- option(check_java_version).
536 we_did_something :- option(check_parser_version).
537 we_did_something :- option(install_prob_lib(_,_)).
538
539 option_only_works_for_single_file(zmq_assertion(_Identifier)).
540 option_only_works_for_single_file(zmq_master(_Identifier)).
541
542 clear_loaded_files :-
543 (file_loaded(_) -> clear_loaded_machines_wo_errors ; true).
544
545 % called if we have at least one file
546 cli_load_files2([],_,NrFilesProcessed) :- !,
547 debug_println(19,finished_procesing_all_files(NrFilesProcessed)),
548 print_accumulated_infos(NrFilesProcessed). % print summary of all runs for different files
549 cli_load_files2([F1,F2|T],NOW,_NrFilesProcessed) :-
550 option(Option),
551 option_only_works_for_single_file(Option),!,
552 add_error(probcli,'The following option can only be used for a single file: ',Option),
553 add_error(probcli,'Multiple files provided: ',[F1,F2|T]),
554 halt_prob(NOW,0).
555 cli_load_files2(RemArgV,NOW,NrFilesProcessed) :-
556 %print_total_probcli_timer,
557 clear_loaded_files,
558 retractall(file_loaded(_,_)),
559 RemArgV = [MainFile0|Rest],!,
560 N1 is NrFilesProcessed+1,
561 cli_load_files3(MainFile0,Rest,NOW,N1).
562 cli_load_files3(MainFile0,Rest,NOW,NrOfFile) :-
563 safe_absolute_file_name(MainFile0,MainFile,[access(none)]), % converts Windows slash into Unix slash,...
564 if_option_set(file_info,print_file_info(MainFile)),
565 ((Rest=[_|_] ; NrOfFile>1)
566 -> length(Rest,RLen), Tot is NrOfFile+RLen,
567 format('~n~n% Processing file ~w/~w: ~w~n',[NrOfFile,Tot,MainFile]) % was formatsilent
568 ; true),
569 start_xml_feature(process_file,filename,MainFile,FINFO),
570 ( file_exists(MainFile) ->
571 debug_println(6,file_exists(MainFile)),
572 ( load_main_file(MainFile,NOW,Already_FullyProcessed) ->
573 (Already_FullyProcessed==true
574 -> true
575 ; assertz(file_loaded(true,MainFile)),
576 trimcore_if_useful(Rest),
577 writeln_log_time(start_processing(NOW)),
578 start_probcli_timer(Timer),
579 catch((cli_process_loaded_file(NOW,MainFile)
580 -> stop_probcli_debug_timer(Timer,'% Finished processing file after')
581 ; print_error('Processing or loading file failed: '), print_error(MainFile),
582 start_repl_even_after_failure
583 ),
584 user_interrupt_signal, % catch CTRL-C by user but give chance to enter REPL
585 start_repl_even_after_failure
586 ),
587 writeln_log_time(finished_processing(NOW))
588 )
589 ;
590 assertz(file_loaded(error,MainFile)),
591 print_error('Loading Specification Failed'),
592 writeln_log_time(loading_failed(NOW,MainFile)),
593 error_occurred(load_main_file)
594 %start_repl_even_after_failure : TODO: fix issues with bmachine not precompiled and counter extension
595 ),
596 nls,
597 ifm_option_set(indent_b_file(PPFILE0),
598 indent_b_file(PPFILE0)),
599 ifm_option_set(pretty_print_prolog_file(PPFILE0),
600 pretty_print_prolog_file(PPFILE0))
601 ; % not file_exists
602 nl, assertz(file_loaded(error,MainFile)),
603 (number(MainFile0)
604 -> add_error(load_main_file,'Command-line argument is a number which is not associated with a command and does not exist as file: ',MainFile0)
605 ; atom_codes(MainFile0,[45|_]) % starts with a dash - : probably an illegal command-line option
606 -> add_error(load_main_file,'Specified option or file does not exist: ',MainFile0)
607 ; get_filename_extension(MainFile,Ext), \+ known_spec_file_extension(Ext,_)
608 -> (Ext = '' -> EMsg = 'Specified file does not exist and has no file extension:'
609 ; ajoin(['Specified file does not exist and has an unrecognised file extension ".',Ext,'" :'], EMsg)
610 ),
611 add_error(load_main_file,EMsg,MainFile)
612 ; add_error(load_main_file,'Specified file does not exist:',MainFile)
613 )
614 ),
615 check_all_expected_errors_occurred(NOW),
616 stop_xml_feature(process_file,FINFO),
617
618 debug_println(19,reset_expected_error_occurred),
619 reset_expected_error_occurred, % reset for next file
620 debug_println(19,resetting_errors),
621 reset_errors,
622 debug_println(19,update_time_stamp),
623 NOW1 is NOW+1,
624 update_time_stamp(NOW1),
625 debug_println(19,remaining_files_to_process(Rest)),
626 cli_load_files2(Rest,NOW1,NrOfFile).
627
628 start_repl_even_after_failure :-
629 (option(eval_repl([]))
630 -> format_with_colour_nl(user_output,[blue],'Starting REPL, but ignoring any other commands',[]),
631 % TODO: check if setup_constants_fails and then suggest e.g. :core @PROPERTIES command
632 start_repl_if_required % can be useful to debug properties, e.g, one can fix an error and reload
633 ; true
634 ).
635
636 print_file_info(F) :-
637 print('Specification_File('), print(F), print(')'),nl.
638
639 :- use_module(probsrc(tools),[statistics_memory_used/1]).
640 trimcore_if_useful(_) :- option(release_java_parser),!, prob_trimcore.
641 % if user wants to release java parser, this is an indication that the .prob files are big and it can be good to free memory
642 trimcore_if_useful([]) :- % try and reduce Prologs memory consumption, see also PROLOGKEEPSIZE parameter
643 % a lot of memory can be consumed loading .prob file and doing machine construction
644 !,
645 (option(X), memory_intensive_option(X)
646 -> debug_format(9,'Not trimming memory usage because of memory intensive option: ~w~n',[X])
647 ; statistics_memory_used(M), M< 300000000 % less than 300 MB used
648 -> debug_format(9,'Not trimming memory usage because of memory used is already low: ~w~n',[M])
649 ; prob_trimcore
650 ).
651 trimcore_if_useful(_) :- debug_println(9,'Not trimming memory usage as there are still files to process').
652
653 prob_trimcore :- (option_verbose ; option(release_java_parser)),!,prob_trimcore_verbose.
654 prob_trimcore :- prob_trimcore_silent.
655
656 prob_trimcore_verbose :-
657 print('Memory used before trimming: '),print_memory_used_wo_gc,flush_output, nl_time,
658 prob_trimcore_silent,
659 print('Memory used after trimming : '),print_memory_used_wo_gc,flush_output, nl_time.
660 prob_trimcore_silent :-
661 garbage_collect, % is important, otherwise trimming may achieve very little
662 trimcore.
663
664 memory_intensive_option(cli_mc(_)).
665 memory_intensive_option(ltl_formula_model_check(_,_)).
666 memory_intensive_option(ctl_formula_model_check(_,_)).
667 memory_intensive_option(pctl_formula_model_check(_,_)).
668 memory_intensive_option(refinement_check(_,_,_)).
669 memory_intensive_option(generate_all_traces_until(_,_,_)).
670
671 % ---------------------
672
673 % process all the commands for a loaded file:
674 cli_process_loaded_file(NOW,MainFile) :-
675 (real_error_occurred -> print_error('% *** Errors occurred while loading ! ***'),nl,nl ; true),
676 get_errors, reset_errors,
677 if_option_set(kodkod_performance(KPFile,Iterations),
678 compare_kodkod_performance1(KPFile,Iterations,NOW)),
679 if_option_set(kodkod_comparision(MaxResiduePreds),
680 test_kodkod_and_exit(MaxResiduePreds,NOW)),
681 % if_option_set(add_csp_guide(CspGuide), tcltk_add_csp_file(CspGuide)), %% moved to later to ensure B machine is precompiled; allows e.g. type_check_csp_and_b to run
682
683 if_option_set(csp_main(MAINPROC),
684 set_cspm_main_process(MAINPROC)),
685
686 if_option_set(zmq_master(Identifier), zmq_start_master(invariant,Identifier)),
687 %if_option_set(zmq_master(IP, Logfile), zmq_start_master(invariant,200,-1,5000,0,IP,Logfile)),
688
689 ifm_option_set(check_machine_file_sha(FileToCheck,ExpectedSha1Hash),
690 check_machine_file_sha(FileToCheck,ExpectedSha1Hash)),
691 ifm_option_set(clear_value_persistance_cache(MachineToClear),
692 delete_cache_files_for_machine(MachineToClear)),
693 ifm_option_set(clear_value_persistance_cache,
694 delete_cache_files),
695
696 % STARTING ANIMATION/MODEL CHECKING
697 cli_start_animation(NOW),
698
699 if_option_set_loaded(cli_core_properties(MaxCoreSize),cli_core_properties,
700 cli_core_properties(MaxCoreSize)),
701
702 if_option_set_loaded(default_trace_check,default_trace_check,
703 cli_start_default_trace_check(MainFile)),
704 if_option_set_loaded(trace_check(TrStyle,TraceFile,ChkMode),trace_check,
705 cli_start_trace_check(TrStyle,TraceFile,ChkMode)),
706
707 cli_process_loaded_file_afer_start_animation(NOW).
708
709 cli_process_loaded_file_afer_start_animation(NOW) :-
710 ifm_option_set(cli_print_machine_info(IKind),
711 cli_print_machine_info(IKind)),
712 ifm_option_set(pretty_print_internal_rep(PPFILE1,MachName1,TYPES1,ASCII1),
713 pretty_print_internal_rep(PPFILE1,MachName1,TYPES1,ASCII1)),
714 ifm_option_set(pretty_print_internal_rep_to_B(PPFILE3),
715 b_write_eventb_machine_to_classicalb_to_file(PPFILE3)),
716
717 if_option_set_loaded(state_trace(TraceFile),state_trace,
718 cli_start_trace_state_check(TraceFile)),
719
720 if_option_set(evaldot(EvalDotF),
721 set_eval_dot_file(EvalDotF)),
722
723 (initialise_required
724 -> check_loaded(initialise),
725 cli_start_initialisation(NOW),
726 writeln_log_time(initialised(NOW))
727 ; true),
728 if_option_set(check_abstract_constants,
729 check_abstract_constants),
730
731 if_option_set(zmq_assertion(Identifier),
732 zmq_start_master(assertion,Identifier)),
733
734 if_option_set(cli_lint,cli_lint(_)),
735 ifm_option_set_loaded(cli_lint(LintCheck),cli_lint,cli_lint(LintCheck)),
736 if_option_set(cli_wd_check(Disch,TotPos),cli_wd_check(Disch,TotPos)),
737 if_option_set(cli_wd_inv_proof(UnchangedNr,ProvenNr,TotPOsNr),cli_wd_inv_proof(UnchangedNr,ProvenNr,TotPOsNr)),
738 if_option_set(cli_start_mc_with_tlc,cli_start_mc_with_tlc),
739 if_option_set(cli_start_sym_mc_with_lts(LType),cli_start_sym_mc_with_lts(LType)),
740
741 if_option_set(cli_symbolic_model_check(Algorithm),cli_symbolic_model_check(Algorithm)),
742
743 if_option_set_loaded(cli_check_properties,check_properties,
744 cli_check_properties(NOW)),
745 ifm_option_set_loaded(cli_check_assertions(ALL,ReqInfos),check_assertions,
746 cli_check_assertions(ALL,ReqInfos,NOW)),
747 if_option_set(set_goal(GOAL),
748 cli_set_goal(GOAL)),
749 if_option_set(set_searchscope(SCOPE),
750 cli_set_searchscope(SCOPE)),
751 ifm_option_set_loaded(cli_mc(Nr,MCOpts),model_check,
752 cli_start_model_check(Nr,NOW,MCOpts)),
753 ifm_option_set_loaded(cli_random_animate(Steps,ErrOnDeadlock),animate,
754 cli_random_animate(NOW,Steps,ErrOnDeadlock)),
755 ifm_option_set_loaded(execute(ESteps,ErrOnDeadlock,From),execute,
756 cli_execute(ESteps,ErrOnDeadlock,From)),
757 ifm_option_set_loaded(animate_until_ltl(LTLFormula,ExOption,ExpResult,ExpSteps),execute,
758 animate_until_ltl(LTLFormula,ExOption,ExpResult,ExpSteps)),
759 if_option_set_loaded(pa_check,predicate_analysis,
760 test_predicate_analysis),
761
762 cbc_check(NOW),
763
764 ifm_option_set_loaded(logxml_write_ids(Prefix,IDScope),logxml_write_ids,
765 logxml_write_ids(Prefix,IDScope)),
766
767 if_options_set(generate_read_write_matrix_csv(RWCsvFile),
768 generate_read_write_matrix(RWCsvFile)),
769 if_options_set(feasibility_analysis_csv(TimeOut,EnablingCsvFile),
770 do_feasibility_analysis(TimeOut,EnablingCsvFile)),
771 ifm_option_set_loaded(mcm_tests(ADepth1,AMaxS,ATarget1,Output1),mcm_test_cases,
772 mcm_test_case_generation(ADepth1,AMaxS,ATarget1,Output1)),
773 ifm_option_set_loaded(all_deadlocking_paths(File),all_deadlocking_paths,
774 write_all_deadlocking_paths_to_xml(File)),
775 ifm_option_set_loaded(cbc_tests(ADepth2,ATarget2,Output2),cb_test_cases,
776 cbc_test_case_generation(ADepth2,ATarget2,Output2)),
777 ifm_option_set_loaded(test_description(TestDescFile),cb_test_cases,
778 test_generation_by_xml_description(TestDescFile)),
779 if_options_set(csp_in_situ_refinement_check(RP,RType,RQ),
780 cli_csp_in_situ_refinement_check(RP,RType,RQ,NOW)),
781 if_options_set(csp_checkAssertion(Proc,Model,AssertionType),
782 cli_checkAssertion(Proc,Model,AssertionType,NOW)),
783 if_options_set(check_csp_assertion(Assertion),
784 cli_check_csp_assertion(Assertion,NOW)),
785 if_options_set(refinement_check(RefFile,PerformSingleFailures,RefNrNodes),
786 cli_start_refinement_check(RefFile,PerformSingleFailures,RefNrNodes,NOW)),
787 if_options_set(ctl_formula_model_check(CFormula,CExpected),
788 (timeout_call(cli_ctl_model_check(CFormula,init,CExpected,_),NOW,ctl_model_check) -> true; true)),
789 if_options_set(pctl_formula_model_check(PFormula,PExpected),
790 (timeout_call(cli_pctl_model_check(PFormula,init,PExpected,_),NOW,ctl_model_check) -> true; true)),
791 % TO DO print ctl/ltl statistics
792 if_options_set(csp_get_assertions,cli_csp_get_assertions),
793 if_options_set(eval_csp_expression(CspExpr),cli_eval_csp_expression(CspExpr)),
794 if_options_set(csp_translate_to_file(PlFile),cli_csp_translate_to_file(PlFile)),
795 if_options_set(get_coverage_information(CovFileName),cli_get_coverage_information(CovFileName)), %% TODO: replace
796 if_options_set(vacuity_check,cli_vacuity_check),
797 if_option_set_loaded(check_goal,check_goal,cli_check_goal),
798 if_option_set_loaded(animate,animate,
799 (interactive_animate_machine -> true ; true)),
800 if_option_set(ltsmin, start_ltsmin_srv('/tmp/ltsmin.probz', NOW)),
801 if_option_set(ltsmin2(EndpointPath), start_ltsmin_srv(EndpointPath, NOW)),
802 if_option_set(ltsmin_ltl_output(Path), ltsmin_ltl_output(Path, NOW)),
803 if_options_set(run_benchmark(Kind,Option,Path), run_benchmark(Kind,Option,Path)),
804 evaluate_from_commandline,
805 if_option_set_loaded(ltl_assertions,check_ltl_assertions,
806 (timeout_call(ltl_check_assertions,NOW,check_ltl_assertions) -> true; true)),
807 ifm_option_set_loaded(ltl_formula_model_check(LFormula,LExpected),check_ltl_assertions,
808 (option(cli_start_sym_mc_with_lts(_))-> true % we request LTSMin, do not start prob model check
809 ; timeout_call(cli_ltl_model_check(LFormula,init,LExpected,_),NOW,ltl_formula_model_check)
810 -> true; true)),
811 ifm_option_set_loaded(ltl_file(LtlFilename),check_ltl_file,
812 (ltl_check_file(LtlFilename) -> true; true)),
813 ifm_option_set_loaded(visb_history(VJSONFile,VHTMLFile,Options),visb,
814 cli_visb_history(VJSONFile,VHTMLFile,Options)),
815 ifm_option_set_loaded(history(HistoryFilename),history,
816 cli_print_history(HistoryFilename)),
817 ifm_option_set_loaded(print_values(ValuesFilename),sptxt,
818 cli_print_values(ValuesFilename)),
819 ifm_option_set_loaded(print_all_values(ValuesDirname),print_all_values,
820 cli_print_all_values(ValuesDirname)),
821 ifm_option_set_loaded(generate_all_traces_until(LTL_Stop_AsAtom,FilePrefix),generate_all_traces_until,
822 cli_generate_all_traces_until(LTL_Stop_AsAtom,FilePrefix)),
823 if_options_set(save_state_for_refinement(SaveRefF),
824 tcltk_save_specification_state_for_refinement(SaveRefF)),
825 if_options_set(rule_report(File),
826 rule_validation:generate_report(File)),
827 if_options_set(dot_command(DCommand1,DotFile1,DotEngine1),
828 dot_command(DCommand1,DotFile1,DotEngine1)),
829 if_options_set(dot_command_for_expr(DECommand,Expr,DotFile,Opts,DotEngine),
830 dot_command_for_expr(DECommand,Expr,DotFile,Opts,DotEngine)),
831 if_options_set(plantuml_command(PCommand1,UmlFile1),
832 plantuml_command(PCommand1,UmlFile1)),
833 if_options_set(plantuml_command_for_expr(PECommand,Expr,UmlFile,Opts),
834 plantuml_command_for_expr(PECommand,Expr,UmlFile,Opts)),
835 if_options_set(csv_table_command(TECommand,TableFormulas,TableOptions,TableCSVFile),
836 csv_table_command(TECommand,TableFormulas,TableOptions,TableCSVFile)),
837 if_options_set(evaluate_expression_over_history_to_csv_file(HistExpr,HistDotFile),
838 tcltk_interface:evaluate_expression_over_history_to_csv_file(HistExpr,HistDotFile)),
839 if_options_set(enabling_analysis_csv(EnablingCsvFile),
840 do_enabling_analysis_csv(EnablingCsvFile,NOW)),
841 if_options_set(process_latex_file(LatexF1,LatexF2),
842 process_latex_file(LatexF1,LatexF2)),
843 ifm_option_set(coverage(Nodes,Operations,ShowEnabledInfo),
844 cli_show_coverage(Nodes,Operations,ShowEnabledInfo,NOW)),
845 ifm_option_set(check_statespace_hash(ExpectedHash,Kind),
846 cli_check_statespace_hash(ExpectedHash,Kind)),
847 ifm_option_set(check_op_cache(ExpectedC),
848 cli_check_op_cache(ExpectedC)),
849 ifm_option_set(coverage(ShowEnabledInfo),
850 cli_show_coverage(ShowEnabledInfo,NOW)),
851 if_option_set(save_state_space(StateFile),
852 save_state_space(StateFile)),
853 ifm_option_set(cli_print_statistics(SPARA),
854 cli_print_statistics(SPARA)),
855 if_option_set(show_cache(SCVM),
856 show_cache(SCVM)),
857 if_option_set(cli_cache_stats_check(CStats),cli_cache_stats_check(CStats)),
858 if_option_set(check_complete, check_complete),
859 if_option_set(check_complete_operation_coverage, check_complete_operation_coverage),
860 if_option_set(check_scc_for_ltl_formula(LtlFormula,SCC),cli_check_scc_for_ltl_formula(LtlFormula,SCC)).
861
862 % what needs to be done for files like .po files, where all processing is already done:
863 cli_process_options_for_alrady_fully_processed_file(_MainFile) :-
864 ifm_option_set(cli_print_statistics(SPARA),
865 cli_print_statistics(SPARA)).
866
867 show_cache(default) :- !,
868 (option_verbose -> show_cache(normal) ; show_cache(verbose)).
869 show_cache(Verbose) :-
870 show_cache_file_contents(Verbose).
871
872 cli_cache_stats_check(Expected) :-
873 get_value_persistance_stats(Stats),
874 check_required_infos(Expected,Stats,check_cache_stats).
875
876 % new profiler
877 %:- use_module('../extensions/profiler/profiler.pl').
878 %cli_print_statistics :- pen,nl,garbage_collect,statistics,nl,state_space:state_space_initialise_with_stats.
879
880 :- use_module(runtime_profiler,[print_runtime_profile/0]).
881 :- use_module(source_profiler,[print_source_profile/0]).
882 :- use_module(memoization,[print_memo_profile/0]).
883 :- use_module(state_packing,[print_state_packing_profile/0]).
884 :- use_module(external_functions,[print_external_function_instantiation_profile/0]).
885
886 % old profiler
887 :- use_module(covsrc(hit_profiler),[print_hit_profile_statistics/0]).
888 :- use_module(extrasrc(b_operation_cache),[print_op_cache_profile/0, reset_b_operation_cache_with_statistics/0]).
889 :- use_module(memoization,[reset_memo_with_statistics/0]).
890 :- use_module(disproversrc(disprover),[print_prover_result_stats/0]).
891 :- use_module(probsrc(tools),[print_mb/1]).
892 cli_print_statistics(memory) :- !,
893 print_memory_statistics(user_output).
894 cli_print_statistics(value_persistance_stats) :- !,
895 print_value_persistance_stats.
896 cli_print_statistics(sicstus_profile) :- !,
897 format('SICStus Prolog PROFILE STATISTICS~n',[]),
898 sicstus_profile_statistics.
899 cli_print_statistics(disprover_profile) :- !,
900 print_prover_result_stats.
901 cli_print_statistics(prob_profile) :- !,
902 statistics(walltime,[WT,_]),
903 statistics(runtime,[RT,_]),
904 format('--------------------------~nPROB PROFILING INFORMATION after ~w ms walltime (~w ms runtime) ',[WT,RT]),
905 statistics_memory_used(M), print_mb(M),nl,
906 print_source_profile,
907 print_runtime_profile,
908 print_memo_profile,
909 print_state_packing_profile,
910 print_external_function_instantiation_profile,
911 (get_preference(operation_reuse_setting,false) -> true ; print_op_cache_profile). % relevant for test 2152 under SWI
912 cli_print_statistics(hit_profile) :- !,
913 (print_hit_profile_statistics -> true ; true). % mainly used by external functions
914 cli_print_statistics(op_cache_profile) :- !,
915 get_preference(try_operation_reuse,OR),
916 format('PROB OPERATION_REUSE (value:~w) STATISTICS~n',[OR]),
917 print_op_cache_profile.
918 cli_print_statistics(full) :- format('PROB FULL STATISTICS~n',[]),
919 sicstus_profile_statistics,
920 garbage_collect,
921 statistics,
922 nl,
923 print_op_cache_profile,
924 print_prover_result_stats,
925 state_space:state_space_initialise_with_stats,
926 reset_memo_with_statistics,
927 reset_b_operation_cache_with_statistics.
928
929 print_memory_statistics(Stream) :-
930 garbage_collect,
931 write(Stream,'ProB memory used: '),
932 print_memory_used_wo_gc(Stream), nl(Stream), flush_output(Stream).
933
934 sicstus_profile_statistics :-
935 %(hit_profiler:print_hit_profile_statistics -> true ; true), % only used by external functions
936 (option(profiling_on)
937 -> catch(print_profile,
938 error(existence_error(_,_),_),
939 print_red('SICStus Prolog Profiler can only be used when running from source'))
940 ; true).
941
942
943 :- use_module(state_space,[not_all_transitions_added/1, not_invariant_checked/1,
944 not_interesting/1, get_operation_name_coverage_infos/4]).
945 check_complete :-
946 (tcltk_find_max_reached_node(Node1) ->
947 add_error(check_complete,'Maximum number of transitions reached for at least one state: ',Node1) ; true),
948 (not_all_transitions_added(Node2) ->
949 add_error(check_complete,'At least one state was not examined: ',Node2) ; true),
950 (not_invariant_checked(Node3) ->
951 add_error(check_complete,'The invariant was not checked for at least one state: ',Node3) ; true),
952 (not_interesting(Node4) ->
953 add_message(check_complete,'At least one state was ignored (not satisfying the SCOPE predicate): ',Node4) ; true).
954
955 check_complete_operation_coverage :-
956 (state_space: operation_name_not_yet_covered(OpName) ->
957 add_error(check_complete_operation_coverage,'At least one operation is not covered: ', OpName)
958 ; true).
959
960 show_operation_coverage_summary(NOW) :-
961 get_operation_name_coverage_infos(PossibleNr,FeasibleNr,UncovNr,UncoveredList),
962 writeln_log(uncovered_info(NOW,PossibleNr,UncoveredList)),
963 (UncovNr=0 -> format(' All ~w possible operations have been covered',[PossibleNr]),nl
964 ; (FeasibleNr=PossibleNr
965 -> format(' The following ~w operations (out of ~w) were not covered:~n ~w~n',
966 [UncovNr, PossibleNr,UncoveredList])
967 ; INr is PossibleNr-FeasibleNr,
968 format(' The following ~w operations (out of ~w with ~w infeasible) were not covered:~n ~w~n',
969 [UncovNr, PossibleNr, INr,UncoveredList])
970 )).
971 show_initialisation_summary(NOW) :-
972 findall(ID,state_space:is_concrete_constants_state_id(ID),L),
973 length(L,Nr), N1 is Nr+1, % for root
974 writeln_log(uninitialised_states(NOW,N1)),
975 format(' Uninitialised states: ~w (root and constants only)~n',[N1]).
976
977 % ---------------------
978
979 animation_mode_does_not_support_animation(File) :-
980 loaded_main_file(smt2,File).
981 cli_start_animation(NOW) :-
982 file_loaded(true,LoadedFile),
983 \+ animation_mode_does_not_support_animation(LoadedFile),
984 !,
985 debug_println(20,'% Starting Animation'),
986 writeln_log_time(start_animation(NOW)),
987 start_probcli_timer(Timer1),
988 start_animation_without_computing,
989 stop_probcli_debug_timer(Timer1,'% Finished Starting Animation'),
990 if_option_set(add_csp_guide(CspGuide), tcltk_add_csp_file(CspGuide)),
991
992 xml_log_machine_statistics,
993 getAllOperations(Ops),
994 debug_print(20,'Operations: '), debug_println(20,Ops),
995
996 (we_need_only_static_assertions(ALL)
997 -> debug_println(20,'% Projecting on static ASSERTIONS'),
998 b_interpreter:set_projection_on_static_assertions(ALL) ; true),
999
1000 (option(load_state(File))
1001 -> debug_println(20,'% Loading stored state from file'),
1002 state_space:tcltk_load_state(File)
1003 ; computeOperations_for_root_required ->
1004 debug_println(20,'% Searching for valid initial states'),
1005 start_probcli_timer(Timer2),
1006 cli_computeOperations(EO),
1007 stop_probcli_debug_timer(Timer2,'% Finished searching for valid initial states'),
1008 debug_println(10,EO)
1009 ; debug_println(20,'% No initialisation required')
1010 ).
1011 cli_start_animation(_NOW).
1012
1013 start_animation_without_computing :-
1014 update_preferences_from_spec(ListOfPrefs),
1015 (ListOfPrefs=[] -> true ; write_prolog_term_as_xml_to_log(b_machine_preferences(ListOfPrefs))),
1016 set_prefs, % override SET_PREF in DEFINITIONS with values from command-line;
1017 start_animation,
1018 ifm_option_set(add_additional_property(PROP),
1019 cli_add_additional_property(PROP)),
1020 get_errors.
1021
1022 animate_until_ltl(LTLFormula,ExOption,ExpectedResult,ExpectedNrSteps) :-
1023 tcltk_animate_until(LTLFormula,ExOption,StepsExecuted,Result),
1024 formatsilent('Found trace of length ~w for LTL formula. Result: ~w ~n',[StepsExecuted,Result]),
1025 print_history_as_counter_example(false), % TODO: only print from current id before command
1026 (ExpectedResult=Result -> true % Result can be ltl_found, maximum_nr_of_steps_reached, deadlock
1027 ; add_error(animate_until_ltl,'Unexpected animation result: ',Result),
1028 error_occurred(animate_until_ltl)
1029 ),
1030 (ExpectedNrSteps=StepsExecuted -> true
1031 ; add_error(animate_until_ltl,'Unexpected number of animation steps: ',StepsExecuted),
1032 error_occurred(animate_until_ltl)
1033 ).
1034
1035 % ---------------------
1036
1037 % an execution engine with minimal overhead: states are not stored in visited_expression database, only first enabled operation is taken
1038
1039 cli_execute(Steps,ErrorOnDeadlock,FromWhere) :-
1040 temporary_set_preference(operation_reuse_setting,false,ChangeOccured),
1041 (ChangeOccured=true % operation reuse not compatible with cut used below after solution found
1042 -> add_message(execute_model,'Disabling OPERATION_REUSE preference for -execute ',Steps) ; true),
1043 call_cleanup(cli_execute2(Steps,ErrorOnDeadlock,FromWhere),
1044 reset_temporary_preference(operation_reuse_setting,ChangeOccured)).
1045 cli_execute2(Steps,ErrorOnDeadlock,FromWhere) :-
1046 FromWhere=from_all_initial_states,!,
1047 % try out all initial states and from each of those perform deterministic execution
1048 start_ms_timer(Start),
1049 format('Running execute from all initial states~n',[]),
1050 reset_counter(cli_execute_inits),
1051 findall(Result,
1052 (cli_trans(root,Action,CurState,0,'$NO_OPERATION'), %print(Action),nl,
1053 (\+ functor(Action,'$setup_constants',_)
1054 -> inc_counter(cli_execute_inits,Nr),
1055 format('~nExecuting model from initial state ~w~n',[Nr]),
1056 (option(animate_stats) -> print_state_silent(CurState) ; true),
1057 (cli_execute_from(CurState,Steps,ErrorOnDeadlock,1,Result) -> true)
1058 ; format('~nInitialising state~n',[]), % we need to execute initialise_machine
1059 cli_trans(CurState,_ActionName,NewState,0,'$NO_OPERATION'),
1060 inc_counter(cli_execute_inits,Nr),
1061 format('~nExecuting model from initial state ~w with constants~n',[Nr]),
1062 (option(animate_stats) -> print_state_silent(NewState) ; true),
1063 (cli_execute_from(NewState,Steps,ErrorOnDeadlock,2,Result) -> true)
1064 )), Results),
1065 get_counter(cli_execute_inits,Nr),
1066 format('---------~nTotal runtime for all ~w executions:',[Nr]),nl,
1067 stop_ms_timer(Start),
1068 count_occurences(Results,Occs), format('Results: ~w~n',[Occs]).
1069 cli_execute2(Steps,ErrorOnDeadlock,current_state(Repetitions)) :-
1070 current_expression(ID,CurState),
1071 start_xml_feature(execute,max_steps,Steps,FINFO),
1072 start_ms_timer(Start),
1073 (between(1,Repetitions,RepNr),
1074 % with -strict option we will stop after first error found
1075 % for repetitions you should probably set RANDOMISE_OPERATION_ORDER and RANDOMISE_ENUMERATION_ORDER to TRUE
1076 debug_format(19,'Starting execute (~w/~w) from state ~w with maximum number of steps ~w~n',[RepNr,Repetitions,ID,Steps]),
1077 (cli_execute_from(CurState,Steps,ErrorOnDeadlock,1,_Result) -> fail ; fail)
1078 ; Repetitions>1 -> stop_ms_timer_with_msg(Start,'-execute-repeat')
1079 ; true),
1080 stop_xml_feature(execute,FINFO).
1081
1082 :- use_module(bmachine,[b_top_level_operation/1]).
1083 allow_filter_unused_constants :-
1084 b_or_z_mode,
1085 b_top_level_operation(_), % we can filter out unused constants, unless there are no operations in which case the user probably wants to see the constant values
1086 \+ options_can_eval_any_cst,
1087 \+ option(cache_storage(_,_)). % we do not know what constants other machines using the cache may use
1088
1089 options_can_eval_any_cst :- option(eval_repl(_)).
1090 options_can_eval_any_cst :- option(eval_string_or_file(_,_,_,_,_)).
1091 options_can_eval_any_cst :- option(dot_command(_,_,_)).
1092 options_can_eval_any_cst :- option(dot_command_for_expr(_,_,_,_,_)).
1093 options_can_eval_any_cst :- option(process_latex_file(_,_)).
1094 options_can_eval_any_cst :- option(logxml_write_ids(all,_)). % the user writes out constants (not just variables) to file: also do not filter
1095
1096 :- dynamic execute_timeout_occurred/0.
1097
1098 cli_execute_from(CurState,Steps,ErrorOnDeadlock,FirstStepNr,Result) :-
1099 retractall(max_walltime(_,_,_)),
1100 retractall(execute_timeout_occurred),
1101 start_ms_timer(Start),
1102 (allow_filter_unused_constants -> temporary_set_preference(filter_unused_constants,true,CHNG) ; true),
1103 cli_execute_aux(FirstStepNr,Steps,CurState,_MEMO,ErrorOnDeadlock,'$NO_OPERATION',Result),
1104 (allow_filter_unused_constants -> reset_temporary_preference(filter_unused_constants,CHNG) ; true),
1105 (option(silent) -> true ; stop_ms_timer_with_msg(Start,'-execute')),
1106 print_max_walltime.
1107
1108 :- use_module(tools_strings,[ajoin/2, ajoin_with_sep/3]).
1109 :- use_module(external_functions,[reset_side_effect_occurred/0, side_effect_occurred/1]).
1110 cli_execute_aux(Nr,Steps,CurState,_,_ErrorOnDeadlock,_LastActionName,Result) :- Nr>Steps,!,
1111 formatsilent('Stopping execution after ~w steps~n',[Steps]), Result = stopped,
1112 print_state_silent(CurState),
1113 cli_execute_add_virtual_transition(Steps,CurState,Result).
1114 cli_execute_aux(Nr,Steps,CurState0,MEMO,ErrorOnDeadlock,LastActionName,Result) :-
1115 (Nr mod 5000 =:= 0, \+option(animate_stats), \+option(silent)
1116 -> (var(LastActionName) -> format('Step ~w~n',[Nr])
1117 ; format('Step ~w (after ~w)~n',[Nr,LastActionName])),
1118 (option_verbose -> print_state_silent(CurState0) ; true),
1119 %copy_term(CurState0,CurState), tools_printing:print_term_summary((CurState0)),nl,
1120 !,
1121 garbage_collect,
1122 !,
1123 print('Memory used: '),print_memory_used_wo_gc,flush_output,nl %nl_time
1124 ; true),
1125 prepare_state_for_specfile_trans(CurState0,unknown,MEMO,CurState), % ensure we memoize expanded constants in MEMO
1126 % avoid re-expanding constants in every state !
1127 % relevant e.g. for probcli -execute 20001 DataValidationTestSmallStep.mch -init
1128 (cli_invariant_ko(CurState,LastActionName,InvStatus,CliErr) -> % also recognises no_inv command
1129 N1 is Nr-1,
1130 ajoin(['INVARIANT ',InvStatus,' after ',N1,' steps (after ',LastActionName,').'],ErrMsg),
1131 format('~w~n',[ErrMsg]),!,
1132 print_state_silent(CurState),
1133 error_occurred_with_msg(CliErr,ErrMsg),
1134 Result=CliErr,
1135 cli_execute_add_virtual_transition(N1,CurState,Result,NewID),
1136 %(option_verbose -> b_interpreter:analyse_invariant_for_state(NewID) ; true)
1137 b_interpreter:analyse_invariant_for_state(NewID)
1138 ; cli_assertions_ko(CurState,LastActionName,AssRes) -> % also recognises no_inv command
1139 N1 is Nr-1,
1140 format('ASSERTIONS ~w after ~w steps (after ~w).~n',[AssRes,N1,LastActionName]),!,
1141 print_state_silent(CurState),
1142 error_occurred(assertion_violation), Result=assertion_violation,
1143 cli_execute_add_virtual_transition(N1,CurState,Result)
1144 ; cli_goal_found(CurState) -> % also recognizes no_goal command
1145 N1 is Nr-1,
1146 format('GOAL FOUND after ~w steps (after ~w).~n',[N1,LastActionName]),!,
1147 print_state_silent(CurState), Result=goal_found,
1148 cli_execute_add_virtual_transition(N1,CurState,Result)
1149 ; reset_side_effect_occurred,
1150 cli_trans(CurState,ActionName,NewState,Nr,LastActionName), % Compute new transition
1151 !,
1152 N1 is Nr+1,
1153 (NewState=CurState0, % could be expensive for large states; states are expanded ! % TO DO: look only at written variables ?!
1154 \+ side_effect_occurred(file)
1155 -> formatsilent('Infinite loop reached after ~w steps (looping on ~w).~n',[N1,ActionName]),
1156 Result=loop,
1157 cli_execute_add_virtual_transition(N1,CurState,Result)
1158 ; cli_execute_aux(N1,Steps,NewState,MEMO,ErrorOnDeadlock,ActionName,Result))
1159 ).
1160 cli_execute_aux(Nr,_Steps,CurState,_,_ErrorOnDeadlock,LastActionName,Result) :- execute_timeout_occurred,!,
1161 N1 is Nr-1,
1162 formatsilent('Timeout occurred after ~w steps (after ~w).~n',[N1,LastActionName]),
1163 Result=time_out,
1164 print_state_silent(CurState),
1165 cli_execute_add_virtual_transition(N1,CurState,Result).
1166 cli_execute_aux(Nr,_Steps,CurState,_,ErrorOnDeadlock,LastActionName,Result) :- N1 is Nr-1,
1167 formatsilent('Deadlock reached after ~w steps (after ~w).~n',[N1,LastActionName]),
1168 Result=deadlock,
1169 (ErrorOnDeadlock=true,\+ option(no_deadlocks) -> error_occurred(deadlock) ; true),
1170 print_state_silent(CurState),
1171 cli_execute_add_virtual_transition(N1,CurState,Result).
1172
1173 check_nr_of_steps(Steps) :- option(execute_expect_steps(ExpSteps)),
1174 (Steps = ExpSteps -> formatsilent('The expected number of steps were executed: ~w~n',[Steps]),fail
1175 ; true),
1176 !,
1177 ajoin(['Unexpected number of steps ',Steps,', expected:'],Msg),
1178 add_error(cli_execute,Msg,ExpSteps).
1179 check_nr_of_steps(_).
1180
1181 cli_execute_add_virtual_transition(Steps,CurState,Result) :-
1182 cli_execute_add_virtual_transition(Steps,CurState,Result,_).
1183 cli_execute_add_virtual_transition(Steps,CurState,Result,ToID) :-
1184 current_state_id(CurID),
1185 write_xml_element_to_log(executed,[steps/Steps,result/Result]),
1186 (Steps>0 -> %TODO: we could check whether this is actually useful for any outstanding command
1187 (CurID=root
1188 -> tcltk_interface:tcltk_add_cbc_state(CurState,'$execute'(Steps)) % generate separate constants state
1189 ; tcltk_interface:tcltk_add_new_transition(CurID,'$execute'(Steps),ToID,CurState,[]),
1190 tcltk_goto_state('$execute'(Steps),ToID)
1191 ),
1192 debug_format(19,'Added transition ~w -> ~w to state space for ~w execution steps~n',[CurID,ToID,Steps])
1193 ; true),
1194 check_nr_of_steps(Steps).
1195
1196 :- dynamic max_walltime/3.
1197 print_max_walltime :- (max_walltime(Action,Nr,WT),option_verbose
1198 -> format('% Maximum walltime ~w ms at step ~w for ~w.~n',[WT,Nr,Action]) ; true).
1199
1200 % will be used to compute a single successor
1201 % b_operation_cannot_modify_state
1202 cli_trans(CurState,ActionName,NewState,Nr,LastActionName) :-
1203 option(animate_stats),!, % provide statistics about the animation
1204 start_probcli_timer(Timer),
1205 cli_trans_aux(CurState,ActionName,Act,NewState,Nr,LastActionName),
1206 (option_verbose -> translate:translate_event(Act,TStr)
1207 ; translate:translate_event_with_limit(Act,100,TStr)),
1208 format('~w~5|: ~w~n',[Nr,TStr]),
1209 format(' ~5|',[]),stop_probcli_timer(Timer,' '),
1210 (option_verbose -> format(' ~5|',[]),print_memory_used_wo_gc,nl ; true),
1211 flush_output,
1212 get_probcli_elapsed_walltime(Timer,WallTime),
1213 get_probcli_elapsed_runtime(Timer,RunTime),
1214 accumulate_infos(animate_stats,[step-1,step_nr-Nr,runtime-RunTime,walltime-WallTime]),
1215 (max_walltime(_,_,MWT), MWT >= WallTime -> true
1216 ; retractall(max_walltime(_,_,_)),
1217 assertz(max_walltime(ActionName,Nr,WallTime))).
1218 cli_trans(CurState,ActionName,NewState,Nr,LastActionName) :-
1219 cli_trans_aux(CurState,ActionName,_,NewState,Nr,LastActionName).
1220
1221 cli_trans_aux(CurState,ActionName,Act,NewState,Nr,LastActionName) :-
1222 option(timeout(TO)),!,
1223 safe_time_out(cli_trans_aux2(CurState,ActionName,Act,NewState,LastActionName),TO,Res),
1224 (Res=time_out -> format_error_with_nl('! Timeout occurred while performing step ~w of execute: ~w ms',[Nr,TO]),
1225 % TO DO: try and obtain operation name in which time-out occured
1226 error_occurred(time_out,execute),
1227 assertz(execute_timeout_occurred),
1228 fail
1229 ; true).
1230 cli_trans_aux(CurState,ActionName,Act,NewState,_Nr,LastActionName) :-
1231 cli_trans_aux2(CurState,ActionName,Act,NewState,LastActionName).
1232
1233 cli_trans_aux2(CurState,ActionName,Act,NewState,LastActionName) :-
1234 catch_enumeration_warning_exceptions(
1235 (throw_enumeration_warnings_in_current_scope,
1236 cli_execute_trans(CurState,ActionName,Act,NewState,LastActionName), % no time-out !
1237 (error_occurred_in_error_scope -> ErrorEvent=true ; ErrorEvent=false)
1238 ),
1239 (error_occurred(virtual_time_out_execute),
1240 ActionName = '*** VIRTUAL_TIME_OUT ***', Act=ActionName,
1241 CurState=NewState) % this forces loop detection above; not very elegant way of signalling
1242 ),
1243 (ErrorEvent==true,option(strict_raise_error)
1244 -> print('*** ERROR OCCURED DURING EXECUTE ***'),nl, error_occurred(execute),fail
1245 ; true).
1246
1247 :- use_module(runtime_profiler,[profile_single_call/3]).
1248 :- use_module(specfile,[get_specification_description/2]).
1249 cli_execute_trans(CurState,ActionName,Act,NewState,LastActionName) :-
1250 statistics(runtime,[StartExecuteForState,_]),
1251 get_possible_next_operation_for_execute(CurState,LastActionName,ActionName),
1252 start_check_disabled(ActionName,StartActionTime),
1253 catch(
1254 profile_single_call(ActionName,
1255 unknown, % state Unknown
1256 specfile_trans_with_check(CurState,ActionName,Act,NewState,Residue) % no time-out !
1257 ),
1258 EXC,
1259 (translate_exception(EXC,EMSG),
1260 (nonvar(ActionName)
1261 -> get_specification_description(operation,OP),
1262 format_with_colour_nl(user_error,[red,bold],'~n*** ~w while executing ~w "~w"~n',[EMSG,OP,ActionName])
1263 ; get_specification_description(operations,OP),
1264 format_with_colour_nl(user_error,[red,bold],'~n*** ~w while computing ~w~n',[EMSG,OP])
1265 ),
1266 perform_feedback_options_after_exception,
1267 throw(EXC))),
1268 (Residue=[]
1269 -> check_trans_time(StartExecuteForState,StartActionTime,ActionName)
1270 ; error_occurred(cli_execute_residue(ActionName,Residue,Act))).
1271
1272 :- use_module(probsrc(static_enabling_analysis),[static_cannot_enable/2]).
1273 % compute all possible next operations to try out in -execute, based on LastActionName
1274 % the predicate makes use of the fact that operations are tried in order
1275 get_possible_next_operation_for_execute(CurState,LastActionName,ActionName) :-
1276 get_preference(randomise_operation_order,false),
1277 get_preference(use_po,true), % PROOF_INFO: should we use a proper preference for use_po_for_execute ?
1278 b_or_z_mode,
1279 b_top_level_operation(LastActionName),
1280 % prevent trying ActionName which we know is infeasible according to previous LastActionName
1281 % we rely on the fact that execute tries the operations in order
1282 findall(AN,specfile_possible_trans_name_for_successors(CurState,AN),ANS),
1283 !,
1284 member_with_last(ActionName,ANS,LastActionName,FoundLast),
1285 (var(FoundLast)
1286 -> % ActionName occurs before LastActionName, this means
1287 % we did try this ActionName at the last execution step and it was not possible
1288 % format('Checking operation ~w against ~w~n',[ActionName,LastActionName]),debug:nl_time,
1289 %Note: we could use result of cbc enabling analysis if it was performed
1290 (static_cannot_enable(LastActionName,ActionName)
1291 -> %format('Operation ~w : ~w cannot be enabled by ~w : ~w~n',[Nr2,ActionName,Nr1,LastActionName]),
1292 %print('- '),
1293 fail
1294 ; true
1295 )
1296 ; true % we did not try this ActionName at the last execution step
1297 ).
1298 get_possible_next_operation_for_execute(CurState,_LastActionName,ActionName) :-
1299 specfile_possible_trans_name_for_successors(CurState,ActionName).
1300
1301 % like member but instantiate FoundLast when we pass the element Last
1302 member_with_last(X,[H|T],Last,FoundLast) :-
1303 (H=Last -> !,FoundLast=true, member(X,[H|T]) ; X=H).
1304 member_with_last(X,[_|T],Last,FoundLast) :- member_with_last(X,T,Last,FoundLast).
1305
1306 :- use_module(probsrc(value_persistance),[start_cache_execute_modus/1,stop_cache_execute_modus/0,
1307 add_new_transition_to_cache_from_expanded_state/4]).
1308 % also checks whether a setup_constants_inconsistent error should be raised:
1309 specfile_trans_with_check(CurState,ActionName,Act,NewState,Residue) :-
1310 start_cache_execute_modus(CacheInfo),
1311 if(specfile_trans_or_partial_trans(CurState,ActionName,Act,NewState,_TransInfo,Residue,Partial), % no time-out !
1312 (check_partial_trans(Partial,ActionName),
1313 (Partial=true -> true ; add_new_transition_to_cache_from_expanded_state(CurState,Act,NewState,CacheInfo)),
1314 stop_cache_execute_modus
1315 ),
1316 (stop_cache_execute_modus,
1317 check_deadlock_fail(ActionName) % add_deadlock_to_cache_from_expanded_state(CurState,ActionName)
1318 )
1319 ).
1320
1321 % check whether we should raise errors on deadlock in -execute:
1322 check_deadlock_fail('$setup_constants') :- !, error_occurred(setup_constants_inconsistent),fail.
1323
1324 % check whether we should raise errors due to partial transitions in -execute:
1325 check_partial_trans(true,'$setup_constants') :- !, error_occurred(setup_constants_inconsistent).
1326 check_partial_trans(true,ActionName) :- !, format('Unknown partial transition: ~w~n',[ActionName]),
1327 error_occurred(setup_constants_inconsistent).
1328 check_partial_trans(_,_).
1329
1330 % check if we did not spend too much time on disabled operations and print warning if we do
1331 check_trans_time(StartExecuteForState,StartActionTime,ActionName) :-
1332 option(execute_monitoring),
1333 statistics(runtime,[CurrentTime,_]),
1334 Delta1 is StartActionTime-StartExecuteForState,
1335 Delta2 is CurrentTime-StartActionTime,
1336 Delta1 > 100, Delta1 > Delta2,
1337 !,
1338 format_with_colour(user_output,[blue],'~n ~5|: WARNING from -execute_monitor: ~w ms for disabled operations and ~w ms for operation ~w itself~n',[Delta1,Delta2,ActionName]).
1339 check_trans_time(_,_,_).
1340
1341 % check if we did not spend too much time on a single disabled operations and print warning if we do
1342 start_check_disabled(ActionName,StartActionTime) :- option(execute_monitoring),!,
1343 statistics(runtime,[StartActionTime,_]),
1344 (true
1345 ; statistics(runtime,[EndActionTime,_]),
1346 Delta is EndActionTime - StartActionTime,
1347 Delta > 50,
1348 format_with_colour(user_output,[blue],'~n ~5|: WARNING from -execute_monitor: ~w ms for disabled operation ~w~n',[Delta,ActionName]),
1349 fail
1350 ).
1351 start_check_disabled(_,0).
1352
1353 translate_exception(user_interrupt_signal,'User-Interrupt (CTRL-C)').
1354 translate_exception(enumeration_warning(_,_,_,_,_),'Enumeration Warning').
1355 translate_exception(E,E).
1356
1357 :- use_module(bmachine,[b_machine_has_constants/0]).
1358 print_state_silent(_) :- option(silent),!.
1359 print_state_silent(CurState) :- (option_verbose;\+ b_machine_has_constants),!,
1360 translate:print_bstate_limited(CurState,1000,-1),nl.
1361 print_state_silent(CurState) :- remove_constants(CurState,VarState),
1362 % only print variables
1363 format('VARIABLES (use -v to see constants or -silent to suppress output):~n',[]),
1364 translate:print_bstate_limited(VarState,1000,-1),nl.
1365
1366 :- use_module(bmachine,[b_is_constant/1]).
1367 is_constant_binding(bind(C,_)) :- b_is_constant(C).
1368 remove_constants(const_and_vars(_,Vars),Res) :- !,Res=Vars.
1369 remove_constants([H|T],Res) :- !,exclude(prob_cli:is_constant_binding,[H|T],Res).
1370 remove_constants(root,Res) :- !,Res=[].
1371 remove_constants(concrete_constants(_),Res) :- !, Res=[].
1372 remove_constants(X,X).
1373
1374 % write vars to xml log file if they start with a given prefix
1375 logxml_write_ids(variables,Prefix) :- !,
1376 current_expression(_,CurState),
1377 remove_constants(CurState,VarState),
1378 % TO DO: store also final state in xml_log
1379 write_bstate_to_log(VarState,Prefix).
1380 logxml_write_ids(_,Prefix) :- !,
1381 current_expression(_,CurState),
1382 expand_const_and_vars_to_full_store(CurState,EState),
1383 write_bstate_to_log(EState,Prefix).
1384
1385 :- use_module(bmachine,[b_get_invariant_from_machine/1, b_specialized_invariant_for_op/2, b_machine_has_constants/0]).
1386 cli_invariant_ko(_,_,_,_) :- option(no_invariant_violations),!,fail. % user asks not to check it
1387 cli_invariant_ko(_,_,_,_) :- get_preference(do_invariant_checking,false),!,fail. % user asks not to check it via preference
1388 cli_invariant_ko(CurState,LastActionName,ResInvStatus,CliError) :-
1389 profile_single_call('INVARIANT',unknown,cli_invariant_ko2(CurState,LastActionName,ResInvStatus,CliError)).
1390 cli_invariant_ko2(CurState,LastActionName,ResInvStatus,CliError) :-
1391 state_corresponds_to_initialised_b_machine(CurState,BState),!,
1392 start_probcli_timer(InvTimer),
1393 (b_specialized_invariant_for_op(LastActionName,Invariant) -> true
1394 %, print('Specialized invariant: '),translate:print_bexpr(Invariant),nl
1395 ; b_get_invariant_from_machine(Invariant)),
1396 cli_test_pred(BState,'INVARIANT',Invariant,ResInvStatus),
1397 stop_probcli_debug_timer(InvTimer,'Finished Invariant Checking'),
1398 ResInvStatus \= 'TRUE',
1399 (ResInvStatus == 'FALSE' -> CliError = invariant_violation
1400 ; ResInvStatus == 'UNKNOWN' -> CliError = invariant_unknown
1401 ; ResInvStatus == 'TIME-OUT' -> CliError = invariant_time_out
1402 ; format_error_with_nl('Unexpected invariant status: ~w',[ResInvStatus]),
1403 CliError= invariant_unknown).
1404 %cli_invariant_ko(_,_,_,_) :- fail. % not yet initialised
1405
1406 :- use_module(b_interpreter,[b_test_boolean_expression_for_ground_state/4]).
1407 cli_test_pred(BState,PredKind,Pred) :- cli_test_pred(BState,PredKind,Pred,'TRUE').
1408 % comment in following clause to get more precise location for exceptions/virtual timeouts:
1409 %cli_test_pred(BState,PredKind,Pred,Res) :- option_verbose, bsyntaxtree:decompose_conjunct(Pred,A,B),!,
1410 % cli_test_pred(BState,PredKind,A,ResA), (ResA = 'TRUE' -> cli_test_pred(BState,PredKind,B,Res) ; Res = ResA).
1411 cli_test_pred(BState,PredKind,Pred,Res) :- option(timeout(TO)),!,
1412 debug_format(9,'Testing ~w with time-out ~w~n',[PredKind,TO]),
1413 safe_time_out(cli_test_pred2(BState,PredKind,Pred,Res), TO, TRes),
1414 (Res=time_out -> TRes='TIME-OUT' ; true).
1415 cli_test_pred(BState,PredKind,Pred,Res) :-
1416 debug_format(9,'Checking ~w without a time-out~n',[PredKind]),
1417 cli_test_pred2(BState,PredKind,Pred,Res).
1418 cli_test_pred2(BState,PredKind,Pred,Res) :-
1419 % currently does not do a time-out: % b_interpreter calls: time_out_with_enum_warning_one_solution_no_new_error_scope
1420 catch(
1421 on_enumeration_warning(b_test_boolean_expression_for_ground_state(Pred,[],BState,PredKind ), (
1422 add_error(cli_test_pred,'Enumeration warning while testing',PredKind,Pred),
1423 cli_print_pred_info(Pred),
1424 Res='UNKNOWN')
1425 ),
1426 E,
1427 (
1428 ajoin(['VIRTUAL TIME-OUT or exception while testing ',PredKind,': '],Msg),
1429 add_error(cli_test_pred,Msg,E,Pred), % E can also be user_interrupt_signal
1430 cli_print_pred_info(Pred),
1431 Res='UNKNOWN'
1432 )
1433 ),
1434 !,
1435 (var(Res) -> Res = 'TRUE' ; true).
1436 cli_test_pred2(_BState,_PredKind,_Pred,'FALSE').
1437
1438 cli_print_pred_info(Pred) :- get_texpr_label(Pred,Label),
1439 format('Label = ~w~n',[Label]),fail.
1440 cli_print_pred_info(Pred) :- get_texpr_description(Pred,Desc),
1441 format('Description = ~w~n',[Desc]),fail.
1442 %cli_print_pred_info(Pred) :- bsyntaxtree:get_texpr_pos(Pred,Pos), Pos \= none, translate_span(Pos,Str),
1443 % format('Location = ~w~n',[Str]),fail.
1444 cli_print_pred_info(Pred) :-
1445 option_verbose,
1446 write('Predicate: '), translate:nested_print_bexpr(Pred),nl.
1447
1448 :- use_module(bmachine,[get_assertions_from_machine/2]).
1449 % TO DO: also check static assertions
1450 cli_assertions_ko(_,_,_) :- option(no_assertion_violations),!,fail. % user asks not to check it
1451 cli_assertions_ko(CurState,_LastActionName,Res) :-
1452 state_corresponds_to_initialised_b_machine(CurState,BState),
1453 get_assertions_from_machine(dynamic,Assertions), % TO DO: do something similar to b_specialized_invariant_for_op
1454 !,
1455 profile_single_call('ASSERTIONS',unknown,cli_assertions_ko2(BState,Assertions,Res)).
1456
1457
1458 cli_assertions_ko2(BState,Assertions,Res) :-
1459 start_probcli_timer(AssTimer),
1460 %nl,nl,print(check),nl,maplist(translate:print_bexpr,Assertions),nl,
1461 (member(Ass,Assertions),
1462 cli_test_pred(BState,'ASSERTION',Ass,Res),
1463 Res \= 'TRUE' -> true
1464 ; Res = 'TRUE'
1465 ),
1466 stop_probcli_debug_timer(AssTimer,'Finished Checking Assertions'),
1467 Res \= 'TRUE'.
1468
1469
1470 :- use_module(bmachine,[b_get_machine_goal/1]).
1471 cli_goal_found(_):- option(no_goal),!,fail.
1472 cli_goal_found(CurState) :-
1473 b_get_machine_goal(Goal),
1474 state_corresponds_to_initialised_b_machine(CurState,BState),
1475 profile_single_call('GOAL',unknown,cli_goal_found2(Goal,BState)).
1476 cli_goal_found2(Goal,BState) :-
1477 b_test_boolean_expression_for_ground_state(Goal,[],BState,'GOAL').
1478
1479
1480 % random animation
1481 :- public cli_random_animate/2. % for repl to use -animate command
1482 cli_random_animate(Steps,Err) :- probcli_time_stamp(NOW),
1483 cli_random_animate(NOW,Steps,Err).
1484 cli_random_animate(_NOW,Steps,ErrorOnDeadlock) :-
1485 start_xml_feature(random_animate,max_steps,Steps,FINFO),
1486 start_ms_timer(Start),
1487 perform_random_steps(Steps,ErrorOnDeadlock),
1488 (option(silent) -> true ; stop_ms_timer_with_msg(Start,'-animate')),
1489 %tcltk_save_history_as_trace_file(prolog,user),
1490 stop_xml_feature(random_animate,FINFO).
1491
1492 :- use_module(bmachine,[b_get_assertions/3]).
1493 we_need_only_static_assertions(ALL) :- specfile:b_or_z_mode,
1494 (option(cli_check_assertions(main,_)) -> ALL=main
1495 ; option(cli_check_assertions(ALL,_))),
1496 % we do an assertion check
1497 \+ ((option(A), option_requires_all_properties(A))),
1498 b_get_assertions(ALL,dynamic,[]). % the assertions do not reference variables
1499
1500 % do we need all properties/constants of the machine, or only certain ones (e.g., static)
1501 option_requires_all_properties(cli_mc(_,_)).
1502 option_requires_all_properties(cli_check_properties). % we may want to check all properties
1503 option_requires_all_properties(cli_core_properties(_)).
1504 option_requires_all_properties(cli_random_animate(_)).
1505 option_requires_all_properties(default_trace_check).
1506 option_requires_all_properties(trace_check(_,_,_)).
1507 option_requires_all_properties(state_trace(_)).
1508 option_requires_all_properties(mcm_tests(_,_,_,_)).
1509 option_requires_all_properties(cbc_tests(_,_,_)).
1510 option_requires_all_properties(animate).
1511 option_requires_all_properties(initialise). % INITIALISATION may access constants
1512 option_requires_all_properties(eval_repl(_)).
1513 option_requires_all_properties(eval_string_or_file(_,_,_,_,_)).
1514 option_requires_all_properties(ltl_assertions).
1515 option_requires_all_properties(ltl_file(_)).
1516 option_requires_all_properties(refinement_check(_,_,_)).
1517 option_requires_all_properties(cli_start_mc_with_tlc).
1518 option_requires_all_properties(cli_symbolic_model_check(_)).
1519 option_requires_all_properties(process_latex_file(_,_)).
1520 option_requires_all_properties(cli_wd_check(_,_)).
1521 option_requires_all_properties(cli_lint(_)).
1522 option_requires_all_properties(visb_history(_,_,_)).
1523
1524 :- use_module(b_intelligent_trace_replay,[replay_json_trace_file/2]).
1525 :- public default_trace_check/0.
1526 default_trace_check :- loaded_main_file(_,MainFile),
1527 cli_start_default_trace_check(MainFile).
1528 cli_start_default_trace_check(MainFile) :-
1529 debug_println(20,'% Starting Default Trace Check: '),
1530 (check_default_trace_for_specfile(MainFile) -> true ; error_occurred(trace_check)).
1531
1532 default_json_trace_save :-
1533 loaded_main_file(_,MainFile),
1534 get_default_trace_file(MainFile,'.prob2trace',HistFile),
1535 format('Saving history to JSON ProB2-UI default trace file: ~w~n',[HistFile]),
1536 tcltk_save_history_as_trace_file(json,HistFile).
1537 cli_start_trace_check(json,File,default_trace_replay) :- !,
1538 replay_json_trace_file(File,Status),
1539 (Status=perfect -> true
1540 ; Status = imperfect(_) -> add_warning(trace_replay,'Imperfect JSON trace replay:',Status)
1541 ; add_error(trace_replay,'Failed JSON trace replay:',Status)
1542 ).
1543 cli_start_trace_check(Style,File,Mode) :-
1544 debug_format(20,'% Starting Trace Check (~w:~w): ~w~n',[Style,Mode,File]),
1545 (tcltk_check_sequence_from_file(Style,File,Mode) -> true ; error_occurred(trace_check)).
1546 cli_start_trace_state_check(File) :-
1547 debug_println(20,'% Starting Trace Check: '),
1548 (tcltk_check_state_sequence_from_file(File) -> true ; error_occurred(state_trace)).
1549
1550 % is it necessary to compute enabled operations for root state
1551 computeOperations_for_root_required :- initialise_required.
1552 computeOperations_for_root_required :- option(default_trace_check).
1553 computeOperations_for_root_required :- option(trace_check(_,_,_)).
1554 computeOperations_for_root_required :- option(state_trace(_)).
1555 computeOperations_for_root_required :- option(ltl_assertions).
1556 computeOperations_for_root_required :- option(cli_random_animate(_,_)).
1557 computeOperations_for_root_required :- option(socket(_,_)).
1558 computeOperations_for_root_required :- option(cli_mc(_,_)).
1559 computeOperations_for_root_required :- option(ltl_file(_)).
1560 computeOperations_for_root_required :- option(ltl_formula_model_check(_,_)).
1561 computeOperations_for_root_required :- option(ctl_formula_model_check(_,_)).
1562 computeOperations_for_root_required :- option(pctl_formula_model_check(_,_)).
1563 computeOperations_for_root_required :- option(refinement_check(_,_,_)).
1564 computeOperations_for_root_required :- option(csp_in_situ_refinement_check(_,_)).
1565 computeOperations_for_root_required :- option(csp_checkAssertion(_,_)).
1566 computeOperations_for_root_required :- option(mcm_tests(_,_,_,_)).
1567 computeOperations_for_root_required :- option(mcm_cover(_)).
1568
1569 % is an initialisation mandatory:
1570 initialise_required :- option(initialise), \+ empty_machine_loaded.
1571 initialise_required :- \+ option(default_trace_check), \+ option(trace_check(_,_,_)), \+ option(state_trace(_)),
1572 \+ option(load_state(_)),
1573 \+ empty_machine_loaded,
1574 \+ (option(execute(Nr,_,_)), Nr>=2), % execute will also initialise machine
1575 init_req2.
1576 init_req2 :- option(cli_check_properties).
1577 init_req2 :- option(zmq_assertion(_,_,_)).
1578 init_req2 :- option(cli_check_assertions(_,_)).
1579 init_req2 :- option(process_latex_file(_,_)).
1580 init_req2 :- option(eval_string_or_file(_,_,_,_,_)). % ensure that we initialise/precompile empty machine in case no main file specified; currently no longer required
1581 init_req2 :- option(check_abstract_constants).
1582 init_req2 :- option(visb_click(_)).
1583 init_req2 :- option(dot_command_for_expr(Cat,_,_,_,_)),
1584 nonmember(Cat,[transition_diagram,expression_coverage]). % see test 1033, option also works with empty state space
1585 %init_req2 :- option(csv_table_command(Cat,_,_,_)), ...
1586
1587 :- public initialise/0. % for REPL
1588 initialise :- probcli_time_stamp(NOW),cli_start_initialisation(NOW).
1589
1590 cli_start_initialisation(NOW) :-
1591 debug_println(20,'% Performing INITIALISATION: '),
1592 (perform_random_initialisation -> true ;
1593 writeln_log_time(cli_start_initialisation_failed(NOW)),
1594 fail).
1595
1596 :- use_module(wdsrc(well_def_analyser),[analyse_wd_for_machine/4]).
1597 :- public cli_wd_check/2. % for REPL
1598 cli_wd_check(ExpectedDis,ExpectedTot) :-
1599 (option(timeout(TO)) -> true ; TO=5000), % this is global_time_out option
1600 (option(silent) -> Opts=[discharge_po,ignore_wd_infos,reorder_conjuncts]
1601 ; Opts=[create_not_discharged_msg(warning),discharge_po,ignore_wd_infos,reorder_conjuncts]),
1602 statistics(walltime,[W1,_]),
1603 safe_time_out(analyse_wd_for_machine(NrDischarged,NrTot,_Res,Opts),TO,Res),
1604 statistics(walltime,[W2,_]), WT is W2-W1,
1605 (Res=time_out -> accumulate_infos(wd_check,[timeout-1,walltime-WT]), % discharged and total are unknown
1606 add_error(cli_wd_check,'TIME-OUT in WD Analysis (use -global_time_out X to increase it)')
1607 ; format(user_output,'WD Analysis Result: discharged ~w / ~w',[NrDischarged,NrTot]),
1608 (NrTot >0
1609 -> Perc is 100*NrDischarged/NrTot,
1610 (NrDischarged=NrTot -> Col=[green,bold] ; Col=[red])
1611 ; Perc = 100, Col=[]),
1612 format_with_colour(user_output,Col,' (~2f %)~n',[Perc]),
1613 WDInfos = [discharged-NrDischarged,timeout-0,total-NrTot,walltime-WT],
1614 accumulate_infos(wd_check,WDInfos),
1615 (ExpectedDis==ExpectedTot, ExpectedTot = NrTot -> true ; true), % for -wd-check-all: bind ExpectedDis
1616 check_required_infos([discharged-ExpectedDis,total-ExpectedTot],WDInfos,cli_wd_check)
1617 ).
1618 :- use_module(wdsrc(well_def_analyser),[analyse_invariants_for_machine/5]).
1619 cli_wd_inv_proof(UnchangedNr,ProvenNr,TotPOsNr) :-
1620 (option(timeout(TO)) -> true ; TO=5000),
1621 Options=[],
1622 statistics(walltime,[W1,_]),
1623 safe_time_out(analyse_invariants_for_machine(UnchangedNr,ProvenNr,UnProvenNr,TotPOsNr,Options),TO,Res),
1624 statistics(walltime,[W2,_]), WT is W2-W1,
1625 (Res=time_out -> accumulate_infos(wd_inv_proof,[timeout-1,walltime-WT]), % discharged and total are unknown
1626 add_error(cli_wd_check,'TIME-OUT in WD Invariant Proving (use -global_time_out X to increase it)')
1627 ;
1628 (TotPOsNr>0 -> Perc is (UnchangedNr+ProvenNr)*100/ TotPOsNr ; Perc = 100.0),
1629 format('Proof summary for ~w Invariant POs (~2f % discharged): ~w unchanged, ~w proven, ~w unproven~n',
1630 [TotPOsNr,Perc,UnchangedNr,ProvenNr,UnProvenNr]),
1631 WDInfos = [proven-ProvenNr,timeout-0,total-TotPOsNr,unchanged-UnchangedNr,unproven-UnProvenNr,walltime-WT],
1632 accumulate_infos(wd_inv_proof,WDInfos)
1633 ).
1634
1635
1636 :- use_module(bmachine_static_checks,[extended_static_check_machine/1]).
1637 :- use_module(visbsrc(visb_visualiser),[extended_static_check_default_visb_file/0]).
1638 % perform some additional static checks
1639 :- public cli_lint/0. % for REPL
1640 cli_lint(Check) :-
1641 extended_static_check_machine(Check),
1642 (unavailable_extension(visb_extension,_) -> true
1643 ; Check=visb -> extended_static_check_default_visb_file
1644 ; true).
1645 cli_lint :- cli_lint(_).
1646
1647
1648 :- use_module(extrasrc(predicate_debugger),[tcltk_debug_properties/3]).
1649 :- use_module(state_space,[current_state_corresponds_to_setup_constants_b_machine/0]).
1650 :- public cli_check_properties/0. % for REPL
1651 cli_check_properties :- probcli_time_stamp(NOW),
1652 cli_check_properties(NOW).
1653 cli_check_properties(NOW) :-
1654 printsilent('% Checking PROPERTIES: '),nls,
1655 writeln_log_time(starting_check_properties(NOW)),
1656 ( current_state_corresponds_to_setup_constants_b_machine ->
1657 set_analyse_hook('_P'),
1658 predicate_evaluator:tcltk_analyse_properties(_PROPRES,PROPInfos),
1659 unset_analyse_hook,
1660 printsilent(PROPInfos),nls, % ex: [total/33,true/29,false/0,unknown/4,timeout/4,runtime/49950]
1661 accumulate_infos(properties,PROPInfos),
1662 write_important_xml_element_to_log(check_properties,PROPInfos),
1663 (predicate_evaluator:check_summary_all_true(PROPInfos) -> true
1664 ; print_error('Not all PROPERTIES true'), error_occurred(check_properties))
1665 ;
1666 (tcltk_debug_properties(list(PROPRES),false,Satisfiable)
1667 -> printsilent(PROPRES),nls,
1668 printsilent(Satisfiable),nls
1669 ; error_occurred(debug_properties_failed))
1670 ),
1671 writeln_log_time(finished_check_properties(NOW,PROPInfos)),
1672 loaded_root_filename(RootName),
1673 formatsilent('% Finished checking PROPERTIES of ~w~n',[RootName]).
1674
1675 % TODO: provide argument so that we run it only if necessary; e.g., when ProB has not already found a solution
1676
1677 cli_core_properties(Algorithm) :-
1678 format('% Checking CONSISTENCY of PROPERTIES by finding UNSAT CORE (using ~w)~n',[Algorithm]),
1679 b_get_properties_from_machine(Properties),!,
1680 size_of_conjunction(Properties,NrOfConjuncts),
1681 statistics(walltime,[W1,_]),
1682 (find_core(Algorithm,Properties,Core,Result)
1683 -> statistics(walltime,[W2,_]), WTime is W2-W1,
1684 length(Core,Len),
1685 accumulate_infos(properties_core,[contradiction_found-1,core_length-Len,
1686 properties-NrOfConjuncts,walltime-WTime]),
1687 format('UNSAT CORE of length ~w found, PROPERTIES are inconsistent! (~w, ~w ms walltime using ~w)~n',[Len,Result,WTime,Algorithm]),
1688 translate:nested_print_bexpr_as_classicalb(Core),
1689 format('% END OF UNSAT CORE (~w conjuncts)~n',[Len])
1690 % TODO: raise setup_constants_fails and avoid trying to solve properties later
1691 ; statistics(walltime,[W2,_]), WTime is W2-W1,
1692 accumulate_infos(properties_core,[contradiction_found-0,core_length-0,
1693 properties-NrOfConjuncts,walltime-WTime]),
1694 format('No small UNSAT CORE found, PROPERTIES may be consistent (~w ms walltime).~n',[WTime])
1695 ).
1696
1697 :- use_module(extrasrc(unsat_cores),[quick_bup_core_up_to/4]).
1698 :- use_module(wdsrc(well_def_analyser),[find_inconsistent_axiom/3]).
1699 find_core(wd_prover,_,Core,Result) :-
1700 find_inconsistent_axiom([],Axiom,NecHyps),
1701 Core = [Axiom|NecHyps], Result = contradiction_found.
1702 find_core(z3_bup(MaxSize),Properties,Core,Result) :-
1703 (var(MaxSize) -> MaxSize=2 ; true),
1704 quick_bup_core_up_to(Properties,MaxSize,Core,Result).
1705
1706
1707 % -----------------------
1708
1709 :- public cli_check_assertions/2. % for REPL
1710 cli_check_assertions(ALL,RI) :-
1711 probcli_time_stamp(NOW),
1712 cli_check_assertions(ALL,RI,NOW).
1713 cli_check_assertions(ALL,ReqInfos,NOW) :-
1714 printsilent('% Checking ASSERTIONS: '),nls,
1715 writeln_log_time(starting_check_assertions(NOW)),
1716 set_analyse_hook('_A'), % for dot output, in case users wants to generate dot files for assertions
1717 predicate_evaluator:tcltk_analyse_assertions(ALL,_ASSRES,Infos), % also checks CSP assertions
1718 unset_analyse_hook,
1719 printsilent(Infos),nls,
1720 accumulate_infos(assertions,Infos),
1721 write_important_xml_element_to_log(check_assertions,Infos),
1722 check_required_infos(ReqInfos,Infos,check_assertions),
1723 writeln_log_time(finished_check_assertions(NOW,Infos)),
1724 loaded_root_filename(RootName),
1725 formatsilent('% Finished checking ASSERTIONS of ~w~n',[RootName]),!.
1726 cli_check_assertions(ALL,ReqInfos,NOW) :-
1727 add_internal_error('Analyse ASSERTIONS unexpectedly failed',cli_check_assertions(ALL,ReqInfos,NOW)),
1728 error_occurred(internal_error).
1729 cli_set_goal(GOAL) :-
1730 debug_println(20,set_goal(GOAL)), %print(set_goal(GOAL)), nl,
1731 (bmachine:b_set_machine_goal(GOAL) -> true
1732 ; add_error(scope,'Setting GOAL predicate failed:',GOAL)).
1733 cli_add_additional_property(PROP) :-
1734 debug_println(20,add_additional_property(PROP)),
1735 (bmachine:add_additional_property(PROP,'command line -property') -> true
1736 ; add_error(scope,'Adding additional predicate to PROPERTIES failed:',PROP)).
1737 cli_set_searchscope(GOAL) :-
1738 debug_println(20,set_searchscope(GOAL)),
1739 format('Setting SCOPE for verification: ~w~n (Only states satisfying this predicate will be examined)~n',[GOAL]),
1740 (b_or_z_mode, bmachine:b_set_machine_searchscope(GOAL) -> true
1741 ; (xtl_mode, xtl_interface:xtl_set_search_scope(GOAL) -> true
1742 ; add_error(scope,'Setting model checking search SCOPE failed:',GOAL))
1743 ).
1744 cli_check_goal :- \+ b_get_machine_goal(_),!,
1745 add_error(cli_check_goal,'No GOAL DEFINITION found'),
1746 error_occurred(cli_check_goal).
1747 cli_check_goal :-
1748 printsilent('% Checking GOAL predicate: '),nls,
1749 tcltk_analyse_goal(_List,Summary),
1750 debug_println(20,Summary),
1751 accumulate_infos(check_goal,Summary),
1752 write_important_xml_element_to_log(check_goal,Summary),
1753 check_required_infos([false/0,unknown/0],Summary,check_goal).
1754 :- public cli_mc/2. % for REPL
1755 cli_mc(Nr,Opts) :- probcli_time_stamp(NOW), cli_start_model_check(Nr,NOW,Opts).
1756 cli_start_model_check(Nr,NOW,Options) :-
1757 (member(reset_state_space,Options)
1758 -> formatsilent('Resetting state space for benchmarking model checking (limit:~w, options:~w)~n',[Nr, Options]),
1759 announce_event(reset_specification) % for benchmarking purposes
1760 %,state_space:portray_state_space,nl
1761 ; true),
1762 start_xml_feature(model_check,max_states,Nr,FINFO),
1763 regular_safety_model_check_now(Nr,Time,WallTime,MCRes,NOW),
1764 %nl,
1765 stop_xml_feature(model_check,FINFO),
1766 get_state_space_stats(TS,TT,PT,IgnT),
1767 statistics_memory_used(Mem),
1768 (MCRes=time_out -> TInfos=[timeout/1] ; TInfos=[]),
1769 accumulate_infos(model_check,[runtime-Time,walltime-WallTime, % mc only runtime, and total wall time
1770 processed_states/PT,total_states/TS,total_transitions/TT,
1771 ignored_states/IgnT, memory_used/Mem|TInfos]), %for bench_csv output
1772 writeln_log_time(model_check(NOW,Nr,Time,WallTime,MCRes)),
1773 (select(repeat(RepNr),Options,RestOptions)
1774 -> (RepNr>1
1775 -> N1 is RepNr-1,
1776 cli_start_model_check(Nr,NOW,[repeat(N1)|RestOptions])
1777 ; merge_accumulated_infos(model_check)
1778 )
1779 ; true
1780 ).
1781
1782 cli_start_mc_with_tlc :-
1783 (animation_mode(b), \+ animation_minor_mode(eventb) -> true
1784 ; error_manager: add_error_and_fail(mc_with_tlc,'TLC4B tool can be used only for classical B models.')),
1785 % TO DO: use b_write_eventb_machine_to_classicalb_to_file to do conversion
1786 catch(
1787 safe_absolute_file_name(prob_lib('TLC4B.jar'),TLC4BTool),
1788 error(E,_),
1789 error_manager:add_error_fail(get_tlc_command,'Could not find TLC4B.jar file.',E)),
1790 start_xml_feature(model_check_with_tlc,tlc4bjar,TLC4BTool,FINFO),
1791 construct_and_execute_tlc_command(TLC4BTool),
1792 stop_xml_feature(model_check_with_tlc,FINFO).
1793
1794 :- use_module(system_call,[system_call/4]).
1795 construct_and_execute_tlc_command(TLC4BTool) :-
1796 parsercall: get_java_command_path(JavaCmd),
1797 loaded_main_file(File),
1798 % determine extra arguments:
1799 (get_preference(tlc_number_of_workers,TLCWorkers), TLCWorkers>1
1800 -> number_codes(TLCWorkers,CC), atom_codes(TLAWA,CC), WW = ['-workers',TLAWA]
1801 ; WW=[]),
1802 (option(no_assertion_violations) -> WA = ['-noass'] ; WA=[]),
1803 (option(no_deadlocks) -> WD = ['-nodead'] ; WD=[]),
1804 (option(no_invariant_violations) -> WI = ['-noinv'] ; WI=[]),
1805 (option(no_goal) -> WG = ['-nogoal'] ; WG=[]),
1806 (option(no_ltl) -> WL = ['-noltl'] ; WL=[]),
1807 (option_verbose -> WV = ['-verbose'] ; WV=[]),
1808 (option(silent) -> WS = ['-silent'] ; WS=[]),
1809 (option(logtlc(Log)) -> WLG = ['-log',Log] ; WLG=[]),
1810 (get_preference(tlc_use_prob_constant_setup,true),
1811 tcltk_get_constants_predicate(DNF_Pred)
1812 -> WCS = ['-constantssetup', DNF_Pred]
1813 ; WCS=[]),
1814 append([WW,WA,WD,WI,WG,WL,WCS,WV,WS,WLG,[File]],TLCArgs),
1815 debug_println(19,tlc_args(TLCArgs)),
1816 statistics(walltime,[W1,_]),
1817 % we could call get_jvm_options: '-Xss5m' is useful e.g. for Generated1000.mch
1818 system_call(JavaCmd, ['-Xss5m', '-jar', TLC4BTool | TLCArgs], Text,JExit),
1819 statistics(walltime,[W2,_]),
1820 WTime is W2-W1,
1821 formatsilent('exit : ~w walltime: ~w ms~n',[JExit,WTime]),
1822 (JExit=exit(0)
1823 -> accumulate_infos(mc_with_tlc,[walltime-WTime,model_check_ok-1])
1824 ; accumulate_infos(mc_with_tlc,[walltime-WTime,model_check_error-1]),
1825 add_error(construct_and_execute_tlc_command,'Error while model checking with TLC: ',TLC4BTool/File),
1826 atom_codes(T,Text),
1827 add_error_fail(construct_and_execute_tlc_command,'Std error: ',T)
1828 ).
1829
1830 % SymbolicOrSequential = symbolic or sequential
1831 cli_start_sym_mc_with_lts(SymbolicOrSequential) :-
1832 (option(no_deadlocks) -> NoDead = true ; NoDead = false),
1833 (option(no_invariant_violations) -> NoInv = true ; NoInv = false), % does LTSMin support goal checking
1834 findall(Option,option(ltsmin_option(Option)),MoreFlags1),
1835 findall(ltl_formula(LTLF),option(ltl_formula_model_check(LTLF,_)),MoreFlags2),
1836 append(MoreFlags1,MoreFlags2,MoreFlags),
1837 (NoDead = false, NoInv = false ->
1838 print_error('ERROR: cannot start LTSmin with both deadlock and invariant checking'),
1839 print_error(' use either the -noinv or -nodead flag'),
1840 flush_output(user_error)
1841 ; true),
1842 formatsilent('starting prob2lts-sym/seq (flags nodead=~w, noinv=~w, moreflags=~w)~n',[NoDead,NoInv,MoreFlags]),
1843 statistics(walltime,[W1,_]),
1844 start_ltsmin(SymbolicOrSequential, [NoDead, NoInv], MoreFlags,Result),
1845 process_ltsmin_result(Result,AccInfos),
1846 statistics(walltime,[W2,_]), WT is W2-W1,
1847 accumulate_infos(mc_with_lts_min(SymbolicOrSequential),[walltime-WT|AccInfos]).
1848 % TO DO: start lts-sym + start start_ltsmin_srv('/tmp/ltsmin.probz', NOW) + print output
1849
1850 :- use_module(extension('ltsmin/ltsmin_trace'),[csv_to_trace/3]).
1851 process_ltsmin_result(ltsmin_model_checking_ok,[model_check_ok-1]) :-
1852 print_green('LTSMin found no counter example\n').
1853 process_ltsmin_result(ltsmin_model_checking_aborted,[model_check_aborted-1]) :-
1854 add_warning(ltsmin_model_checking_aborted,'LTSMin was aborted (e.g., by CTRL-C)').
1855 process_ltsmin_result(ltsmin_counter_example_found(CsvFile),[model_check_counter_example-1]) :-
1856 add_error(ltsmin_counter_example_found,'LTSMin found a counter example, written to:',CsvFile),
1857 (option(silent) -> true
1858 ; csv_to_trace(CsvFile,_States,Transitions) ->
1859 print('*** TRACE: '),nl,print_list(Transitions) % ,print(_States),nl
1860 ; add_error(ltsmin,'Could not extract trace information from LTSmin file: ',CsvFile)
1861 ).
1862
1863 :- use_module(symbolic_model_checker(ic3), [ic3_symbolic_model_check/1]).
1864 :- use_module(symbolic_model_checker(ctigar), [ctigar_symbolic_model_check/1]).
1865 :- use_module(symbolic_model_checker(kinduction), [kinduction_symbolic_model_check/1,
1866 tinduction_symbolic_model_check/1]).
1867 :- use_module(symbolic_model_checker(bmc), [bmc_symbolic_model_check/1]).
1868 cli_symbolic_model_check(Algorithm) :-
1869 debug_format(20,'% Starting Symbolic Model Check. Using ~w Algorithm', [Algorithm]),
1870 start_xml_feature(model_check,algorithm,Algorithm,FINFO),
1871 (animation_mode(b)
1872 -> true
1873 ; error_manager:add_error_and_fail(cli_symbolic_model_check,'Symbolic Model Checking is currently only available for B and Event-B.')),
1874 perform_symbolic_model_checking(Algorithm,Result),
1875 handle_symbolic_model_check_result(Result),
1876 stop_xml_feature(model_check,FINFO).
1877
1878 perform_symbolic_model_checking(ic3,Result) :- !, ic3_symbolic_model_check(Result).
1879 perform_symbolic_model_checking(ctigar,Result) :- !, ctigar_symbolic_model_check(Result).
1880 perform_symbolic_model_checking(kinduction,Result) :- !, kinduction_symbolic_model_check(Result).
1881 perform_symbolic_model_checking(tinduction,Result) :- !, tinduction_symbolic_model_check(Result).
1882 perform_symbolic_model_checking(bmc,Result) :- !, bmc_symbolic_model_check(Result).
1883 perform_symbolic_model_checking(Alg,_) :- add_error_fail(cli_symbolic_model_check,'Invalid symbolic model checking algorithm: ',Alg).
1884
1885 handle_symbolic_model_check_result(counterexample_found) :- !, error_occurred(invariant_violation).
1886 handle_symbolic_model_check_result(property_holds) :- !,
1887 format('Model checking complete, invariant holds~n',[]).
1888 handle_symbolic_model_check_result(solver_and_provers_too_weak) :- !,
1889 format('Model checking incomplete because a constraint could not be solved in time~n',[]),
1890 error_occurred(model_check_incomplete).
1891 handle_symbolic_model_check_result(limit_reached) :- !,
1892 format('Model checking incomplete because an iteration limit was reached~n',[]),
1893 error_occurred(model_check_incomplete).
1894
1895 zmq_start_master(invariant,Identifier) :-
1896 start_animation_without_computing,
1897 zmq_get_initialisation_term(InitTerm),
1898 (option(strict_raise_error) -> Strict = 1 ; Strict = 0),
1899 get_preference(port, PortStart),
1900 get_preference(max_states, Max),
1901 get_preference(ip, IP),
1902 get_preference(logdir, LogDir),
1903 get_preference(tmpdir, TmpDir),
1904 get_preference(hash_cycle, HashCycle),
1905 atom_concat(LogDir, '/distb-', ATmp),
1906 atom_concat(ATmp, Identifier, Logfile),
1907 atom_concat(TmpDir, '/db-distb-', TTmp),
1908 atom_concat(TTmp, Identifier, TmpDir2),
1909 start_master(InitTerm,Max,PortStart,Strict,IP,Logfile,TmpDir2,HashCycle),
1910 halt.
1911 zmq_start_master(assertion,Identifier) :-
1912 get_preference(port, PortStart),
1913 get_preference(logdir, LogDir),
1914 get_preference(ip, IP),
1915 get_preference(tmpdir, TmpDir),
1916 get_preference(hash_cycle, HashCycle),
1917 atom_concat(LogDir, '/distb-', ATmp),
1918 atom_concat(ATmp, Identifier, Logfile),
1919 atom_concat(TmpDir, '/db-distb-', TTmp),
1920 atom_concat(TTmp, Identifier, TmpDir2),
1921 current_state_corresponds_to_setup_constants_b_machine,
1922 animation_mode(b),
1923 full_b_machine(Machine),
1924 b_get_assertions(_,static,SAss),
1925 b_get_assertions(_,dynamic,DAss),
1926 append(SAss,DAss,Ass),
1927 count_assertions(Ass,0,N),
1928 assertz(master:assertion_count(N)),
1929 current_expression(_,State1),
1930 specfile:state_corresponds_to_set_up_constants(State1,State),
1931 zmq_get_important_options(Options),
1932 (option(strict_raise_error) -> Strict = 1 ; Strict = 0),
1933 %start_master(assertions(classical_b(Machine,Options),State,Ass),2,-1,PortStart,0,Strict,IP,Logfile,TmpDir2),
1934 start_master(assertions(classical_b(Machine,Options),State,Ass),2,PortStart,Strict,IP,Logfile,TmpDir2,HashCycle),
1935 halt.
1936
1937 zmq_get_initialisation_term(Term) :-
1938 (animation_mode(b) ; animation_mode(csp_and_b)), % CSP file not yet added when ZMQ master starts working
1939 \+ animation_minor_mode(eventb),
1940 option(add_csp_guide(CspGuide)),
1941 !, % Classical B + CSP
1942 debug_println(20,'ZMQ: Transferring CSP || B model'),
1943 full_b_machine(Machine),
1944 % TO DO: extract CSP Term rather than file name: will not work for distribution on other file-systems
1945 zmq_get_important_options(Options),
1946 Term = classical_b_with_csp(Machine,CspGuide,Options).
1947 zmq_get_initialisation_term(Term) :-
1948 debug_println(20,'Generating ZMQ Worker Initialisation'),
1949 animation_mode(b), \+ animation_minor_mode(eventb), !, % Classical B
1950 debug_println(20,'ZMQ: Transferring Classical-B model'),
1951 full_b_machine(Machine),
1952 zmq_get_important_options(Options),
1953 Term = classical_b(Machine,Options).
1954 zmq_get_initialisation_term(Term) :-
1955 animation_mode(b), animation_minor_mode(eventb), !, % Event-B
1956 debug_println(20,'ZMQ: Transferring Event-B model'),
1957 full_b_machine(Machine),
1958 zmq_get_important_options(Options),
1959 Term = eventb(Machine,Options).
1960 zmq_get_initialisation_term(Term) :-
1961 animation_mode(cspm),
1962 loaded_main_file(MainCSPFile),!, % TO DO: pass CSP Prolog term rather than file name (for distribution)
1963 zmq_get_important_options(Options),
1964 debug_println(20,'ZMQ: Transferring CSP specification'),
1965 Term = csp_specification(MainCSPFile,Options).
1966 zmq_get_initialisation_term(_Term) :-
1967 \+ real_error_occurred, % otherwise error occured while loading
1968 animation_mode(Mode),
1969 add_internal_error('Unsupported formalism for ZMQ', Mode),
1970 fail.
1971
1972 zmq_get_initialisation_term(filename(FN)) :-
1973 loaded_main_file(FN).
1974
1975 % get important command-line options to be transmitted to probcli worker
1976 zmq_get_important_options(Options) :- findall(O, (option(O), zmq_important_option(O)), Options),
1977 debug_println(20,transferring_zmq_options_to_workers(Options)).
1978 zmq_important_option(coverage(_)).
1979 zmq_important_option(expect_error(_)).
1980 zmq_important_option(optional_error(_)).
1981 zmq_important_option(file_info).
1982 zmq_important_option(log(_)).
1983 zmq_important_option(print_version(_)).
1984 zmq_important_option(profiling_on).
1985 zmq_important_option(set_card(_,_)).
1986 zmq_important_option(set_pref(_,_)).
1987 zmq_important_option(set_preference_group(_,_)).
1988 zmq_important_option(statistics).
1989 zmq_important_option(csv_table_command(_,_,_,_)).
1990 zmq_important_option(verbose(_)).
1991 zmq_important_option(set_searchscope(_)).
1992 zmq_important_option(no_invariant_violations).
1993 %zmq_important_option(no_deadlocks).
1994 %zmq_important_option(no_goal).
1995 % we could consider also supporting: -argv, -cache, -prefs FILE csp_main(ProcessName) profiling_on prob_profile runtimechecking
1996
1997 % set options received by a zmq worker
1998 :- use_module(b_global_sets, [set_user_defined_scope/2]).
1999 :- use_module(tools_strings, [convert_cli_arg/2]).
2000 zmq_set_important_options(Options) :- debug_println(20,setting_zmq_options(Options)),
2001 maplist(prob_cli:zmq_set_option,Options).
2002 zmq_set_option(file_info) :- !, file_info.
2003 zmq_set_option(log(F)) :- !,
2004 generate_time_stamp(Datime,NOW),
2005 cli_start_logging(F,ascii,NOW,Datime,[zmq_worker]).
2006 zmq_set_option(print_version(V)) :- !, print_version(V).
2007 zmq_set_option(profiling_on) :- !, profiling_on.
2008 zmq_set_option(set_card(Set,V)) :- !,
2009 convert_cli_arg(V,Value),
2010 set_user_defined_scope(Set,Value).
2011 zmq_set_option(set_pref(P,V)) :- !, set_pref(P,V).
2012 zmq_set_option(set_preference_group(P,V)) :- !, set_preference_group(P,V).
2013 zmq_set_option(verbose(Nr)) :- !, verbose(Nr).
2014 zmq_set_option(O) :- zmq_delayed_option(O),!, assert_option(O). % DO IT LATER
2015 zmq_set_option(O) :- add_internal_error('Unsupported option for ZMQ worker: ',zmq_set_option(O)).
2016
2017 zmq_delayed_option(coverage(_)).
2018 zmq_delayed_option(expect_error(_)).
2019 zmq_delayed_option(expect_error_pos(_,_,_)).
2020 zmq_delayed_option(optional_error(_)).
2021 zmq_delayed_option(statistics).
2022 zmq_delayed_option(set_searchscope(_)).
2023 zmq_delayed_option(no_invariant_violations). % not supported yet
2024
2025 ltsmin_ltl_output(Filename, NOW) :-
2026 if_option_set(ltl_formula_model_check(Formula, _),true),
2027 ltsmin_generate_ltlfile(Formula, Filename),
2028 halt_prob(NOW,0). % if we additionally specify -ltsformula, we do not want to model check it
2029
2030
2031 start_ltsmin_srv(X, NOW) :-
2032 nls,println_silent('Starting LTSMin Server...'),
2033 if_option_set(ltl_formula_model_check(Formula, _),true),
2034 ltsmin_init(X, Zocket, Formula),
2035 ltsmin_loop(Zocket),
2036 ltsmin_teardown(Zocket, X),
2037 nls,println_silent('Stopped LTSMin Server.'),
2038 halt_prob(NOW,0). % if we additionally specify -ltsformula, we do not want to model check it
2039
2040 zmq_start_worker(Identifier, NOW) :-
2041 get_preference(port, Port),
2042 get_preference(logdir, LogDir),
2043 get_preference(tmpdir, TmpDir),
2044 get_preference(proxynumber, ProxyNumber),
2045 /* TODO: ensure directory exists (pk, 09.01.2018) */
2046 atom_concat(LogDir, '/worker-', ATmp),
2047 atom_concat(ATmp, Identifier, Logfile),
2048 % TODO: tmp dir currently not used
2049 atom_concat(TmpDir, '/db-worker-', TTmp),
2050 atom_concat(TTmp, Identifier, TmpDir2),
2051 start_worker(Port,ProxyNumber,Logfile,TmpDir2,zmq_worker_load_model),
2052 formatsilent('ZMQ worker finished (Port:~w)~n',[Port]),
2053 cli_process_loaded_file_afer_start_animation(NOW),
2054 println_silent('Exiting probcli worker'),
2055 halt_prob(NOW,0).
2056
2057 zmq_start_animation :-
2058 prob2_interface:start_animation,
2059 if_option_set(set_goal(GOAL),
2060 cli_set_goal(GOAL)), % not used yet
2061 if_option_set(set_searchscope(SCOPE),
2062 cli_set_searchscope(SCOPE)),
2063 cli_computeOperations(_).
2064 zmq_worker_load_model(classical_b(Machine,Options)) :- !,
2065 debug_println(20,'ZMQ WORKER: Loading classical B model'),
2066 zmq_set_important_options(Options),
2067 bmachine:b_machine_reset, bmachine:assert_main_machine(Machine),
2068 set_animation_mode(b),
2069 zmq_start_animation.
2070 zmq_worker_load_model(classical_b_with_csp(Machine,CspGuide,Options)) :- !,
2071 debug_println(20,'ZMQ WORKER: Loading CSP || B model'),
2072 zmq_set_important_options(Options),
2073 bmachine:b_machine_reset, bmachine:assert_main_machine(Machine),
2074 set_animation_mode(b),
2075 prob2_interface:start_animation,
2076 tcltk_add_csp_file(CspGuide), % TO DO: use CSP Prolog term rather than filename <----------------
2077 zmq_start_animation.
2078 zmq_worker_load_model(eventb(Machine,Options)) :- !,
2079 print(loading_eventb(Options)),nl,
2080 zmq_set_important_options(Options),
2081 bmachine:b_machine_reset, bmachine:assert_main_machine(Machine),
2082 set_animation_mode(b), set_animation_minor_mode(eventb),
2083 zmq_start_animation.
2084 zmq_worker_load_model(csp_specification(CSPFile,Options)) :-
2085 zmq_set_important_options(Options),
2086 load_cspm_spec_from_cspm_file(CSPFile), % TO DO: pass CSP Prolog term rather than filename
2087 zmq_start_animation.
2088 zmq_worker_load_model(filename(FN)) :- !,
2089 printsilent('loading file by filename\n'),flush_output,
2090 ( is_eventb_b(FN) ->
2091 eclipse_interface:load_eventb_file(FN)
2092 ;
2093 bmachine:b_load_machine_probfile(FN)),
2094 zmq_start_animation.
2095 zmq_worker_load_model(assertions(Machine,State,Assertions)) :- !,
2096 assertz(assertion_counter(-1)),
2097 println_silent(loaded_model_for_assertion_checking),
2098 zmq_worker_load_model(Machine),
2099 assertz(worker:assertion_state(State)),
2100 make_assertionwps(Assertions).
2101 % assert current state
2102 zmq_worker_load_model(Other) :-
2103 add_internal_error('ZMQ worker: Unexpected machine description', zmq_worker_load_model(Other)),
2104 fail.
2105
2106
2107 :-dynamic assertion_counter/1.
2108
2109 count_assertions([],A,A).
2110 count_assertions([H|T],A,R) :- size_of_conjunction(H,N1),
2111 NN is A + N1,
2112 count_assertions(T,NN,R).
2113
2114 make_assertionwps([]).
2115 make_assertionwps([H|T]) :- conjunction_to_list(H,HL),
2116 sort_assertions(HL,SL),
2117 append_assertion(SL),
2118 make_assertionwps(T).
2119
2120 append_assertion([]).
2121 append_assertion([H|T]) :- assertion_counter(N),
2122 retractall(assertion_counter(_)),
2123 N1 is N + 1,
2124 assertz(assertion_counter(N1)),
2125 assertz(worker:assertion_task(N1,H)),
2126 append_assertion(T).
2127
2128 %assertions_order(A,B) :- term_size(A,NA),term_size(B,NB), NA > NB.
2129 sort_assertions(X,X).
2130 % :- samsort(assertions_order,X,Y).
2131
2132
2133
2134 is_eventb_b(FN) :- append(_,FN,".eventb").
2135 % load_model(Initialisation)
2136
2137
2138 :- use_module(predicate_evaluator).
2139 :- use_module(bmachine,[b_machine_name/1]).
2140 set_analyse_hook(AddPrefix) :- % set a hook to write false/unknown expressions into a dot file
2141 reset_dot_file_number,
2142 if_options_set(dot_analyse_output_prefix(_Path),
2143 (set_dot_file_prefix_if_option_set(AddPrefix),
2144 register_conjunct_error_hook(prob_cli:pred_eval_hook))).
2145 unset_analyse_hook :- predicate_evaluator:reset_conjunct_error_hook.
2146
2147 :- use_module(tools,[get_modulename_filename/2]).
2148 loaded_root_filename(RootName) :- loaded_main_file(MainFile),
2149 get_modulename_filename(MainFile,RootName).
2150
2151 set_dot_file_prefix_if_option_set(AddPrefix) :-
2152 if_options_set(dot_analyse_output_prefix(Path),
2153 (loaded_root_filename(RootName),
2154 % we could also use b_machine_hierarchy:main_machine_name(RootName)
2155 string_concatenate(Path,RootName,P1),
2156 string_concatenate(P1,AddPrefix,FullPath),
2157 set_dot_file_prefix(FullPath),
2158 debug_println(9,dot_file_prefix(FullPath)))).
2159
2160 % Status: true, false, unknown
2161 :- public pred_eval_hook/5.
2162 pred_eval_hook(_Conjunct,true,_EnumWarning,_IsExpanded, _CS) :-
2163 \+ option(dot_generate_for_all_formulas),!. % don't generate .dot for true formulas, unless explicitly requested
2164 pred_eval_hook(Conjunct,Status,_EnumWarning,_IsExpanded, CS) :-
2165 printsilent('Generating dotfile for: '),printsilent(CS),nls,
2166 (write_dot_graph_to_new_file(Status,Conjunct) -> true
2167 ; add_error(dot_output,'Writing dot to file failed: ',CS)).
2168
2169
2170 :- dynamic dot_file_prefix/1.
2171 :- dynamic dot_file_number/1.
2172
2173 dot_file_prefix('~/Desktop/dot').
2174 set_dot_file_prefix(F) :- retractall(dot_file_prefix(_)), assertz(dot_file_prefix(F)).
2175 dot_file_number(0).
2176 reset_dot_file_number :- retractall(dot_file_number(_)), assertz(dot_file_number(0)).
2177 get_next_nr(GNr) :- retract(dot_file_number(Nr)), N1 is Nr+1,
2178 assertz(dot_file_number(N1)), GNr = Nr.
2179 write_dot_graph_to_new_file(Status,BExpr) :-
2180 dot_file_prefix(Dir),get_next_nr(Nr),
2181 string_concatenate('_',Status,Str1),
2182 string_concatenate(Nr,Str1,NS),
2183 string_concatenate(Dir,NS,F1),
2184 atom_concat(F1,'.dot',FileName),
2185 tcltk_interface:write_dot_file_for_pred_expr(BExpr,FileName).
2186
2187 % get dot file name if dot_output has been set
2188 get_dot_file(Type,FileName) :- option(dot_analyse_output_prefix(_)),
2189 set_dot_file_prefix_if_option_set(Type),
2190 dot_file_prefix(Dir),
2191 string_concatenate('_',Type,Str1),
2192 string_concatenate(Dir,Str1,F1),
2193 atom_concat(F1,'.dot',FileName).
2194
2195 :- use_module(extrasrc(refinement_checker),
2196 [tcltk_refinement_search/3, tcltk_load_refine_spec_file/1, tcltk_save_specification_state_for_refinement/1]).
2197 cli_csp_in_situ_refinement_check(P,Type,Q,NOW) :-
2198 debug_println(20,'% Starting CSP Refinement Check'),
2199 loaded_main_file(CSPFile),
2200 ajoin_with_sep(['assert',P,Type,Q], ' ',Assertion),
2201 start_xml_feature(csp_refinement_check,assertion,Assertion,FINFO),
2202 ( timeout_call(tcltk_interface:tcltk_check_csp_assertion(Assertion,CSPFile,'False',_PlTerm,RefTrace),NOW,'cspref')
2203 -> check_ref_result(RefTrace)
2204 ; true),
2205 stop_xml_feature(csp_refinement_check,FINFO).
2206 cli_start_refinement_check(RefFile,PerformSingleFailures,RefNrNodes,NOW) :-
2207 start_xml_feature(refinement_check,file,RefFile,FINFO),
2208 tcltk_load_refine_spec_file(RefFile),
2209 ( timeout_call(tcltk_refinement_search(RefTrace,PerformSingleFailures,RefNrNodes),NOW,refinement_check)
2210 -> check_ref_result(RefTrace)
2211 ; true),
2212 stop_xml_feature(refinement_check,FINFO).
2213 check_ref_result(RefTrace) :-
2214 ( RefTrace==no_counter_example ->
2215 print('==> Refinement Check Successful'),nl
2216 ; RefTrace==no_counter_example_found ->
2217 print('==> Refinement Check did not find Counter-Example but is incomplete'),nl,
2218 error_occurred(refinement_check_incomplete)
2219 ;
2220 print('*** Refinement Check Counter-Example: ***'),nl, print(RefTrace),nl,
2221 print('*** Refinement Check Failed ***'),nl,
2222 error_occurred(refinement_check_fails)).
2223 cli_checkAssertion(Proc,Model,AssertionType,_NOW) :-
2224 loaded_main_file(CSPFile),
2225 ajoin(['assert ',Proc,' :[ ',AssertionType,'[',Model,']',' ]'],Assertion),
2226 start_xml_feature(csp_deadlock_check,assertion,Assertion,FINFO),
2227 ( /*timeout_call(*/tcltk_interface:tcltk_check_csp_assertion(Assertion,CSPFile,'False',_PlTerm,ResTrace)/*,NOW,a)*/
2228 -> check_model_result(Assertion,ResTrace)
2229 ; true),
2230 stop_xml_feature(csp_deadlock_check,FINFO).
2231 cli_check_csp_assertion(Assertion,NOW) :-
2232 start_xml_feature(csp_assertion_check,assertion,Assertion,FINFO),
2233 loaded_main_file(CSPFile),
2234 ajoin(['assert ',Assertion],AssertionFull),
2235 ( timeout_call(tcltk_interface:tcltk_check_csp_assertion(AssertionFull,CSPFile,_Negated,PlTerm,ResTrace),NOW,csp_assertion_check)
2236 -> check_model_result(PlTerm,ResTrace)
2237 ; true),
2238 stop_xml_feature(csp_assertion_check,FINFO).
2239
2240
2241
2242 check_model_result(AssertionPlTerm,ResTrace) :-
2243 ( ResTrace==no_counter_example ->
2244 printsilent('==> Model Check Successful'),nls
2245 ;
2246 (functor(AssertionPlTerm,assertRef,_Arity) ->
2247 print('*** Refinement Check Counter-Example: ***'),nl, print(ResTrace),nl,
2248 print('*** Refinement Check Failed ***'),nl,
2249 error_occurred(refinement_check_fails)
2250 ;
2251 print('*** Model Check Counterexample: ***'),nl,print(ResTrace),nl,
2252 print('*** Model Check Failed ***'),nl,
2253 error_occurred(model_check_fails))
2254 ).
2255 :- use_module(probcspsrc(haskell_csp),[get_csp_assertions_as_string/2,
2256 parse_and_load_cspm_file_into_specific_pl_file/2,
2257 evaluate_csp_expression/2, evaluate_csp_expression/3]).
2258 cli_csp_get_assertions :-
2259 loaded_main_file(CSPFile),
2260 get_csp_assertions_as_string(CSPFile,String),
2261 print('*** Assertions in File (separated by $) ***'),nl,print(String),nl.
2262 cli_eval_csp_expression(E) :-
2263 (loaded_main_file(CSPFile) ->
2264 evaluate_csp_expression(E, CSPFile, Res)
2265 ; evaluate_csp_expression(E,Res)
2266 ), print('Evaluated Expression: '),nl,print(Res),nl.
2267 cli_csp_translate_to_file(PlFile) :-
2268 loaded_main_file(CSPFile),
2269 parse_and_load_cspm_file_into_specific_pl_file(CSPFile,PlFile).
2270 :- use_module(probltlsrc(ltl_fairness),[check_scc_ce/2]).
2271 cli_check_scc_for_ltl_formula(LtlFormula,SCC) :-
2272 check_scc_ce(LtlFormula,SCC).
2273
2274 :- use_module(extrasrc(coverage_statistics),[pretty_print_coverage_information_to_file/1]).
2275 cli_get_coverage_information(FileName) :-
2276 pretty_print_coverage_information_to_file(FileName).
2277 cli_vacuity_check :-
2278 eclipse_interface:get_vacuous_invariants(L),
2279 (L=[] -> print('No vacuous invariants'),nl
2280 ; maplist(prob_cli:add_vacuous_invariant,L)).
2281 add_vacuous_invariant(Inv) :-
2282 translate:translate_bexpression(Inv,TI),
2283 add_error(vacuity_check,'Vacuous invariant: ',TI).
2284 cli_start_socketserver(Port,Loopback) :-
2285 printsilent('Starting Socket Server'),nls,
2286 safe_absolute_file_name(prob_home('.'),AppDir),
2287 printsilent('Application Path: '),printsilent(AppDir),nls,
2288 disable_interaction_on_errors,
2289 ( start_prob_socketserver(Port,Loopback) -> true
2290 ;
2291 print('Starting socket server failed, Port: '), print(Port),nl),
2292 printsilent('Finished Socket Server'),nls.
2293 :- use_module(tools_platform, [platform_is_64_bit/0]).
2294 cli_check_statespace_hash(Expected,Kind) :-
2295 printsilent('Computing hash of entire statespace: '),
2296 compute_full_state_space_hash(Hash),
2297 printsilent(Hash),nls, % TO DO: maybe also compute hash for transitions and check that
2298 (Hash=Expected -> true
2299 ; Kind=='64bit', \+ platform_is_64_bit -> format('Hash does not match ~w (but was computed on 64-bit system)~n',[Expected])
2300 ; Kind=='32bit', platform_is_64_bit -> format('Hash does not match ~w (but was computed on 32-bit system)~n',[Expected])
2301 ; add_error(hash,'Expected Statespace Hash to be: ',Expected)).
2302 :- use_module(extrasrc(b_operation_cache),[get_op_cache_stats/1]).
2303 cli_check_op_cache(ReqInfos) :-
2304 get_op_cache_stats(Stats),
2305 (ReqInfos=[] -> format('Operation caching statistics: ~w~n',[Stats])
2306 ; formatsilent('Operation caching statistics: ~w~n',[Stats])),
2307 accumulate_infos(op_cache,Stats),
2308 check_required_infos(ReqInfos,Stats,op_cache_stats).
2309 cli_show_coverage(ShowEnabledInfo,NOW) :-
2310 cli_show_coverage(_Nodes,_Operations,ShowEnabledInfo,NOW).
2311 cli_show_coverage(Nodes,Operations,ShowEnabledInfo,NOW) :-
2312 ShowEnabledInfo == just_check_stats,!, % no printing of individual transition coverage
2313 get_state_space_stats(TotalNodeSum,TotalTransSum,_ProcessedTotal,_), % no computation overhead
2314 writeln_log(computed_coverage(NOW,TotalNodeSum,TotalTransSum)),
2315 check_totals(Nodes,Operations,TotalNodeSum,TotalTransSum).
2316 cli_show_coverage(Nodes,Operations,ShowEnabledInfo,NOW) :-
2317 ShowEnabledInfo == just_summary,
2318 !, % no printing of detailed transition coverage (avoid traversing state space)
2319 get_state_space_stats(TotalNodeSum,TotalTransSum,ProcessedTotal,Ignored), % no computation overhead
2320 writeln_log(computed_coverage(NOW,TotalNodeSum,TotalTransSum)),
2321 format('Coverage:~n States: ~w (~w processed, ~w ignored)~n Transitions: ~w~n',
2322 [TotalNodeSum,ProcessedTotal,Ignored,TotalTransSum]),
2323 show_initialisation_summary(NOW),
2324 show_operation_coverage_summary(NOW),
2325 (invariant_violated(ID) -> format('At least one state violates the invariant (~w) ~n',[ID]) ; true),
2326 check_totals(Nodes,Operations,TotalNodeSum,TotalTransSum).
2327 cli_show_coverage(Nodes,Operations,ShowEnabledInfo,NOW) :-
2328 print('Coverage:'),nl,
2329 compute_the_coverage(Res,TotalNodeSum,TotalTransSum,ShowEnabledInfo,false),
2330 writeln_log(computed_coverage(NOW,TotalNodeSum,TotalTransSum)),
2331 print(Res),nl,
2332 check_totals(Nodes,Operations,TotalNodeSum,TotalTransSum).
2333 check_totals(Nodes,Operations,TotalNodeSum,TotalTransSum) :-
2334 ( Nodes=TotalNodeSum -> true
2335 ;
2336 add_error(probcli,'Unexpected number of nodes: ',TotalNodeSum),
2337 add_error(probcli,'Expected: ',Nodes),error_occurred(coverage)),
2338 ( Operations=TotalTransSum -> true
2339 ;
2340 add_error(probcli,'Unexpected number of transitions: ',TotalTransSum),
2341 add_error(probcli,'Expected: ',Operations),error_occurred(coverage)).
2342
2343
2344 :- use_module(bmachine,[b_machine_statistics/2, b_get_main_filename/1, b_get_all_used_filenames/1,get_full_b_machine_sha_hash/1]).
2345 :- use_module(tools_strings,[get_hex_bytes/2]).
2346 cli_print_machine_info(statistics) :-
2347 b_machine_name(Name),
2348 %(b_get_main_filename(File) -> true ; File=unknown),
2349 format('Machine statistics for ~w:~n',[Name]),
2350 findall(Key/Nr,b_machine_statistics(Key,Nr),L),
2351 maplist(prob_cli:print_keynr,L),!.
2352 cli_print_machine_info(files(WithSha)) :-
2353 b_machine_name(Name),
2354 (WithSha = with_sha -> Msg2='and SHA1 ' ; Msg2=''),
2355 format('Files ~wused for machine ~w:~n',[Msg2,Name]),
2356 b_get_all_used_filenames(Files),
2357 maplist(prob_cli:print_individual_file(WithSha),Files),!.
2358 cli_print_machine_info(hash(Expected)) :-
2359 b_machine_name(MainName), % to do: findall machines and hashes
2360 get_full_b_machine_sha_hash(HashBytes),
2361 get_hex_bytes(HashBytes,Hash),
2362 format('SHA hash for machine ~w = ~s~n',[MainName,Hash]),!,
2363 write_xml_element_to_log(machine_hash,[hash/Hash]),
2364 (var(Expected) -> true
2365 ; atom_codes(Expected,Hash)
2366 -> format_with_colour_nl(user_output,[green],'Machine hash for ~w matches provided hash.',[MainName])
2367 ; add_error(machine_hash_check,'Unexpected machine hash, expected: ',Expected)).
2368 cli_print_machine_info(Kind) :- add_error(machine_stats,'Could not obtain machine information:',Kind).
2369 print_keynr(Key/Nr) :- format(' ~w : ~w~n',[Key,Nr]).
2370 :- use_module(extension('probhash/probhash'),[raw_sha_hash_file/3]).
2371 :- use_module(tools_strings,[get_hex_bytes/2]).
2372 print_individual_file(with_sha,File) :- Span = machine_info,
2373 raw_sha_hash_file(File,Term,Span),
2374 get_hex_bytes(Term,SHAHexCodes),
2375 format(' ~w, ~s~n',[File,SHAHexCodes]).
2376 print_individual_file(_,File) :- format(' ~w~n',[File]).
2377
2378 check_machine_file_sha(File,ExpectedHash) :- Span = check_machine_file_sha,
2379 get_full_machine_file_path(File,AbsFile),
2380 raw_sha_hash_file(AbsFile,Term,Span),
2381 get_hex_bytes(Term,SHAHexCodes), atom_codes(ExpectedHash,ExpectedShaCodes),
2382 (SHAHexCodes=ExpectedShaCodes
2383 -> format_with_colour_nl(user_output,[green],'Checked SHA1 hash for file ~w is ~s',[AbsFile,SHAHexCodes])
2384 ; add_error(check_machine_file_sha,'Unexpected SHA1 hash of file:',AbsFile),
2385 format_with_colour_nl(user_error,[orange],'! Expected: ~w~n! Actual : ~s',[ExpectedHash,SHAHexCodes])
2386 ).
2387
2388 :- use_module(bmachine,[get_machine_file_number/4, b_absolute_file_name_relative_to_main_machine/2]).
2389 :- use_module(probsrc(tools), [get_parent_directory/2]).
2390 get_full_machine_file_path(File,AbsFile) :-
2391 get_modulename_filename(File,Name), get_filename_extension(File,ExtF),
2392 (get_machine_file_number(Name,ExtF,_Nr,AbsFile)
2393 -> get_parent_directory(File,Parent),
2394 (Parent='' -> true % no path provided
2395 ; File=AbsFile -> true % full path provided
2396 ; b_absolute_file_name_relative_to_main_machine(File,AbsFile) -> true % consistent partial path provided
2397 ; add_error(check_machine_file_sha,'File path is inconsistent with used file:',File),
2398 format_with_colour_nl(user_error,[orange],'! File actually used in B specification:~n ~w',[AbsFile])
2399 )
2400 ; add_error(check_machine_file_sha,'Could not locate the file for:',File),
2401 b_absolute_file_name_relative_to_main_machine(File,AbsFile)
2402 ).
2403
2404 :- use_module(tools,[get_tail_filename/2]).
2405 xml_log_machine_statistics :-
2406 animation_mode(Major),
2407 (animation_minor_mode(Minor) -> true ; Minor=none),
2408 write_xml_element_to_log(animation_mode,[major/Major,minor/Minor]),
2409 (b_or_z_mode, b_machine_name(Main)
2410 -> findall(Key/Nr,b_machine_statistics(Key,Nr),BMachStats),
2411 (b_get_main_filename(MainFile) -> get_tail_filename(MainFile,TailFile) ; TailFile = unknown),
2412 write_xml_element_to_log(b_machine_statistics,[machine_name/Main, tail_filename/TailFile|BMachStats])
2413 ; true).
2414
2415 cli_print_junit_results(ArgV) :-
2416 junit_mode(S),!,
2417 statistics(runtime,[E,_]),
2418 T is E - S,
2419 create_and_print_junit_result(['Integration Tests'],ArgV,T,pass).
2420 cli_print_junit_results(_).
2421
2422 :- use_module(visbsrc(visb_visualiser),[load_visb_file/1,
2423 tcltk_perform_visb_click_event/1, generate_visb_html_for_history/2]).
2424 cli_visb_history(JSONFile,HTMLFile,Options) :-
2425 (load_visb_file(JSONFile)
2426 -> ifm_option_set(visb_click(SVGID),tcltk_perform_visb_click_event(SVGID)), % simulate clicks if requested
2427 generate_visb_html_for_history(HTMLFile,Options)
2428 ; true). % errors already reported
2429
2430 cli_print_history(HistFile) :-
2431 findall( O, option(history_option(O)), Options),
2432 debug_println(9,writing_history_to_file(HistFile)),
2433 (select(trace_file,Options,ROpt) -> tcltk_save_history_as_trace_file(prolog,ROpt,HistFile) % save as Prolog trace file for replay with -t
2434 ; select(json,Options,ROpt) -> tcltk_save_history_as_trace_file(json,ROpt,HistFile) % save for replay with ProB2 UI
2435 ; write_history_to_file(HistFile,Options) -> true
2436 ; add_error(history,'Writing history to file failed: ',HistFile)).
2437
2438 cli_print_values(ValuesFilename) :-
2439 (write_values_to_file(ValuesFilename) -> true ; add_error(sptxt,'Writing values to file failed: ',ValuesFilename)).
2440 cli_print_all_values(ValuesDirname) :-
2441 (write_all_values_to_dir(ValuesDirname) -> true ; add_error(sstxt,'Writing all values to directory failed: ',ValuesDirname)).
2442
2443 :- use_module(probltlsrc(trace_generator),[generate_all_traces_until/4]).
2444
2445 cli_generate_all_traces_until(LTL_Stop_AsAtom,FilePrefix) :-
2446 generate_all_traces_until(LTL_Stop_AsAtom,FilePrefix,Result,NrTracesGenerated),
2447 format_with_colour_nl(user_error,[blue],'Generated ~w traces, result=~w~n',[NrTracesGenerated,Result]).
2448
2449 :- dynamic probcli_time_stamp/1.
2450 generate_time_stamp(NOW,TS) :- retractall(probcli_time_stamp(_)),
2451 now(NOW),
2452 current_prolog_flag(argv,ArgV),term_hash(ArgV,Hash),
2453 Rnd is Hash mod 1000,
2454 % random(0,1000,Rnd), always returns 216 % TO DO: try to get milliseconds from some library function
2455 TS is (NOW*1000)+Rnd,
2456 assertz(probcli_time_stamp(TS)).
2457 update_time_stamp(NOW1) :- retractall(probcli_time_stamp(_)),
2458 assertz(probcli_time_stamp(NOW1)).
2459
2460 %get_errors :- \+ real_error_occurred,!, (get_error(_Source,_Msg) -> print('*** Warnings occurred'),nl ; true), reset_errors.
2461 get_errors :-
2462 (get_preference(view_probcli_errors_using_bbresults,true)
2463 -> tools_commands:show_errors_with_bb_results([current]) ; true),
2464 get_error_sources.
2465
2466 get_error_sources :- get_error_with_span(ErrSource,Msg,Span), !,
2467 error_occurred_with_msg(ErrSource,Msg,Span),
2468 findall(1,get_error(ErrSource,_),L), length(L,Nr),
2469 (Nr>0 -> N1 is Nr+1, get_error_category_and_type(ErrSource,Cat,Type),
2470 (Type=error -> print_error('*** Occurences of this error: ')
2471 ; print_error('*** Occurences of this warning: ')),
2472 print_error(N1),
2473 write_xml_element_to_log(multiple_errors_occurred,[category/Cat,(type)/Type,number/N1])
2474 ; true),
2475 get_error_sources.
2476 get_error_sources.
2477
2478 :- use_module(state_space,[state_error/3, invariant_violated/1, time_out_for_invariant/1, time_out_for_assertions/1, time_out_for_node/3]).
2479 ?get_state_space_errors :- option(strict_raise_error),
2480 !,
2481 (\+ option(no_invariant_violations),invariant_violated(ID)
2482 -> (option_verbose ->
2483 format('Invariant violation in state with id = ~w~n',[ID]),
2484 b_interpreter:analyse_invariant_for_state(ID) % caused issue for test 1076
2485 ; format('Invariant violation in state with id = ~w (use -v to print more details)~n',[ID])
2486 ),
2487 error_occurred(invariant_violation)
2488 ; true),
2489 (state_error(_,_,abort_error(TYPE,Msg,_,Span)) -> error_occurred(TYPE,error,Span,Msg) ; true),
2490 get_state_errors(_).
2491 get_state_space_errors.
2492
2493 get_state_errors(ID) :- state_error(ID,_,X), X\=invariant_violated, X\=abort_error(_,_,_,_),
2494 create_state_error_description(X,Msg),error_occurred(Msg),fail.
2495 get_state_errors(ID) :- time_out_for_invariant(ID),error_occurred(time_out_for_invariant),fail.
2496 get_state_errors(ID) :- time_out_for_assertions(ID),error_occurred(time_out_for_assertions),fail.
2497 get_state_errors(ID) :- time_out_for_node(ID,_,time_out),error_occurred(time_out),fail.
2498 get_state_errors(ID) :-
2499 time_out_for_node(ID,_,virtual_time_out(_)), %print(virtual_time_out_for_node(ID)),nl,
2500 error_occurred(virtual_time_out),fail.
2501 get_state_errors(_).
2502
2503
2504 create_state_error_description(eventerror(Event,Error,_),Description) :- !,
2505 functor(Error,Functor,_),
2506 ajoin(['event_error:',Event,':',Functor],Description).
2507 create_state_error_description(StateError,Description) :-
2508 functor(StateError,Functor,_),
2509 atom_concat('state_error:',Functor,Description).
2510
2511 % require a real machine to be loaded
2512 check_loaded_not_empty(Action) :-
2513 file_loaded(true,'$$empty_machine'),!,
2514 add_error(probcli,'No file specified; cannot perform command: ',Action),
2515 error_occurred(loading),fail.
2516 check_loaded_not_empty(Action) :- check_loaded(Action).
2517
2518 check_loaded(Action) :-
2519 ( file_loaded(true) -> true
2520 ; file_loaded(error) -> fail /* we have already generated error message */
2521 ;
2522 add_error(probcli,'No file specified; cannot perform action: ',Action),
2523 error_occurred(loading),fail).
2524
2525 :- dynamic loaded_main_file/2.
2526 loaded_main_file(File) :- loaded_main_file(_Ext,File).
2527
2528 :- use_module(tools,[get_filename_extension/2]).
2529 load_main_file(MainFile,NOW,Already_FullyProcessed) :- retractall(loaded_main_file(_,_)),
2530 debug_print(20,'% Loading: '), debug_println(20,MainFile),
2531 writeln_log_time(loading(NOW,MainFile)),
2532 get_filename_extension(MainFile,Ext),
2533 debug_println(6,file_extension(Ext)),
2534 file_extension_can_be_loaded(Ext,MainFile),
2535 start_probcli_timer(Timer),
2536 load_spec_file(Ext,MainFile,Already_FullyProcessed),
2537 stop_probcli_debug_timer(Timer,'% Finished loading'),
2538 (Already_FullyProcessed==true -> true
2539 ; assertz(loaded_main_file(Ext,MainFile))).
2540
2541 known_spec_file_extension('P',xtl).
2542 known_spec_file_extension(als,alloy).
2543 known_spec_file_extension(csp,csp).
2544 known_spec_file_extension(cspm,csp).
2545 known_spec_file_extension(def,b).
2546 known_spec_file_extension(eval,b_eval).
2547 known_spec_file_extension(eventb,eventb).
2548 known_spec_file_extension(fuzz,z).
2549 known_spec_file_extension(imp,b).
2550 known_spec_file_extension(mch,b).
2551 known_spec_file_extension(pb,b).
2552 known_spec_file_extension(pla,alloy). % Prolog AST of Alloy translation
2553 known_spec_file_extension(prob,b).
2554 known_spec_file_extension(ref,b).
2555 known_spec_file_extension(rmch,b_rules).
2556 known_spec_file_extension(smt,smt).
2557 known_spec_file_extension(smt2,smt).
2558 known_spec_file_extension(sys,b).
2559 known_spec_file_extension(tex,z).
2560 known_spec_file_extension(tla,tla).
2561 known_spec_file_extension(zed,z).
2562
2563 :- use_module(pathes_extensions_db, [load_spec_file_requires_extension/2]).
2564 :- use_module(pathes_lib, [available_extension/1, unavailable_extension/2]).
2565 % check if we can load the file extension given available ProB extensions
2566 file_extension_can_be_loaded(FileExt,_) :- known_spec_file_extension(FileExt,Mode),
2567 load_spec_file_requires_extension(Mode,ProBExtension),
2568 unavailable_extension(ProBExtension,Reason),!,
2569 ajoin(['File with ending .', FileExt,' cannot be loaded because extension not available (',Reason,'):'],Msg),
2570 add_error(probcli,Msg,ProBExtension),
2571 fail.
2572 file_extension_can_be_loaded(_,_). % assume ok; if unrecognized we will load as B machine
2573
2574 %load_spec_file('pl',MainFile) :- !, load_cspm_spec_from_pl_file(MainFile). % no longer needed ?
2575 load_spec_file('csp',MainFile) :- !, load_cspm_spec_from_cspm_file(MainFile).
2576 load_spec_file('cspm',MainFile) :- !, load_cspm_spec_from_cspm_file(MainFile).
2577 load_spec_file('P',MainFile) :- !, load_xtl_spec_from_prolog_file(MainFile).
2578 load_spec_file('p',MainFile) :- !, load_xtl_spec_from_prolog_file(MainFile). % sometimes windows is confused about the upper case letter....
2579 load_spec_file('eventb',MainFile) :- !, load_eventb_file(MainFile).
2580 load_spec_file('v',MainFile) :- !,
2581 print('Warning: .v proof rule file format no longer supported, use -eval_rule_file FILE'),nl,
2582 % but even that may not work; some older rule files required predicate variables
2583 load_b_file_with_options(MainFile). % Siemens Rule File; now use -eval_rule_file
2584 load_spec_file('prob',MainFile) :- !,load_prob_file_with_options(MainFile). % .prob files
2585 load_spec_file('mch',MainFile) :- !,load_b_file_with_options(MainFile).
2586 load_spec_file('sys',MainFile) :- !,load_b_file_with_options(MainFile).
2587 load_spec_file('ref',MainFile) :- !,load_b_file_with_options(MainFile).
2588 load_spec_file('imp',MainFile) :- !,load_b_file_with_options(MainFile).
2589 load_spec_file('rmch',MainFile) :- !,load_b_file_with_options(MainFile).
2590 load_spec_file('def',MainFile) :- !,load_b_file_with_options(MainFile). % .def DEFINITIONS file
2591 load_spec_file('fuzz',MainFile) :- !,tcltk_open_z_file(MainFile).
2592 load_spec_file('tex',MainFile) :- !,tcltk_open_z_tex_file(MainFile).
2593 load_spec_file('zed',MainFile) :- !,tcltk_open_z_tex_file(MainFile). % proz .zed file
2594 load_spec_file('als',MainFile) :- !,tcltk_open_alloy_file(MainFile).
2595 load_spec_file('pla',MainFile) :- !,tcltk_open_alloy_prolog_ast_file(MainFile). % maybe we should detect .als.pl
2596 load_spec_file('tla',MainFile) :- !, load_tla_file(MainFile).
2597 load_spec_file('eval',File) :- !, % .eval file
2598 cli_set_empty_machine,
2599 assertz(option(eval_string_or_file(file(default),File,exists,_,norecheck))).
2600 load_spec_file('pb',File) :- !, cli_set_empty_machine, % .pb file
2601 cli_set_empty_machine,
2602 assertz(option(eval_string_or_file(file(default),File,exists,_,norecheck))).
2603 %load_spec_file('pml',MainFile) :- !,parsercall:call_promela_parser(MainFile),
2604 % parsercall:promela_prolog_filename(MainFile,PrologFile),
2605 % println_silent(consulting(PrologFile)),
2606 % tcltk_open_promela_file(PrologFile).
2607 load_spec_file(EXT,MainFile) :- print_error('Unknown file extension, assuming B machine:'),
2608 print_error(EXT),
2609 load_b_file_with_options(MainFile).
2610
2611 load_spec_file('pl',MainFile, Already_FullyProcessed) :- !, Already_FullyProcessed=true,
2612 printsilent('Processing PO file: '),printsilent(MainFile),nls,
2613 load_po_file(MainFile),
2614 (option(timeout(TO)) -> set_disprover_timeout(TO) ; reset_disprover_timeout),
2615 (option(disprover_options(L)) -> set_disprover_options(L) ; set_disprover_options([])),
2616 println_silent('Running ProB Disprover'),
2617 run_disprover_on_all_pos(Summary),
2618 print_disprover_stats,
2619 accumulate_infos(disprover,[po_files-1|Summary]),
2620 get_errors,
2621 (option(cli_check_disprover_result(Infos)) -> check_required_infos(Infos,Summary,load_po_file)
2622 ; option(strict_raise_error) -> check_required_infos([false-0,unknown-0,failure-0],Summary,load_po_file)
2623 % TO DO: provide way for user to specify expected info
2624 ; true),
2625 cli_process_options_for_alrady_fully_processed_file(MainFile),
2626 clear_loaded_machines.
2627 load_spec_file(EXT,MainFile,Already_FullyProcessed) :- (EXT='smt2' ; EXT= 'smt'), !,
2628 Already_FullyProcessed=true,
2629 printsilent('Processing SMT file: '),printsilent(MainFile),nls,
2630 (option(eval_repl([])) -> Opts = [repl] ; Opts=[]),
2631 smtlib2_file(MainFile,Opts).
2632 load_spec_file(EXT,F,false) :- load_spec_file(EXT,F).
2633
2634 load_prob_file_with_options(File) :-
2635 (option(release_java_parser) -> Options = [use_fastread] ; Options = []),
2636 load_prob_file(File,Options).
2637 load_b_file_with_options(File) :-
2638 (option(release_java_parser) -> Options = [release_java_parser,use_fastread]
2639 ; option(fast_read_prob) -> Options = [use_fastread] % use fastread for large .prob files
2640 ; Options = []),
2641 % TO DO: automatically release if no option requires parsing and no more file uses it; or print warning if release will affect other options like -repl (DEFINITIONS not available,...)
2642 load_b_file(File,Options).
2643
2644 % do not perform -execute_all if no parameters provided
2645 do_not_execute_automatically('pl').
2646 do_not_execute_automatically('smt2').
2647
2648 test_kodkod_and_exit(MaxResiduePreds,NOW) :-
2649 start_animation_without_computing,
2650 test_kodkod(MaxResiduePreds),
2651 halt_prob(NOW,0).
2652
2653 compare_kodkod_performance1(KPFile,Iterations,NOW) :-
2654 start_animation_without_computing,
2655 compare_kodkod_performance(KPFile,Iterations),
2656 halt_prob(NOW,0).
2657
2658 :- use_module(parsercall,[check_java_version/2,get_parser_version/1, ensure_console_parser_launched/0,
2659 connect_to_external_console_parser_on_port/1]).
2660 check_java_version :- check_java_version(V,Result),
2661 format('Result of checking Java version:~n ~w~n',[V]),
2662 (Result=compatible -> check_parser_version
2663 ; add_error(check_java_version,V)).
2664
2665 check_parser_version :- get_parser_version(PV),!,
2666 format(' ProB B Java Parser available in version: ~w.~n',[PV]). % will also launch parser
2667 check_parser_version :- add_error(check_parser_version,'Cannot start Java B Parser to obtain version number').
2668
2669 :- use_module(pathes_lib,[install_lib_component/2]).
2670 install_prob_lib(Lib,Opts) :- install_lib_component(Lib,Opts).
2671
2672 print_version(Kind) :- print_version(Kind,user_output).
2673
2674 print_version(short,Stream) :- print_short_version(Stream).
2675 print_version(cpp,Stream) :- print_cpp_version(Stream).
2676 print_version(java,Stream) :- print_java_version(Stream).
2677 print_version(full,Stream) :- print_full_version(Stream).
2678 print_version(full_verbose,Stream) :- print_full_version(Stream,verbose).
2679 print_version(host,Stream) :- print_host_version(Stream).
2680 print_version(lib,Stream) :- check_lib_contents(Stream,verbose).
2681
2682 :- use_module(version).
2683 print_short_version(Stream) :-
2684 version(V1,V2,V3,Suffix),revision(Rev),
2685 format(Stream,'VERSION ~p.~p.~p-~p (~p)~N',[V1,V2,V3,Suffix,Rev]).
2686
2687 :- use_module(parsercall,[get_parser_version/1, get_java_command_path/1, get_java_fullversion/1]).
2688 :- use_module(pathes_lib,[check_lib_contents/2]).
2689 print_full_version(Stream) :-
2690 (option_verbose ->
2691 (option_very_verbose
2692 -> print_full_version(Stream,very_verbose)
2693 ; print_full_version(Stream,verbose)
2694 )
2695 ; print_full_version(Stream,normal)
2696 ).
2697 print_full_version(Stream,Verbose) :-
2698 format(Stream,'ProB Command Line Interface~n',[]),
2699 print_probcli_version(Stream),
2700 ( Verbose=normal -> true
2701 ;
2702 current_prolog_flag(system_type,SysType),
2703 format(Stream,' Prolog System Type: ~p~N', [SysType]), % development or runtime
2704 safe_absolute_file_name(prob_home('.'),AppDir),
2705 format(Stream,' Application Path: ~p~N', [AppDir]),
2706 print_host_version(Stream),
2707 print_java_version(Stream),
2708 print_cpp_version(Stream),
2709 (Verbose = very_verbose
2710 -> print_prolog_flags(Stream), print_extensions(Stream), print_modules(Stream),
2711 check_lib_contents(Stream,verbose)
2712 ; check_lib_contents(Stream,silent)
2713 )
2714 ), print_compile_time_flags.
2715
2716 print_java_version(Stream) :-
2717 (get_java_command_path(JavaPath)
2718 -> format(Stream,' Java Runtime: ~p~N', [JavaPath]),
2719 (get_java_fullversion(JavaVersion)
2720 -> format(Stream,' Java Version: ~s~N', [JavaVersion])
2721 ; format(Stream,' Java Version: *** not available ***~N',[])
2722 ),
2723 (get_parser_version(ParserVersion)
2724 -> format(Stream,' Java Parser: ~p~N', [ParserVersion])
2725 ; format(Stream,' Java Parser: *** not available ***~N',[])
2726 )
2727 ; format(Stream,' Java Runtime: *** not available ***~N',[])
2728 ).
2729
2730 :- use_module(tools_platform, [host_platform/1, host_processor/1]).
2731 print_host_version(Stream) :-
2732 host_platform(HP),
2733 host_processor(Proc),
2734 (platform_is_64_bit -> Bits=64 ; Bits=32),
2735 format(Stream,' Host Processor: ~w (~w bits)~n Host Operating System: ~w~n',[Proc,Bits,HP]).
2736
2737
2738 print_probcli_version(Stream) :-
2739 full_version_str(VersStr),
2740 revision(Rev), lastchangeddate(LCD),
2741 current_prolog_flag(dialect, Dialect),
2742 (Dialect= swi, current_prolog_flag(version_git,PV) -> true
2743 ; current_prolog_flag(version,PV)
2744 ),
2745 format(Stream,' VERSION ~w (~p)~N ~p~N Prolog (~w): ~p~N',
2746 [VersStr,Rev,LCD,Dialect, PV]).
2747
2748
2749 :- use_module(compile_time_flags,[compile_time_flags/1, relevant_prolog_flags/1]).
2750 :- use_module(extension('regexp/regexp'),[get_cpp_version/1]).
2751 print_compile_time_flags :-
2752 compile_time_flags(list(Flags)),
2753 (Flags=[], \+ option_verbose -> true ; format(' COMPILE TIME FLAGS: ~w~N',[Flags])).
2754 print_prolog_flags(Stream) :-
2755 relevant_prolog_flags(Flags),
2756 format(Stream,' PROLOG FLAGS: ~w~N',[Flags]).
2757 print_extensions(Stream) :- findall(E,available_extension(E),Es),
2758 format(Stream,' EXTENSIONS: ~w~N',[Es]).
2759 print_cpp_version(Stream) :-
2760 available_extension(regexp_extension),!,
2761 get_cpp_version(V),
2762 format(Stream,' C++ Version for extensions: ~w~n',[V]).
2763 print_cpp_version(_).
2764 print_modules(Stream) :- findall(M,current_module(M),Ms), sort(Ms,SMs),
2765 format(Stream,' PROLOG MODULES: ~w~N',[SMs]).
2766
2767 print_logo :-
2768 % should be improved considerably; doesn't look very nice yet on macOS terminal due to line separation
2769 % â–„â–„â–„â–„ â–„â–„â–„â–„
2770 % â–ˆ â–ˆ â–ˆ â–ˆ
2771 % █▀▀▀ ▄ ▄▄▄ █▀▀▀▄
2772 % █ █ █▄█ █▄▄▄▀
2773 format_with_colour_nl(user_output,[blue],' ~s',[[9604,9604,9604,9604,32,32,32,32,32,32,32,9604,9604,9604,9604]]),
2774 format_with_colour_nl(user_output,[blue],' ~s',[[9608,32,32,32,9608,32,32,32,32,32,32,9608,32,32,32,9608]]),
2775 format_with_colour_nl(user_output,[blue],' ~s',[[9608,9600,9600,9600,32,9604,32,9604,9604,9604,32,9608,9600,9600,9600,9604]]),
2776 format_with_colour_nl(user_output,[blue],' ~s',[[9608,32,32,32,9608,32,32,9608,9604,9608,32,9608,9604,9604,9604,9600]]).
2777
2778 print_help :-
2779 print_version(full),
2780 print('Usage: probcli FILE [OPTIONS]'),nl,
2781 print(' OPTIONS are: '),nl,
2782 print(' -mc Nr model check; checking at most Nr states'),nl,
2783 print(' -model_check model check without limit on states explored'),nl,
2784 ( \+ option_verbose ->
2785 print(' -noXXX XXX=dead,inv,goal,ass (for model check)'),nl % -nodead, -noinv, -nogoal, -noass
2786 ;
2787 print(' -nodead do not look for deadlocks (for model check, animate, execute)'),nl,
2788 print(' -noinv do not look for invariant violations (for model check, animate, execute)'),nl,
2789 print(' -nogoal do not look for GOAL predicate (for model check, execute)'),nl,
2790 print(' -noass do not look for ASSERTION violations (for model check, execute)'),nl
2791 ),
2792 print(' -bf proceed breadth-first (default is mixed bf/df)'),nl,
2793 print(' -df proceed depth-first'),nl,
2794 print(' -mc_mode M M=hash,heuristic,random,dlk,breadth-first,depth-first,mixed,size'),nl, % dlk stands for out_degree_hash
2795 print(' -global_time_out N total timeout in ms for model/refinement checking and'),nl,
2796 print(' and execute steps and disprover checks'),nl,
2797 print(' -disable_timeout disable timeouts for operations, invariants,....'),nl, % speeds up mc
2798 print(' -t trace check (associated .trace file must exist)'),nl,
2799 print(' -init initialise specification'),nl,
2800 print(' -cbc OPNAME constraint-based invariant checking for an operation'),nl,
2801 print(' (you can also use OPNAME=all)'),nl,
2802 print(' -cbc_deadlock constraint-based deadlock checking'),nl,
2803 ( \+ option_verbose -> true ;
2804 print(' -cbc_deadlock_pred PRED as above but with additional predicate'),nl
2805 ),
2806 print(' -cbc_assertions constraint-based static assertion checking'),nl,
2807 print(' -cbc_refinement constraint-based static refinement checking'),nl,
2808 print(' -cbc_sequence S constraint-based search for sequence of operations'),nl,
2809 print(' -strict raise error if model-checking finds counter example'),nl,
2810 print(' or trace checking fails or any error state found'),nl,
2811 print(' -expcterr ERR expect error to occur (ERR=cbc,mc,ltl,...)'),nl,
2812 print(' -animate Nr random animation (max. Nr steps)'),nl,
2813 print(' -animate_all random animation until a deadlock is reached'),nl,
2814 print(' -animate_stats provide feedback which operations are animated or executed'),nl,
2815 print(' -execute Nr execute specification (maximally Nr steps)'),nl,
2816 print(' in contrast to -animate: stops at first operation found, is deterministic,'),nl,
2817 print(' does not store intermediate states and does not use TIME_OUT preference'),nl,
2818 print(' -execute_all execute until a deadlock, direct loop, goal or error is reached'),nl,
2819 print(' -execute_monitor monitor performance of execute'),nl,
2820 print(' -his File write history to File'),nl,
2821 print(' -his_option O additional option when writing a history (show_init,show_states,json,trace_file)'),nl,
2822 print(' -sptxt File save constants and variable values of last discovered state to File'),nl,
2823 print(' -sstxt Dir save constants and variable values of all discovered states to files in Dir'),nl,
2824 print(' -cache Directory automatically save constants to files and avoid recomputation'),nl,
2825 print(' -det_check check if animation steps are deterministic'),nl,
2826 print(' -det_constants only check if SETUP_CONSTANTS step is deterministic'),nl,
2827 ( \+ option_verbose -> true ;
2828 print(' -i interactive animation. Only for interactive sessions,'),nl,
2829 print(' the output can arbitrarily change in future versions. '),nl,
2830 print(' Do not build automatic tools using the interactive mode'),nl
2831 ),
2832 print(' -repl start interactive read-eval-loop'),nl,
2833 print(' -eval "E" evaluate expression or predicate'),nl,
2834 print(' -eval_file FILE evaluate expression or predicate from file'),nl,
2835 print(' -c print coverage statistics'),nl,
2836 print(' -cc Nr Nr print and check coverage statistics'),nl,
2837 print(' -vacuity_check look for vacuous implications in invariant'),nl,
2838 print(' -cbc_redundant_invariants Nr find redundant invariants, expecting Nr'),nl, % Nr exepcted
2839 print(' -statistics print memory and other statistics at the end'),nl,
2840 print(' -p PREF Val set preference to value'),nl,
2841 print(' -prefs FILE set preferences from Prolog file'),nl,
2842 print(' -pref_group G S set group G of preferences to predefined value set S'),nl,
2843 print(' -card GS Val set cardinality (aka scope) of B deferred set'),nl,
2844 print(' -goal "PRED" set GOAL predicate for model checker'),nl,
2845 print(' -check_goal check GOAL (after -mc, -t, or -animate)'),nl,
2846 print(' -scope "PRED" set scope predicate for model checker'),nl,
2847 print(' (only states satsifying this predicate will be examined)'),nl,
2848 print(' -property "PRED" virtually add predicate to PROPERTIES'),nl,
2849 print(' -s Port start socket server on given port'),nl,
2850 print(' -ss start socket server on port 9000'),nl,
2851 print(' -sf start socket server on some free port'),nl,
2852 print(' -l LogFile log activities in LogFile'),nl,
2853 print(' -ll log activities in /tmp/prob_cli_debug.log'),nl,
2854 print(' -logxml LogFile log activities in XML LogFile'),nl,
2855 print(' -logxml_write_ids P write variables/constants starting with P to XML LogFile'),nl,
2856 print(' -pp FILE pretty-print internal representation to file (or user_output)'), nl,
2857 print(' -ppf FILE like -pp, but force printing of all type infos'),nl,
2858 print(' -ppAB FILE like -ppf, but make output readable by Atelier-B'),nl,
2859 print(' -ppB FILE pretty-print Event-B model to file in valid B syntax'),nl,
2860 print(' -v verbose'),nl,
2861 ( \+ option_verbose -> true ;
2862 print(' -vv very verbose'),nl
2863 ),
2864 print(' -mc_with_tlc model check using TLC (see also TLC_WORKERS preference)'),nl,
2865 print(' -mc_with_lts_sym model check using LTSmin (symbolic)'),nl,
2866 print(' -mc_with_lts_seq model check using LTSmin (sequential)'),nl,
2867
2868 ( \+ option_verbose -> true ;
2869 print(' -ltsmin_option OPT set option for LTSmin (e.g, por)'),nl,
2870 print(' -ltsmin_ltl_output FILE set output file for LTSMin'),nl,
2871 print(' -symbolic_model_check ALGO ALGO is bmc, kinduction, ctigar, ic3'),nl,
2872 print(' -enabling_analysis_csv FILE perform operation enabling analysis'),nl,
2873 print(' -feasibility_analysis perform operation feasibility analysis'),nl,
2874 print(' -feasibility_analysis_csv FILE write feasibility result to file'),nl,
2875 print(' -read_write_matrix show read/write matrix for operations'),nl
2876 ),
2877 print(' -version print version information (-svers for short info)'),nl,
2878 print(' -check_java_version check that Java version compatible with ProB parser'),nl,
2879 print(' -assertions check ASSERTIONS'),nl,
2880 print(' -main_assertions check ASSERTIONS from main file only'),nl,
2881 print(' -properties check PROPERTIES'),nl,
2882 print(' -cache Dir use directory "Dir" to cache constants and variables'),nl,
2883 print(' -ltlfile F check LTL formulas in file F'),nl,
2884 print(' -ltlassertions check LTL assertions (in DEFINITIONS)'),nl,
2885 print(' -ltllimit L explore at most L states when model-checking LTL or CTL'),nl,
2886 print(' -ltlformula \"F\" check the LTL formula F'),nl,
2887 print(' -ctlformula \"F\" check the CTL formula F'),nl,
2888 print(' -save File save state space for later refinement check'),nl,
2889 print(' -refchk File refinement check against previous saved state space'),nl,
2890 print(' -mcm_tests Depth MaxStates EndPredicate File'),nl,
2891 print(' generate test cases with maximum length Depth, explore'),nl,
2892 print(' maximally MaxStates, the last state satisfies EndPredicate'),nl,
2893 print(' and the test cases are written to File'),nl,
2894 print(' -mcm_cover Operation'),nl,
2895 print(' when generating MCM test cases, Operation should be covered'),nl,
2896 print(' -cbc_tests Depth EndPredicate File'),nl,
2897 print(' generate test cases by constraint solving with maximum'),nl,
2898 print(' length Depth, the last state satisfies EndPredicate'),nl,
2899 print(' and the test cases are written to File'),nl,
2900 print(' -cbc_cover Operation'),nl,
2901 print(' when generating CBC test cases, Operation should be covered'),nl,
2902 % print(' -cbc_cover_all try and cover all operations'),nl, % is now default if no cbc_cover provided
2903 print(' -test_description File'),nl,
2904 print(' read information for test generation from File'),nl,
2905 print(' -dot CMD File write a graph to a dot file, with CMD being one of:'),nl,
2906 (is_dot_command(Cmd),command_description(Cmd,_,Desc),
2907 format(' ~w : ~w~n',[Cmd,Desc]),fail
2908 ; true),
2909 print(' -dotexpr CMD Expr File write a graph for Expr to a dot file, with CMD:'),nl,
2910 (is_dot_command_for_expr(Cmd),command_description(Cmd,_,Desc),
2911 format(' ~w : ~w~n',[Cmd,Desc]),fail
2912 ; true),
2913 print(' -puml CMD File write a graph to a plantuml file, with CMD being one of:'),nl,
2914 (is_plantuml_command(Cmd),command_description(Cmd,_,Desc),
2915 format(' ~w : ~w~n',[Cmd,Desc]),fail
2916 ; true),
2917 print(' -pumlexpr CMD Expr File write a graph for Expr to a plantuml file, with CMD:'),nl,
2918 (is_plantuml_command_for_expr(Cmd),command_description(Cmd,_,Desc),
2919 format(' ~w : ~w~n',[Cmd,Desc]),fail
2920 ; true),
2921 print(' -csv CMD File write a table to a CSV file, with CMD being one of:'),nl,
2922 (is_table_command(Cmd),command_description(Cmd,_,Desc),
2923 format(' ~w : ~w~n',[Cmd,Desc]),fail
2924 ; true),
2925 print(' -csvexpr CMD Expr File write a table for Expr to a CSV file, with CMD:'),nl,
2926 (is_table_command_for_expr(Cmd),command_description(Cmd,_,Desc),
2927 format(' ~w : ~w~n',[Cmd,Desc]),fail
2928 ; true),
2929 print(' -dot_output Path generate dot files for false assertions/properties'),nl,
2930 print(' -dot_all also generate dot files for true assertions/properties'),nl,
2931 print(' -rule_report generate HTML validation report for rules machines (.rmch)'),nl,
2932 print(' -csvhist E File evaluate expression over history and generate CSV file'),nl,
2933 print(' -visb JFile HFile use VisB JSON file JFILE to create HTML visualistion of history'),nl,
2934 print(' -visb_with_vars JFile HFile (similar, but also show variable values)'),nl,
2935 print(' -load_state File load state of ProB from a saved state space (generated by ProB Tcl/Tk or -save_state)'),nl,
2936 % For Eclipse Version only
2937 %% print(' -parsercp CP class path of the B Parser, this has to be a valid Java class path'),nl,
2938 %% print(' -cspm load CSP-M .csp file rather than B Machine .mch/.ref/.imp File'),nl,
2939 %% print(' -csp load CSP-M .pl file rather than B Machine File'),nl,
2940
2941 /* Options -cspref, -cspdeadlock, -cspdeterministic, and -csplivelock are deprecated, should be excluded in favor of -csp_assertion */
2942 print(' -cspref Spec [m= Impl File'),nl,
2943 print(' checks a refinement statement,'),nl,
2944 print(' where Spec and Impl are processes from File, and \'m\' the type of the refinement:'),nl,
2945 print(' \'T\' for traces, \'F\' for failures, or \'FD\' for failures-divergences.'),nl,
2946 print(' -cspdeadlock P m File'),nl,
2947 print(' checks a process for deadlock,'),nl,
2948 print(' where \'P\' is a process from File, and \'m\' the type of the model:'),nl,
2949 print(' \'F\' for failures and \'FD\' for failures-divergences.'),nl,
2950 print(' -cspdeterministic P m File'),nl,
2951 print(' checks a process for determinism,'),nl,
2952 print(' where \'P\' is a process from File, and \'m\' the type of the model:'),nl,
2953 print(' \'F\' for failures and \'FD\' for failures-divergences.'),nl,
2954 print(' -csplivelock P File'),nl,
2955 print(' checks a process for divergence,'),nl,
2956 print(' where \'P\' is a process from File.'),nl,
2957 /* Options -cspref, -cspdeadlock, -cspdeterministic, and -csplivelock are deprecated, should be excluded in favor of -csp_assertion */
2958
2959 print(' -csp_assertion \"A\" File'),nl,
2960 print(' checks the CSP assertion \'A\' on file \'File\''),nl,
2961 print(' -csp_eval "E" evaluate CSP-M expression.'),nl,
2962 print(' -csp_guide File CSP||B: Use the CSP File to control the B machine'),nl,
2963 print(' '),nl,
2964 ( \+ option_verbose -> true
2965 ;
2966 print(' -test_mode set random seed to the Prolog\'s current random state'),nl,
2967 print(' -rc runtime checking of types/pre-/post-conditions'),nl,
2968 print(' -state_trace File read a file of B predicates (one per line) and try find a matching trace.'),nl
2969
2970 ),
2971 print(' FILE extensions are: '),nl,
2972 print(' .mch for B abstract machines'),nl,
2973 print(' .ref for B refinement machines'),nl,
2974 print(' .imp for B implementation machines'),nl,
2975 print(' .sys for Event-B abstract machines'),nl,
2976 print(' .rmch for B Rule DSL machines'),nl,
2977 print(' .csp, .cspm for CSP-M files, same format as FDR'),nl,
2978 print(' .eventb for Event-B packages exported from Rodin ProB Plugin'),nl,
2979 print(' .tex, .zed for Z models'),nl,
2980 print(' .tla for TLA+ models'),nl,
2981 print(' .als for Alloy models'),nl,
2982 print(' .P for Prolog XTL models'),nl,
2983 ( option_verbose ->
2984 print(' Preferences PREF are: '),nl,
2985 print_eclipse_prefs
2986 ;
2987 print(' Use --help -v to print available preferences PREF'),nl
2988 ),
2989 print(' Set NO_COLOR environment variable to disable terminal colors'),nl,
2990 print(' More info at: https://prob.hhu.de/w/index.php/ProB_Cli'),nl,
2991 nl.
2992
2993
2994 set_argv(V) :-
2995 debug_println(20,set_argv(V)),
2996 external_functions:set_argv_from_atom(V).
2997
2998 :- use_module(b_global_sets, [set_user_defined_scope/2]).
2999 :- use_module(state_space_exploration_modes,[set_depth_breadth_first_mode/1, get_current_breadth_first_level/1]).
3000 :- use_module(tools_strings, [convert_cli_arg/2]).
3001 set_prefs :-
3002 if_option_set(cli_start_sym_mc_with_lts(_),
3003 preferences:set_preference(try_operation_reuse,false)), % LTSMIN does its own OPERATION_REUSE
3004 if_option_set(socket(_,_), % then we may need the event(.) transition_info for the Java API
3005 preferences:set_preference(store_event_transinfo,true)),
3006 option(set_prefs_from_file(File)),
3007 debug_println(20,load_preferences(File)),
3008 preferences:load_preferences(File),
3009 fail.
3010 set_prefs :-
3011 option(set_preference_group(P,V)),
3012 debug_println(20,set_preference_group(P,V)),
3013 set_preference_group(P,V),
3014 fail.
3015 % eclipse preference or 'normal preference'
3016 set_prefs :-
3017 ? option(set_pref(P,V)),
3018 set_pref(P,V),
3019 fail.
3020 set_prefs :- option(set_card(Set,V)),
3021 debug_println(20,set_card(Set,V)),
3022 convert_cli_arg(V,Value),
3023 set_user_defined_scope(Set,Value),
3024 fail.
3025 set_prefs :-
3026 ( option(breadth_first) -> set_depth_breadth_first_mode(breadth_first)
3027 ; option(depth_first) -> set_depth_breadth_first_mode(depth_first)
3028 ; option(depth_breadth_first_mode(M)) -> set_depth_breadth_first_mode(M)
3029 ; true
3030 ).
3031 :- use_module(tools_matching,[get_possible_preferences_matches_msg/2]).
3032 set_pref(P,V) :-
3033 debug_println(20,set_pref(P,V)),
3034 ? ( eclipse_preference(P,_)
3035 -> set_eclipse_preference(P,V)
3036 ; deprecated_eclipse_preference(P,_,_,_) -> set_eclipse_preference(P,V)
3037 ; obsolete_eclipse_preference(P) -> probcli_add_light_warning('Obsolete preference: ',P)
3038 ; obsolete_preference(P) -> probcli_add_light_warning('Obsolete preference: ',P)
3039 ; % might be a term if its a plugin preference
3040 atom_codes(P,Codes),
3041 append(Codes,".",Codes2), % to make term readable by read_from_codes
3042 read_from_codes(Codes2,Preference),
3043 (nonvar(Preference),preference_val_type(Preference,_)
3044 -> convert_cli_arg(V,Value),
3045 set_preference(Preference,Value)
3046 ; P=timeout ->
3047 add_error(probcli,'Unknown preference timeout. Either set preference TIME_OUT or use -gobal_time_out command','')
3048 ; get_possible_preferences_matches_msg(P,FuzzyMsg) ->
3049 ajoin(['Unknown preference: ',P,'. Did you mean:'],Msg),
3050 add_error(probcli,Msg,FuzzyMsg)
3051 ; get_possible_fuzzy_match_options(P,FuzzyMatches),
3052 % will only give perfect matches as P usually does not have the hyphen in front
3053 FuzzyMatches = [FMC|_] ->
3054 ajoin(['Unknown preference ', P, ' which looks like a probcli command! Did you want to call:'],Msg),
3055 add_error(probcli,Msg,FMC)
3056 ;
3057 add_error(probcli,'Unknown preference:',P)
3058 )
3059 ).
3060
3061 % add non severe warning:
3062 probcli_add_light_warning(Msg,Term) :- option(strict_raise_error),!,
3063 add_warning(probcli,Msg,Term). % does not write on user_error
3064 probcli_add_light_warning(Msg,Term) :- add_message(probcli,Msg,Term).
3065
3066 set_optional_errors :- % register optional/expected errors in the error_manager; avoid printing on stderr
3067 reset_optional_errors_or_warnings,
3068 (option(optional_error(Type)) ; option(expect_error(Type)) ; option(expect_error_pos(Type,_Line,_Col))),
3069 register_optional_error_or_warning(Type),
3070 fail.
3071 set_optional_errors.
3072
3073 % explicit state model checking, without LTL/CTL
3074 regular_safety_model_check_now(Nr,Runtime,WallTime,MCRes,NOW) :-
3075 statistics(runtime,[T1,_]),
3076 statistics(walltime,[W1,_]),
3077 (option(timeout(TO)) -> safe_time_out(regular_safety_model_check(Nr,Time,MCRes),TO,Res)
3078 ; regular_safety_model_check(Nr,Time,MCRes), Res=success
3079 ),
3080 statistics(runtime,[T2,_]),
3081 statistics(walltime,[W2,_]),
3082 WallTime is W2-W1,
3083 Runtime is T2-T1,
3084 (Res=time_out
3085 -> add_warning(model_check_incomplete,'Not all states examined due to -global_time_out option set by user: ',TO),
3086 writeln_log(timeout_occurred(NOW,model_check(Nr,Time,MCRes))),
3087 coverage(just_summary),
3088 MCRes=time_out
3089 ; true).
3090
3091 :- use_module(model_checker,[model_checking_is_incomplete/6]).
3092
3093 % TO DO: check for ignored states
3094 % code somewhat redundant also with model_check_incomplete below
3095 add_model_checking_warnings(FindInvViolations,FindDeadlocks,FindGoal,FindAssViolations) :-
3096 %print(check(model_checking_is_incomplete(FindInvViolations,FindDeadlocks,FindGoal,FindAssViolations,Msg,Term))),nl,
3097 model_checking_is_incomplete(FindInvViolations,FindDeadlocks,FindGoal,FindAssViolations,Msg,Term),
3098 add_warning(model_check_incomplete,Msg,Term),
3099 % TO DO: store for accumulate_infos
3100 fail.
3101 add_model_checking_warnings(_,_,_,_).
3102
3103 :- use_module(state_space,[current_state_id/1]).
3104 regular_safety_model_check(Nr,Time,ErrRes) :-
3105 statistics(runtime,[T1,_]),
3106 statistics(walltime,[W1,_]),
3107 catch(model_check_aux(Nr,T1,W1,Time,ErrRes), user_interrupt_signal, (
3108 statistics(walltime,[W2,_]), TotalWT is W2-W1,
3109 format_with_colour_nl(user_error,[red],'~nmodel checking interrupted after ~w ms by user (CTRL-C)',[TotalWT]),
3110 coverage(just_summary),
3111 perform_feedback_options_after_exception,
3112 throw(user_interrupt_signal)
3113 )).
3114
3115 % perform some important options for user feedback after CTRL-C interrupts model checking, execute, ...
3116 perform_feedback_options_after_exception :-
3117 (option(check_op_cache(_)) -> cli_check_op_cache([]) ; true),
3118 if_options_set(csv_table_command(TECommand,TableFormulas,TableOptions,TableCSVFile),
3119 csv_table_command(TECommand,TableFormulas,TableOptions,TableCSVFile)),
3120 (option(get_coverage_information(FCC)) -> pretty_print_coverage_information_to_file(FCC) ; true),
3121 (option(cli_print_statistics(X)), (cli_print_statistics(X) -> fail) ; true).
3122
3123 model_check_aux(Nr,T1,W1,Time,ErrRes) :-
3124 (option(no_deadlocks) -> FindDeadlocks=0 ; FindDeadlocks=1),
3125 (option(no_invariant_violations) -> FindInvViolations=0 ; FindInvViolations=1),
3126 (option(no_goal) -> FindGoal=0 ; FindGoal=1),
3127 (option(no_state_errors) -> FindStateErrors=0 ; FindStateErrors=1),
3128 (option(no_assertion_violations)
3129 -> FindAssViolations=0
3130 ; FindAssViolations=1
3131 ),
3132 get_preference(por,POR),
3133 StopAtFullCoverage=0,
3134 %STOPMCAFTER = 86400000, /* 86400000 = 1 day timeout */
3135 STOPMCAFTER = 1152921504606846975, /* equals 13,343,998,895 days */
3136 InspectExistingNodes = 1,
3137 write_xml_element_to_log(model_checking_options,[find_deadlocks/FindDeadlocks,
3138 find_invariant_violations/FindInvViolations, find_goal/FindGoal,
3139 find_assertion_violations/FindAssViolations,
3140 find_state_errors/FindStateErrors,
3141 partial_order_reduction/POR,
3142 inspect_existing_nodes/InspectExistingNodes]),
3143 (tcltk_interface:do_model_check(Nr,NodesAnalysed,STOPMCAFTER,ErrRes,
3144 FindDeadlocks,FindInvViolations,FindGoal,
3145 FindAssViolations,FindStateErrors,StopAtFullCoverage,POR, InspectExistingNodes)
3146 -> (statistics(runtime,[T2,_]), statistics(walltime,[W2,_]),
3147 Time1 is T2-T1, WTime is W2-W1,
3148 (model_checker: expired_static_analysis_time(AnalysisTime) ->
3149 Time is Time1 - AnalysisTime
3150 ; Time = Time1, AnalysisTime=0),
3151 formatsilent('Model checking time: ~w ms (~w ms walltime)~n',[Time,WTime]),
3152 formatsilent('States analysed: ~w~n',[NodesAnalysed]),
3153 get_state_space_stats(_,NrTransitions,_,_),
3154 printsilent('Transitions fired: '),printsilent(NrTransitions),nls,
3155 (get_current_breadth_first_level(Level)
3156 -> formatsilent('Breadth-first levels: ~w~n',[Level]) % is this the equivalent of TLC's diameter?
3157 ; true),
3158 write_xml_element_to_log(model_checking_statistics,
3159 [result/ErrRes,runtime/Time,walltime/WTime,
3160 states/NodesAnalysed,transitions/NrTransitions,staticAnalysisTime/AnalysisTime]),
3161 (ErrRes = no
3162 -> print('No counter example Found, not all states visited'),nl,
3163 add_warning(model_check_incomplete,'Not all states examined due to limit set by user: ',Nr)
3164 ; ErrRes=all
3165 -> (tcltk_find_max_reached_node
3166 -> (not_interesting(_)
3167 -> print('No counter example found. However, not all transitions were computed (and some states not satisfying SCOPE predicate were ignored) !')
3168 ; print('No counter example found. However, not all transitions were computed !')
3169 )
3170 ; not_interesting(_)
3171 -> print_green('No counter example found. ALL states (satisfying SCOPE predicate) visited.')
3172 % b_get_machine_searchscope(Scope)
3173 ; print_green('No counter example found. ALL states visited.')
3174 ),nl,
3175 add_model_checking_warnings(FindInvViolations,FindDeadlocks,FindGoal,FindAssViolations)
3176 ; % ErrRes is not no or all
3177 print_red('*** COUNTER EXAMPLE FOUND ***'),nl,
3178 debug_println(20,ErrRes),nl,
3179 tcltk_interface:translate_error_for_tclk(ErrRes,TclTkRes),
3180 print(TclTkRes),nl,
3181 print_history_as_counter_example(true),
3182 error_occurred(TclTkRes)
3183 ),nl
3184 )
3185 ; % do_model_check failed
3186 statistics(runtime,[T2,_]), Time1 is T2-T1,
3187 (model_checker: expired_static_analysis_time(AnalysisTime) -> Time is Time1 - AnalysisTime
3188 ; Time = Time1),
3189 printsilent('Model checking time: '), printsilent(Time), printsilent(' ms'),nls,
3190 print_error('*** Model checking FAILED '),nl,
3191 ErrRes=fail,
3192 definite_error_occurred
3193 ).
3194
3195 print_history_as_counter_example(CheckInv) :-
3196 (option(silent) -> true
3197 ; option(no_counter_examples) -> true % -nocounter
3198 ; cli_print_history,
3199 (silent_mode(off), CheckInv=true,
3200 current_state_id(ID),invariant_violated(ID)
3201 -> b_interpreter:analyse_invariant_for_state(ID)
3202 ; true)
3203 ).
3204
3205 cli_print_history :-
3206 tcltk_interface:tcltk_get_history(list(Hist)),
3207 length(Hist,Len),
3208 format('*** TRACE (length=~w):~n',[Len]),
3209 reverse(Hist,Trace),
3210 print_nr_list(Trace).
3211
3212 % perform all cbc checks on current machine
3213 cbc_check(_NOW) :-
3214 option(cbc_deadlock_check(DeadlockGoalPred)),
3215 cbc_deadlock_check(DeadlockGoalPred),
3216 fail.
3217 cbc_check(_NOW) :-
3218 option(constraint_based_check(OpName)),
3219 constraint_based_check(OpName),
3220 fail.
3221 cbc_check(_NOW) :- option(cbc_assertions(AllowEnumWarning,Options)),
3222 cbc_assertions(AllowEnumWarning,Options),
3223 fail.
3224 %cbc_check(NOW) :-
3225 % option(cbc_pred(TargetPredString)),
3226 % check_loaded(cbc_pred),
3227 % print('% Starting Constraint-Based Check for Predicate: '), print(TargetPredString),nl,
3228 % b_set_up_valid_state_with_pred(NormalisedState,Pred) TO DO: add this feature
3229 cbc_check(_NOW) :- option(cbc_sequence(Sequence,TargetPredString,Findall)),
3230 cbc_sequence(Sequence,TargetPredString,Findall),
3231 fail.
3232 cbc_check(_NOW) :- option(cbc_refinement),
3233 cbc_refinement,
3234 fail.
3235 cbc_check(_NOW) :- option(cbc_redundant_invariants(NrExpected)),
3236 cbc_redundant_invariants(NrExpected),
3237 fail.
3238 cbc_check(_).
3239
3240 :- use_module(tcltk_interface,[tcltk_constraint_based_check/2,
3241 tcltk_constraint_based_check_with_timeout/2,
3242 tcltk_constraint_find_deadlock_state_with_goal/3,
3243 tcltk_cbc_find_trace/4,
3244 tcltk_cbc_refinement_check/2]).
3245 :- use_module(probsrc(bmachine),[b_is_operation_name/1]).
3246
3247 constraint_based_check(all) :-
3248 check_loaded_not_empty(constraint_based_check),
3249 print_repl_prompt_s('% Starting Constraint-Based Check for all Operations: '),nl,
3250 start_xml_feature(cbc_operation_check,all_operations,true,FINFO),
3251 (tcltk_constraint_based_check(list(Result),ErrorsWereFound)
3252 -> print('% Constraint-Based Check Result: '),nl,
3253 print(Result),nl,
3254 write_result_to_file(Result),
3255 (ErrorsWereFound=true
3256 -> print_red('*** CONSTRAINT-BASED CHECK FOUND ERRORS ***'),nl, error_occurred(cbc)
3257 ; (ErrorsWereFound=false -> print_green('NO ERRORS FOUND'),nl)
3258 ; print_red('*** TIMEOUT OCCURRED ***'),nl,error_occurred(cbc)
3259 )
3260 ; write_result_to_file(cbc_check_failed), Result=internal_error, ErrorsWereFound=false,
3261 add_internal_error('ConstraintBasedCheck unexpectedly failed. ',cbc_check(all)),definite_error_occurred
3262 ),nl,
3263 write_cbc_check_result(Result,ErrorsWereFound),
3264 stop_xml_feature(cbc_operation_check,FINFO).
3265 constraint_based_check(OpName) :- OpName\=all, % -cbc OpName
3266 check_loaded_not_empty(constraint_based_check),
3267 print_repl_prompt_s('% Starting Constraint-Based Check for Operation: '), print(OpName),nl,
3268 start_xml_feature(cbc_operation_check,operation,OpName,FINFO),
3269 (tcltk_constraint_based_check_with_timeout(OpName,Result)
3270 -> print('% Constraint-Based Check Result: '),nl, print(Result),nl,
3271 write_result_to_file(Result),
3272 (Result=time_out
3273 -> print_red('*** TIMEOUT OCCURRED ***'),nl, error_occurred(cbc)
3274 ; (Result=ok -> print_green('NO ERRORS FOUND'),nl)
3275 ; print_red('*** CONSTRAINT-BASED CHECK FOUND ERRORS ***'),nl,error_occurred(cbc) )
3276 ; write_result_to_file(constraint_based_check_failed), Result=internal_error,
3277 add_error(probcli,'ConstraintBasedCheck unexpectedly failed'),
3278 (b_is_operation_name(OpName) -> true
3279 ; add_error(probcli,'Unknown Operation Name: ',OpName)),
3280 definite_error_occurred
3281 ),nl,
3282 write_cbc_check_result(Result),
3283 stop_xml_feature(cbc_operation_check,FINFO).
3284
3285 write_cbc_check_result(Result) :-
3286 functor(Result,F,_), % example result: no_counterexample_exists(Ids,Prd,Other)
3287 write_xml_element_to_log(cbc_check_result,[result/F]).
3288 write_cbc_check_result(Result,ErrorsWereFound) :- functor(Result,F,_),
3289 write_xml_element_to_log(cbc_check_result,[result/F,errors_were_found/ErrorsWereFound]).
3290
3291 cbc_deadlock_check(DeadlockGoalPred) :-
3292 print_repl_prompt_s('% Starting Constraint-Based DEADLOCK check '),nl,
3293 start_xml_feature(cbc_deadlock_check,FINFO),
3294 (tcltk_constraint_find_deadlock_state_with_goal(DeadlockGoalPred,false,Res)
3295 -> write_result_to_file(Res),
3296 (Res=time_out ->
3297 print_red('*** TIME_OUT occurred ***'),nl,
3298 error_occurred(cbc_deadlock_check_time_out)
3299 ; print_red('*** DEADLOCK state found ***'),nl,
3300 error_occurred(cbc_deadlock_check),
3301 (silent_mode(on) -> true
3302 ; print('*** STATE = '),nl,
3303 current_b_expression(DBState), translate:print_bstate(DBState),nl,
3304 print('*** END DEADLOCKING STATE '),nl
3305 )
3306 )
3307 ; write_result_to_file(no_deadlock_found), Res=no_deadlock_found,
3308 print_green('No DEADLOCK state found'),nl
3309 ),
3310 write_cbc_check_result(Res),
3311 stop_xml_feature(cbc_deadlock_check,FINFO).
3312 cbc_assertions(AllowEnumWarning,Options) :-
3313 findall(OPT,option(cbc_option(OPT)),FullOptions,Options),
3314 check_loaded_not_empty(cbc_assertions),
3315 print_repl_prompt_s('% Starting Constraint-Based static ASSERTIONS check '),nl,
3316 start_xml_feature(cbc_assertion_check,allow_enumeration_warning,AllowEnumWarning,FINFO),
3317 write_prolog_term_as_xml_to_log(options(Options)),
3318 (cbc_constraint_find_static_assertion_violation(Res,FullOptions)
3319 -> process_cbc_assertion_result(Res,AllowEnumWarning)
3320 ; write_result_to_file(cbc_assertions_failed), Res=internal_error,
3321 print_red('CBC Check failed'),nl,
3322 error_occurred(cbc_assertions_failure)
3323 ),
3324 write_cbc_check_result(Res),
3325 stop_xml_feature(cbc_assertion_check,FINFO).
3326 cbc_sequence(Sequence,TargetPredString,Findall) :-
3327 check_loaded_not_empty(cbc_sequence),
3328 print_repl_prompt_s('% Starting Constraint-Based Check for Sequence: '), print_repl_prompt_s(Sequence),
3329 start_xml_feature(cbc_sequence_check,sequence,Sequence,FINFO),
3330 (TargetPredString='' -> true ; print(' with target: '), print(TargetPredString)),
3331 nl,
3332 write_xml_element_to_log(options,[target_predicate/TargetPredString]),
3333 (tcltk_cbc_find_trace(Sequence,TargetPredString,Findall,Res)
3334 -> (Res=ok -> print_green('Sequence found and executed'),nl
3335 ; Res=time_out -> error_occurred(cbc_sequence_time_out)
3336 ; Res=no_solution_found -> print_red('*** NO SOLUTION FOUND '),error_occurred(cbc_sequence_no_solution_found)
3337 ; Res=nr_cbc_sols(NrSols) -> print('*** # SOLUTIONS FOUND: '),print(NrSols),nl
3338 ; print_red('*** Unknown result: '), print(Res),nl,
3339 error_occurred(cbc_sequence)
3340 )
3341 ; print('*** Internal error: Check failed '), error_occurred(cbc_sequence), Res=internal_error
3342 ),
3343 write_cbc_check_result(Res),
3344 stop_xml_feature(cbc_sequence_check,FINFO).
3345 cbc_refinement :-
3346 check_loaded_not_empty(cbc_refinement),
3347 print_repl_prompt_s('% Starting Constraint-Based static refinement check '),nl,
3348 start_xml_feature(cbc_refinement_check,FINFO),
3349 tcltk_cbc_refinement_check(list(Result),ErrorsWereFound),
3350 print('% Constraint-Based Refinement Check Result: '),nl,print(Result),nl,
3351 (ErrorsWereFound = time_out -> print_red('*** TIME_OUT occurred ***'),nl,error_occurred(cbc_refinement_time_out) ;
3352 ErrorsWereFound = true -> print_red('*** Refinement Violation found ***'),nl,error_occurred(cbc_refinement) ;
3353 print_green('No static Refinement Violation found'),nl
3354 ),
3355 write_xml_element_to_log(cbc_check_result,[errors_were_found/ErrorsWereFound]),
3356 stop_xml_feature(cbc_refinement_check,FINFO).
3357 :- use_module(b_state_model_check,[cbc_find_redundant_invariants/2]).
3358 cbc_redundant_invariants(NrExpected) :-
3359 check_loaded_not_empty(cbc_redundant_invariants),
3360 print_repl_prompt_s('% Starting Constraint-Based invariant redundancy check'),nl,
3361 start_xml_feature(cbc_redundant_invariants,FINFO),
3362 cbc_find_redundant_invariants(Res,TimeoutOccured),
3363 length(Res,NrInvs),
3364 (Res = [] -> print_green('No redundant invariants found'),nl
3365 ; format('*** REDUNDANT INVARIANTS (~w) ***~n',[NrInvs]),
3366 prnt(1,Res), nl
3367 ),
3368 (NrExpected = NrInvs -> true
3369 ; format_with_colour_nl(user_error,[red],'*** Expected ~w redundant invariants (instead of ~w).',[NrExpected,NrInvs]),
3370 error_occurred(cbc_redundant_invariants)),
3371 write_xml_element_to_log(cbc_redundant_invariants,[redundant_invariants/NrInvs, timeout_occured/TimeoutOccured]),
3372 stop_xml_feature(cbc_redundant_invariants,FINFO).
3373
3374 prnt(_,[]).
3375 prnt(N,[H|T]) :- format(' ~w : ~w~n',[N,H]), N1 is N+1, prnt(N1,T).
3376
3377 :- use_module(solver_interface,[predicate_uses_unfixed_deferred_set/2, unfixed_typed_id_in_list/3]).
3378 process_cbc_assertion_result(time_out,_) :- !,
3379 write_result_to_file(no_counterexample_found('"TIME_OUT"')),
3380 print_red('*** TIME_OUT occurred ***'),nl,
3381 error_occurred(cbc_assertions_time_out).
3382 process_cbc_assertion_result(no_counterexample_exists(Constants,TotPredicate,OtherInfo),AllowEnumWarning) :- !,
3383 print_green('No counter-example to ASSERTION exists '),(OtherInfo=[] -> true ; print(OtherInfo)),nl,
3384 (unfixed_typed_id_in_list(TID,CType,Constants) % TO DO: look only at component
3385 -> write_deferred_set_used(AllowEnumWarning),
3386 get_texpr_id(TID,CID),pretty_type(CType,CTypeS),
3387 format('Warning: Some constants use deferred sets (e.g., ~w:~w) which have only been checked for a single cardinality!~n',[CID,CTypeS])
3388 ; predicate_uses_unfixed_deferred_set(TotPredicate,CType)
3389 -> write_deferred_set_used(AllowEnumWarning),pretty_type(CType,CTypeS),
3390 format('Warning: Some quantified variables use deferred sets (e.g., ~w) which have only been checked for a single cardinality!~n',[CTypeS]) % happens for tests 1173, 1174
3391 ; write_result_to_file(no_counterexample_exists)
3392 %,print('Computing unsat core: '),nl,unsat_cores:unsat_core(TotPredicate,Core),print('CORE: '),translate:print_bexpr(Core),nl
3393 ). % WE HAVE A PROOF
3394 process_cbc_assertion_result(no_counterexample_found,AllowEnumWarning) :- !,
3395 write_result_to_file(no_counterexample_found('"Enumeration Warning"')),
3396 print('No counter-example for ASSERTION found (*enumeration warning occured*)'),nl,
3397 (AllowEnumWarning=true -> true ; error_occurred(cbc_assertions_enumeration_warning)).
3398 process_cbc_assertion_result(counterexample_found,_) :- !,
3399 write_result_to_file(counterexample_found),
3400 print_red('*** Counter-example for ASSERTION found ***'),nl,
3401 error_occurred(cbc_assertions),
3402 (silent_mode(on) -> true
3403 ; print('*** STATE = '),nl,
3404 current_b_expression(DBState), translate:print_bstate(DBState),nl,
3405 print('*** END ASSERTION counter-example STATE '),nl
3406 ),
3407 (get_dot_file('cbc_assertions',DFile) -> generate_dot_from_assertions(DFile) ; true).
3408 process_cbc_assertion_result(Res,A) :-
3409 write_result_to_file(Res),
3410 add_internal_error('Unknown: ',process_cbc_assertion_result(Res,A)).
3411
3412
3413 write_deferred_set_used(AllowEnumWarning) :-
3414 write_result_to_file(no_counterexample_found('"Deferred Sets Used"')),
3415 (AllowEnumWarning=true -> true ; error_occurred(cbc_assertions_enumeration_warning)).
3416
3417 :- use_module(tools_io,[safe_open_file/4]).
3418 write_result_to_file(Result) :- option(cbc_result_file(FILE)),
3419 safe_open_file(FILE,write,Stream,[encoding(utf8)]),
3420 !,
3421 write(Stream,Result),
3422 close(Stream).
3423 write_result_to_file(_).
3424
3425
3426
3427 if_option_set(Option,Call) :-
3428 if_option_set(Option,Call,true).
3429 if_option_set(Option,Then,Else) :-
3430 (option(Option) -> call_for_option(Then) ; call_for_option(Else)).
3431 ifm_option_set(Option,Call) :-
3432 ifm_option_set(Option,Call,true).
3433 ifm_option_set(Option,Then,Else) :- % can perform multiple options
3434 findall(Then,option(Option),As),
3435 (As=[] -> call_for_option(Else) ; perform(As)).
3436 perform([]).
3437 perform([A|T]) :-
3438 call_for_option(A),
3439 perform(T).
3440 call_for_option(Call) :- (call(Call) -> true ; add_internal_error('probcli option call failed: ',Call)).
3441 if_option_set_loaded(Option,Action,Call) :-
3442 ( option(Option),check_loaded_not_empty(Action) ->
3443 call_for_option(Call)
3444 ; true).
3445 ifm_option_set_loaded(Option,Action,Call) :- % can perform multiple options
3446 findall(Call,(option(Option),check_loaded_not_empty(Action)),As),
3447 perform(As).
3448
3449
3450
3451 if_options_set(Option,Call) :- % allow multiple solutions for Option
3452 option(Option),call(Call),fail.
3453 if_options_set(_,_).
3454
3455 print_options :- print('CLI OPTIONS: '),nl,
3456 option(Option), print(Option), nl, fail.
3457 print_options :- nl.
3458
3459 :- use_module(cbcsrc(enabling_analysis),[infeasible_operation_cache/1]).
3460 :- use_module(cbcsrc(sap),[explore_and_generate_testcases/7,cbc_gen_test_cases_from_string/5, tcl_get_stored_test_cases/1]).
3461 :- use_module(translate,[print_bexpr/1]).
3462
3463 mcm_test_case_generation(ADepth,AMaxStates,ATarget,Output) :-
3464 arg_is_number(ADepth,MaxDepth),
3465 arg_is_number(AMaxStates,MaxStates),
3466 bmachine:b_parse_machine_predicate(ATarget,Target),!,
3467 get_comma_or_space_separated_options(mcm_cover,Events),
3468 (option(silent) -> true
3469 ; print('mcm test case generation, maximum search depth: '),print(MaxDepth),nl,
3470 print('mcm test case generation, maximum number of states: '),print(MaxStates),nl,
3471 print('mcm test case generation, target state predicate: '),print_bexpr(Target),nl,
3472 print('mcm test case generation, output file: '),print(Output),nl,
3473 print('mcm test case generation, events to cover: '),print_list(Events),nl
3474 ),
3475 explore_and_generate_testcases(Events,Target,MaxDepth,MaxStates,Output,NumTests,Uncovered),
3476 printsilent('mcm test case generation, generated test cases: '),printsilent(NumTests),nls,
3477 print_uncovered('mcm test case generation, ',Uncovered).
3478 mcm_test_case_generation(_ADepth,_AMaxStates,_ATarget,_Output) :-
3479 print_error('MCM Test Case Generation failed'),
3480 error_occurred(mcm_tests).
3481
3482 cbc_test_case_generation(ADepth,TargetString,Output) :-
3483 arg_is_number(ADepth,MaxDepth),
3484 ( option(cbc_cover_all) -> Events=all
3485 ; (get_comma_or_space_separated_options(cbc_cover,Events), Events \= []) -> true
3486 ; Events=all ),
3487 (\+ option(cbc_cover_final) -> FEvents = Events
3488 ; Events=all -> FEvents=all,
3489 add_error(cbc_cover_final,'Option cbc_cover_final not compatible with trying to cover all events')
3490 ; FEvents = final(Events),
3491 println_silent('constraint based test case generation, target events considered final')),
3492 printsilent('constraint based test case generation, maximum search depth: '),printsilent(MaxDepth),nls,
3493 printsilent('constraint based test case generation, target state predicate: '),printsilent(TargetString),nls,
3494 printsilent('constraint based test case generation, output file: '),printsilent(Output),nls,
3495 (TargetString = '#not_invariant' -> BMC=invariant_violation
3496 ; TargetString = '#deadlock' -> BMC=deadlock
3497 ; BMC = 'none'),
3498 (BMC \= 'none' ->
3499 printsilent('constraint based test case generation, performing bounded model checking'),nls
3500 ; option(silent) -> true
3501 ; print('constraint based test case generation, events to cover: '),print_list(Events),nl),
3502 cbc_gen_test_cases_from_string(FEvents,TargetString,MaxDepth,Output,Uncovered),
3503 !,
3504 format('constraint based test case generation finished~n',[]),
3505 (BMC \= 'none'
3506 -> tcl_get_stored_test_cases(list(Tests)), %print(tests(Tests)),nl,
3507 (Tests=[] -> print_green('No counterexample found'),nl
3508 ; Tests = [_|_], BMC=deadlock -> add_error(deadlock,'Deadlock found by bmc')
3509 ; Tests = [_|_] -> add_error(invariant_violation,'Invariant violation found by bmc')
3510 ; add_internal_error('Unexpected bmc result: ',Tests)
3511 )
3512 ; Uncovered=[_|_],option(strict_raise_error)
3513 -> add_error(cbc_tests,'Uncovered events: ',Uncovered)
3514 ; print_uncovered('constraint based test case generation, ',Uncovered)
3515 ).
3516 cbc_test_case_generation(_ADepth,_ATarget,_Output) :-
3517 print_error('Constraint based test case generation failed!'),
3518 error_occurred(cbc_tests).
3519
3520 print_uncovered(Msg,Uncovered) :-
3521 include(enabling_analysis:infeasible_operation_cache,Uncovered,Infeasible),
3522 (Infeasible=[]
3523 -> format('~wuncovered events: ',[Msg]),print_list(Uncovered),nl
3524 ; format('~winfeasible uncovered events: ',[Msg]),print_list(Infeasible),nl,
3525 exclude(enabling_analysis:infeasible_operation_cache,Uncovered,Feasible),
3526 format('~wuncovered events: ',[Msg]),print_list(Feasible),nl
3527 ).
3528
3529 print_list(all) :- print('** all **').
3530 print_list(list(L)) :- print_list(L). % possibly not used
3531 print_list([]) :- print('** none **').
3532 print_list([H|T]) :- length([H|T],Len), format('(~w) ',[Len]),
3533 print(H),print(' '),print_list2(T).
3534 print_list2([]).
3535 print_list2([H|T]) :- print(H),print(' '),print_list2(T).
3536
3537 get_comma_or_space_separated_options(Option,Selection) :-
3538 functor(O,Option,1),
3539 findall(E, (option(O),arg(1,O,CommaSep),
3540 split_by_seperator(CommaSep,Es),
3541 member(E,Es)),
3542 Selection).
3543
3544 split_by_seperator(NonAtomic,Res) :- \+ atomic(NonAtomic),!, Res=[NonAtomic].
3545 split_by_seperator(String,Strings) :-
3546 atom_chars(String,Chars),
3547 split_by_seperator2(Chars,Strings).
3548 split_by_seperator2(Chars,Result) :-
3549 append(AChars,[X|B],Chars),seperator(X),!,
3550 (AChars=[] -> Result=Rest ; atom_chars(A,AChars), Result=[A|Rest]),
3551 split_by_seperator2(B,Rest).
3552 split_by_seperator2(Chars,[String]) :- atom_chars(String,Chars).
3553
3554 seperator(',').
3555 seperator(' ').
3556 seperator(';').
3557
3558 ltl_check_assertions :-
3559 (option(ltl_limit(Limit)) -> true; Limit= -1), % -1 means no limit
3560 formatsilent('Model checking LTL assertions~n',[]),
3561 ltl_check_assertions(Limit,Outcome),!,
3562 ( Outcome = pass -> print_green('LTL check passed'),nl
3563 ; Outcome = fail -> print_red('*** LTL check failed'),nl,error_occurred(ltl)
3564 ; Outcome = no_tests -> print_red('*** No LTL assertions found, test failed'),nl,definite_error_occurred
3565 ; print_red('*** An error occurred in the LTL assertion test'),nl,
3566 definite_error_occurred).
3567 ltl_check_assertions :-
3568 add_internal_error('Call failed:',ltl_check_assertions),definite_error_occurred.
3569
3570 :- use_module(probltlsrc(ltl),[parse_ltlfile/2]).
3571 ltl_check_file(Filename) :-
3572 (option(ltl_limit(Limit)) -> true; Limit= -1), % -1 means no limit
3573 ajoin(['Model checking LTL assertions from file ',Filename],Msg),
3574 print_repl_prompt_s(Msg),nl,
3575 ( parse_ltlfile(Filename, Formulas)
3576 -> ltl_check_formulas(Formulas,Limit)
3577 ; print_red('An error occurred while parsing the LTL file.\n'),
3578 definite_error_occurred
3579 ).
3580
3581 :- use_module(probltlsrc(ltl),[ltl_model_check2/4]).
3582 ltl_check_formulas([],_) :-
3583 print_green('All LTL formulas checked.\n').
3584 ltl_check_formulas([formula(Name,F)|Rest],Limit) :-
3585 print('Checking formula '),print(Name),print(':\n'),
3586 ltl_model_check2(F,Limit,init,Status),
3587 ( Status == no ->
3588 print_red('Counter-example found for formula \"'),print_red(Name),
3589 print_red('\", saving trace file.\n'),
3590 ajoin(['ltlce_', Name, '.trace'], Tracefile),
3591 tcltk_save_history_as_trace_file(prolog,Tracefile),
3592 add_error(ltl_counterexample,'Counter-example was found')
3593 ; Status == ok ->
3594 ltl_check_formulas(Rest,Limit)
3595 ; Status == incomplete ->
3596 ajoin(['Model was not completly model-checked, aborted after ',Limit,' new states'],
3597 Msg),
3598 add_error(ltl,Msg)
3599 ;
3600 ajoin(['Model checker returns unexpected result (',Status,')'],Msg),
3601 add_error(ltl,Msg)).
3602
3603 % Mode = init or specific_node(ID) or starthere
3604 cli_ltl_model_check(Formula,Mode,ExpectedStatus,Status) :-
3605 (option(ltl_limit(Max)) -> true; Max = -1), % -1 means no limit
3606 start_xml_feature(ltl_model_check,formula,Formula,FINFO),
3607 ltl_model_check(Formula,Max,Mode,Status),
3608 write_xml_element_to_log(model_check_result,[status/Status,expected_status/ExpectedStatus,(mode)/Mode]),
3609 check_status(Status,ExpectedStatus,Formula,ltl),
3610 stop_xml_feature(ltl_model_check,FINFO).
3611
3612 % Mode = init or specific_node(ID) or starthere
3613 cli_ctl_model_check(Formula,Mode,ExpectedStatus,Status) :-
3614 (option(ltl_limit(Max)) -> true; Max = -1), % -1 means no limit
3615 start_xml_feature(ctl_model_check,formula,Formula,FINFO),
3616 ctl_model_check(Formula,Max,Mode,Status),
3617 write_xml_element_to_log(model_check_result,[status/Status,expected_status/ExpectedStatus,(mode)/Mode]),
3618 check_status(Status,ExpectedStatus,Formula,ctl),
3619 stop_xml_feature(ctl_model_check,FINFO).
3620
3621 :- use_module(extension('markov/dtmc_model_checking.pl')).
3622 cli_pctl_model_check(Formula,Mode,ExpectedStatus,Status) :-
3623 % use_module(extension('markov/dtmc_model_checking.pl')),
3624 (option(ltl_limit(Max)) -> true; Max = -1), % -1 means no limit
3625 dtmc_model_checking:pctl_model_check(Formula,Max,Mode,Status),
3626 check_status(Status,ExpectedStatus,Formula,pctl).
3627
3628 check_expected(St,Exp,Mode) :-
3629 (St=Exp -> true
3630 ; ajoin(['Unexpected ',Mode,' model checking result ',St,', expected: '],Msg),
3631 add_error(Mode,Msg,Exp)).
3632
3633 check_status(ok,Expected,Formula,ltl) :- !, % TO DO: make uniform ? CTL returns true; LTL returns ok
3634 format_with_colour_nl(user_output,[green],'LTL Formula TRUE.~nNo counter example found for ~w.',[Formula]),
3635 flush_output(user_output),
3636 check_expected(true,Expected,ltl).
3637 check_status(true,Expected,Formula,ctl) :- !,
3638 format_with_colour_nl(user_output,[green],'CTL Formula TRUE.~nNo counter example found for ~w.',[Formula]),
3639 flush_output(user_output),
3640 check_expected(true,Expected,ctl).
3641 check_status(true,Expected,Formula,pctl) :- !,
3642 format_with_colour_nl(user_output,[green],'PCTL Formula TRUE: ~w~n',[Formula]),
3643 flush_output(user_output),
3644 check_expected(true,Expected,pctl).
3645 check_status(solution(Bindings),Expected,Formula,pctl) :- !,
3646 format_with_colour_nl(user_output,[green],'PCTL Formula TRUE: ~w',[Formula]),
3647 format_with_colour_nl(user_output,[green],'PCTL Solutions: ~w~n',[Bindings]),
3648 flush_output(user_output),
3649 check_expected(true,Expected,pctl).
3650 check_status(incomplete,Expected,Formula,LTLorCTL) :- !,
3651 incomplete_warning(LTLorCTL,Warning),
3652 add_warning(Warning, 'Warning: Model Check incomplete for: ', Formula),nl,
3653 format('No counter example found so far for ~w.~n',[Formula]),
3654 check_expected(incomplete,Expected,LTLorCTL).
3655 check_status(NO,Expected,Formula,LTLorCTL) :- (NO=no ; NO=false),!, % TO DO: make uniform
3656 (Expected==false
3657 -> format_with_colour_nl(user_error,[red],'Model Check Counterexample found for: ~w',[Formula])
3658 ; add_error(LTLorCTL, 'Model Check Counterexample found for: ', Formula)
3659 ),
3660 cli_print_history,
3661 print('Formula '), print('FALSE.'),nl,
3662 debug_format(19,'Use -his FILE -his_option show_states to display states of counterexample~n',[]),
3663 nl,
3664 check_expected(false,Expected,LTLorCTL).
3665 check_status(Status,Expected,Formula,LTLorCTL) :-
3666 add_internal_error('Unknown status: ', check_status(Status,Expected,Formula,LTLorCTL)).
3667
3668 incomplete_warning(ltl,ltl_incomplete) :- !.
3669 incomplete_warning(ctl,ctl_incomplete) :- !.
3670 incomplete_warning(X,X).
3671
3672 :- if(environ(prob_release,true)).
3673
3674 run_benchmark(_, _, _) :-
3675 add_message(probcli, 'Command-line argument for benchmarking is not available in release mode.').
3676
3677 :- else.
3678
3679 :- use_module('../tests/smt_solver_benchmarks/alloy2b_benchmarks').
3680 :- use_module('../tests/smt_solver_benchmarks/smt_solver_benchmarks').
3681 run_benchmark(alloy, CmdName, AlloyFilePath) :-
3682 alloy2b_benchmarks:benchmark_alloy_command(CmdName, AlloyFilePath).
3683 run_benchmark(smt, bmc, Path) :-
3684 smt_solver_benchmarks:run_additional_bmc_benchmarks(false, [Path]), halt.
3685 run_benchmark(smt, cbc_deadlock, Path) :-
3686 smt_solver_benchmarks:run_additional_deadlock_benchmarks(false, [Path]), halt.
3687 run_benchmark(smt, cbc_inv, Path) :-
3688 smt_solver_benchmarks:run_additional_inductive_inv_benchmarks(false, [Path]), halt.
3689
3690 :- endif.
3691
3692 evaluate_from_commandline :-
3693 retractall(eval_result(_,_)),
3694 option(eval_string_or_file(A,B,Q,E,Rchk)), %print(eval(A,B,Q,E)),nl,
3695 % treat eval_string and eval_file together to ensure proper order of evaluation
3696 % (only possible side-effect at the moment: formula can add new machine_string facts)
3697 eval_string_or_file(A,B,Q,E,Rchk),
3698 fail.
3699 evaluate_from_commandline :- print_eval_results,
3700 % treat -repl option or -replay File option
3701 (option(eval_repl([File1|TF]))
3702 -> (repl_evaluate_expressions([File1|TF]) -> true ; true)
3703 ; start_repl_if_required).
3704 start_repl_if_required :-
3705 (option(eval_repl([]))
3706 -> (repl_evaluate_expressions([]) -> true ; true)
3707 ; true).
3708
3709 :- dynamic eval_result/2.
3710 add_eval_result(R) :- retract(eval_result(R,N)),!,
3711 N1 is N+1, assertz(eval_result(R,N1)).
3712 add_eval_result(R) :- assertz(eval_result(R,1)).
3713 print_eval_results :- findall(R/N, eval_result(R,N), L), sort(L,SL),
3714 (SL=[] -> true ; format('Evaluation results: ~w~n',[SL])).
3715
3716 :- use_module(tools_printing,[print_error/1, format_error_with_nl/2]).
3717 %eval_string_or_file(string,_String,_,'FALSE',_Recheck) :- !. % comment in to skip evalf
3718 eval_string_or_file(string,String,_,Expected,Recheck) :-
3719 set_current_probcli_command(eval_string(String)),
3720 (option(silent),nonvar(Expected) -> true
3721 ; nonvar(Expected) -> format('eval(~w): ~w~n',[Expected,String])
3722 ; format('eval: ~w~n',[String])
3723 ),
3724 reset_error_spans, % avoid underlining previous errors in eval_string
3725 (eval_string_with_time_out(String,StringResult,EnumWarning,_LS) -> true
3726 ; print_error('Eval string failed: '), print_error(String),
3727 error_occurred(eval_string)
3728 ),
3729 add_eval_result(StringResult),
3730 eval_check_result(StringResult,Expected,EnumWarning,eval_string,String),
3731 (Recheck=recheck(Mode) -> recheck_pp_of_last_expression(Mode,_,_) ; true),
3732 unset_current_probcli_command.
3733 eval_string_or_file(file(bench),File,Quantifier,Expected,Recheck) :- !,
3734 ( member(Solver,[prob,kodkod,sat,'sat-z3','z3', 'cdclt',clingo]),
3735 (eval_string_or_file(file(Solver),File,Quantifier,Expected,Recheck) -> fail)
3736 ; true).
3737 eval_string_or_file(file(Solver),File,Quantifier,Expected,_) :-
3738 % evaluate a single formula stored in a file
3739 set_current_probcli_command(eval_file(Solver,File)),
3740 turn_show_error_source_off, % reduce clutter in user feedback; eval_file used in ProB Logic Calculator for example
3741 formatsilent('~nEvaluating file: ~w~n',[File]),
3742 error_manager:reset_error_scopes, % TO DO: avoid that exceptions mess up error scopes in eval_string/file
3743 statistics(runtime,[Start,_]),
3744 statistics(walltime,[W1,_]),
3745 (Expected=='TRUE' -> TypeInfo=predicate(_) % avoids parsing as expression
3746 ; true),
3747 (eval_file(Solver,File,Quantifier,Result,EnumWarning,TypeInfo)
3748 -> statistics(walltime,[W2,_]), WT is W2-W1,
3749 translate_solver_result(Result,Infos),
3750 accumulate_file_infos(File,Solver,[walltime-WT|Infos]),
3751 add_eval_result(Result),
3752 eval_check_result(Result,Expected,EnumWarning,eval_file,File)
3753 ; statistics(walltime,[W2,_]), WT is W2-W1,
3754 accumulate_file_infos(File,Solver,[failure-1,false-0,true-0,unknown-1,walltime-WT]),
3755 add_eval_result(eval_file_failed),
3756 print_error('Eval from file failed: '), print_error(File),
3757 error_occurred(eval_file)
3758 ),
3759 statistics(runtime,[Stop,_]), Time is Stop - Start,
3760 debug_format(19,'Time for ~w : ~w ms (~w ms walltime)~n',[File,Time,WT]),
3761 turn_show_error_source_on,
3762 unset_current_probcli_command.
3763
3764 translate_solver_result('TRUE',I) :- !, I=[false-0,true-1,unknown-0].
3765 translate_solver_result('FALSE',I) :- !, I=[false-1,true-0,unknown-0].
3766 translate_solver_result('UNKNOWN',I) :- !,I=[false-0,true-0,unknown-1].
3767 translate_solver_result('**** TIME-OUT ****',I) :- !,I=[false-0,true-0,unknown-1].
3768 translate_solver_result(_,[false-0,true-0,unknown-1]). % we could record this as error
3769
3770 eval_check_result(StringResult,Expected,_,Origin,File) :- Expected\=StringResult,!,
3771 format_error_with_nl('! Evaluation error, expected result to be: ~w (but was ~w) in ~w',[Expected,StringResult,File]),
3772 error_occurred(Origin).
3773 eval_check_result('NOT-WELL-DEFINED',Expected,_,Origin,File) :- var(Expected),!,
3774 format_error_with_nl('! Evaluation NOT-WELL-DEFINED in ~w',[File]),
3775 error_occurred(Origin).
3776 eval_check_result(_,_,EnumWarning,_,_) :- eval_gen_enum_warning(EnumWarning).
3777
3778 eval_gen_enum_warning(false) :- !.
3779 eval_gen_enum_warning(time_out) :- !,error_occurred(eval_string_time_out).
3780 eval_gen_enum_warning(_) :- print_error('Enumeration warning occurred'),
3781 error_occurred(eval_string_enum_warning,warning).
3782 %repl :- repl_evaluate_expressions([]).
3783 :- use_module(parsercall,[ensure_console_parser_launched/0]).
3784 repl_evaluate_expressions(StartFiles) :-
3785 get_errors, % first clear any errors from earlier commands
3786 nl,
3787 print('ProB Interactive Expression and Predicate Evaluator '), nl,
3788 print('Type ":help" for more information.'),nl,
3789 turn_show_error_source_off, % reduce clutter in user feedback
3790 (option(evaldot(File))
3791 -> print('Solutions written to dot file: '), print(File),nl
3792 ; true
3793 ),
3794 (ensure_console_parser_launched
3795 -> maplist(prob_cli:set_repl_input_file(verbose),StartFiles),
3796 top_level_eval
3797 ; print('>>> ABORTING REPL'),nl),
3798 turn_show_error_source_on.
3799
3800 :- use_module(user_interrupts,[interruptable_call/1]).
3801 top_level_eval :-
3802 catch(top_level_eval1, halt(0), (format('~s', ["Bye."]), nl)).
3803
3804 :- use_module(tools_printing,[reset_terminal_colour/1, print_red/1, print_green/1]).
3805 print_repl_prompt :- reset_terminal_colour(user_output), write('>>> ').
3806 print_repl_prompt_s(_) :- option(silent),!.
3807 print_repl_prompt_s(P) :- print_repl_prompt(P).
3808 print_repl_prompt(P) :- reset_terminal_colour(user_output), write(P).
3809 %print_repl_prompt(P) :- tools_printing:start_terminal_colour(dark_gray,user_output), write(P), reset_terminal_colour(user_output).
3810
3811 top_level_eval1 :-
3812 (interruptable_call(eval1) -> true
3813 ; print_red('Evaluation failed or interrupted'),nl,
3814 print_repl_prompt('Use :q to quit REPL'),nl),
3815 reset_errors,
3816 top_level_eval1.
3817 eval0 :- store_last_error_location_for_repl,
3818 reset_errors, % get_errors prints errors again and quits in -strict mode
3819 % However, reset_errors means that in subsequent REPL runs errors are not printed again!!
3820 garbage_collect, eval1.
3821 eval1 :- repl_multi_read_line(Expr), eval_probcli_repl_line(Expr).
3822
3823 :- dynamic last_repl_error/2.
3824 store_last_error_location_for_repl :-
3825 retractall(last_repl_error(_,_)),
3826 check_error_span_file_linecol(_,File,Line,_,_,_),!,
3827 assertz(last_repl_error(File,Line)).
3828 store_last_error_location_for_repl.
3829
3830 :- dynamic current_repl_input_stream/2.
3831 close_repl_input_stream(file_closed) :- retract(current_repl_input_stream(X,File)),!,
3832 format(":replayed ~w~n",[File]),
3833 close(X).
3834 close_repl_input_stream(no_file).
3835 :- use_module(tools_io,[safe_open_file/4]).
3836 set_repl_input_file(_,File) :- current_repl_input_stream(_,File),!,
3837 add_error(set_repl_input_file,'Cyclic file replay: ',File).
3838 set_repl_input_file(Verbose,File) :-
3839 % close_repl_input_stream, % this way we allow one REPL file to call another
3840 safe_open_file(File,read,Stream,[encoding(utf8)]),!,
3841 (Verbose=verbose -> format('Replaying REPL commands in file: ~w~n',[File]) ; true),
3842 asserta(current_repl_input_stream(Stream,File)).
3843 set_repl_input_file(_,_).
3844
3845 repl_multi_read_line(Line) :-
3846 (current_repl_input_stream(Stream,_)
3847 -> repl_multi_read_line(Stream,Line),
3848 format(user_output,'~s~n',[Line])
3849 ; repl_multi_read_line(user_input,Line)
3850 ).
3851 repl_multi_read_line(Stream,Line) :- repl_multi_read_line_aux(Stream,'>>> ',[],Line).
3852 repl_multi_read_line_aux(Stream,Prompt,SoFar,Line) :-
3853 prompt(OldPrompt,Prompt),
3854 call_cleanup(read_line(Stream,L), prompt(_,OldPrompt)),
3855 (L=end_of_file -> close_repl_input_stream(FileC),
3856 (SoFar=[], FileC = file_closed
3857 -> repl_multi_read_line(Line) % last line of file empty; do not process
3858 ; FileC = file_closed -> Line=SoFar
3859 ; Line=end_of_file) % user pressed CTRL-D
3860 ; append(LFront,[92],L) % line ends with slash \
3861 -> append(LFront,[10],LFront2), % insert newline instead;
3862 % note cleanup_newlines in parsercall transforms this into 8232 \x2028 Unicode
3863 append(SoFar,LFront2,NewSoFar),
3864 repl_multi_read_line_aux(Stream,'... ',NewSoFar,Line)
3865 ; append(SoFar,L,Line)).
3866
3867 :- use_module(eval_strings).
3868 :- dynamic trace_eval/0.
3869
3870 generate_atom_list([],[],R) :- !, R=[].
3871 generate_atom_list([],Last,[NewAtom]) :-
3872 reverse(Last,RL),
3873 atom_codes(NewAtom,RL).
3874 generate_atom_list([39|X],[],[QuotedAtom|T]) :- !,
3875 get_quoted_atom(X,[],QuotedAtom,Rest),
3876 strip_leading_ws(Rest,X2),
3877 generate_atom_list(X2,[],T).
3878 generate_atom_list([32|X],Last,[NewAtom|T]) :- !,
3879 reverse(Last,RL),
3880 atom_codes(NewAtom,RL),
3881 strip_leading_ws(X,X2),
3882 generate_atom_list(X2,[],T).
3883 generate_atom_list([H|X],Last,Res) :- generate_atom_list(X,[H|Last],Res).
3884
3885 get_quoted_atom([],Acc,QuotedAtom,[]) :- reverse(Acc,R), atom_codes(QuotedAtom,R).
3886 get_quoted_atom([39|T],Acc,QuotedAtom,T) :- !, reverse(Acc,R), atom_codes(QuotedAtom,R).
3887 get_quoted_atom([H|T],Acc,QuotedAtom,Rest) :- get_quoted_atom(T,[H|Acc],QuotedAtom,Rest).
3888
3889
3890 strip_leading_ws([32|X],R) :- !, strip_leading_ws(X,R).
3891 strip_leading_ws(X,X).
3892
3893 :- meta_predicate call_probcli_option(0).
3894 call_probcli_option(_:Option) :- just_assert_option(Option), !,
3895 (option(Option) -> true ; assert_option(Option)).
3896 call_probcli_option(_:statistics) :- !, % avoid calling SICS version
3897 cli_print_statistics(full).
3898 call_probcli_option(Option) :-
3899 catch(call(Option), error(existence_error(A,B),E), (
3900 treat_existence_error(A,B,E,Option),
3901 nl % ensure that next prompt is printed
3902 )).
3903
3904 % commands that require no execution; just asserting option(.)
3905 just_assert_option(depth_first).
3906 just_assert_option(breadth_first).
3907 just_assert_option(strict_raise_error).
3908 just_assert_option(no_deadlocks).
3909 just_assert_option(no_invariant_violations).
3910 just_assert_option(no_goal).
3911 just_assert_option(no_ltl).
3912 just_assert_option(no_assertion_violations).
3913 just_assert_option(no_state_errors).
3914 just_assert_option(no_counter_examples).
3915
3916 treat_existence_error(source_sink,File,E,Option) :- !,
3917 format_with_colour_nl(user_error,[red],
3918 '* Could not find file ~w~n* for probcli command ~w~n* Detailed error: ~w',[File,Option,E]).
3919 treat_existence_error(_,_,E,Option) :-
3920 format_with_colour_nl(user_error,[red],
3921 '* probcli command not yet supported in REPL: ~w~n* Error: ~w',[Option,E]).
3922
3923 reload_mainfile :-
3924 file_loaded(_,MainFile),
3925 reset_errors,
3926 print_repl_prompt_s('Reloading and initialising file: '), print_repl_prompt_s(MainFile),nl,
3927 clear_loaded_files,
3928 load_main_file(MainFile,0,_),
3929 get_errors,
3930 cli_start_animation(0),
3931 cli_start_initialisation(0).
3932
3933 % REPL EVAL LOOP:
3934 eval_probcli_repl_line(end_of_file) :- !, eval_line(end_of_file).
3935 eval_probcli_repl_line(Line) :- strip_ws(Line,SLine),
3936 catch(eval_line(SLine), E, (
3937 E=halt(_) -> throw(E) % e.g., coming from :quit; will be caught above
3938 ; E='$aborted' -> throw(E) % thrown by SWI-Prolog on abort by user
3939 ; add_error(repl,'Uncaught Exception in REPL: ',E),
3940 nl % ensure that next prompt is printed
3941 )).
3942
3943 % strip whitespace at end and beginning
3944 strip_ws([H|T],Res) :- is_ws(H),!, strip_ws(T,Res).
3945 strip_ws(C,Res) :- reverse(C,CR), strip_ws2(CR,SCR), reverse(SCR,Res).
3946 strip_ws2([H|T],Res) :- is_ws(H),!, strip_ws2(T,Res).
3947 strip_ws2(R,R).
3948
3949 is_ws(32).
3950
3951 :- use_module(performance_messages,[toggle_perfmessages/0]).
3952 eval_line([]) :- !, print_repl_prompt('Type :q or :quit to quit.'),nl,eval0.
3953 eval_line(end_of_file) :- !, halt_exception(0).
3954 % Haskell GHCI like syntax
3955 eval_line(":r") :- !, eval_line("--reload").
3956 eval_line(":reload") :- !, eval_line("--reload").
3957 eval_line("--reload") :- !,
3958 (reload_mainfile -> true ; get_errors,print_repl_prompt('Error(s) occured during reload (use :e to jump to first error)'),nl),
3959 eval0.
3960 % TO DO: other Haskell commands :info E :l FILE , let pattern = expression
3961 eval_line(":prefs") :- !,print_eclipse_prefs, eval0.
3962 eval_line([45|Command]) :- % -command
3963 generate_atom_list([45|Command],[],ArgV),
3964 %print(argv(ArgV)),nl,
3965 % try and parse like commands passed to probcli
3966 get_options(ArgV,recognised_cli_option,Options,[],fail),
3967 print_repl_prompt('Executing probcli command: '),print_repl_prompt(Options),nl,!,
3968 (maplist(prob_cli:call_probcli_option,Options) -> true
3969 ; print_red('Failed to execute probcli arguments'),nl),
3970 eval0.
3971 eval_line("+") :- !, add_last_expression_to_unit_tests, eval0.
3972 eval_line("$+") :- !, preferences:temporary_set_preference(expand_avl_upto,-1,CHNG),
3973 print_last_value,preferences:reset_temporary_preference(expand_avl_upto,CHNG),
3974 eval0.
3975 %eval_line("$$") :- !, print_last_expression, eval0. % now in eval_strings
3976 eval_line("$$$") :- !, % $$0 - $$9 commands to print last expression with indentation
3977 indent_print_last_expression, eval0.
3978 %eval_line("$") :- !, print_last_info, eval0. % now in eval_strings
3979 eval_line("!trace") :- !, eval_line("^").
3980 eval_line("^") :- !,
3981 (retract(trace_eval) -> print_repl_prompt('TRACING OFF'),nl
3982 ; assertz(trace_eval), print_repl_prompt('TRACING ON'),nl), eval0.
3983 eval_line("!observe") :- !, toggle_observe_evaluation.
3984 eval_line("!v") :- !, tcltk_turn_debugging_off.
3985 eval_line("!p") :- !, toggle_perfmessages.
3986 eval_line("!perf") :- !, toggle_perfmessages.
3987 eval_line("!profile") :- !, eval_line("%").
3988 eval_line("!print_profile") :- !, eval_line("%%").
3989 eval_line("%") :- !, print_repl_prompt('PROFILING : '), %spy([avl:avl_size/2]),
3990 (current_prolog_flag(profiling,on)
3991 -> set_prolog_flag(profiling,off), print('OFF') ;
3992 set_prolog_flag(profiling,on), print('ON')),
3993 nl,print_repl_prompt('USE %% to print profile info'),nl,eval0.
3994 eval_line("%%") :- !, nl,print_repl_prompt('PROLOG PROFILE INFORMATION:'), nl,
3995 catch(print_profile,
3996 error(existence_error(_,_),_),
3997 print_red('CAN ONLY BE USED WHEN RUNNING PROB FROM SOURCE')),
3998 nl,
3999 debug:timer_statistics,
4000 eval0.
4001 eval_line("!print_coverage") :- !, nl,print_repl_prompt('PROLOG COVERAGE INFORMATION:'), nl,
4002 (current_prolog_flag(source_info,on) -> true ; print_red('Only useful when current_prolog_flag(source_info,on)!'),nl),
4003 catch(print_coverage,
4004 error(existence_error(_,_),_),
4005 print_red('CAN ONLY BE USED WHEN RUNNING PROB FROM SOURCE')),
4006 nl,
4007 eval0.
4008 eval_line("!profile_reset") :- !, nl,print_repl_prompt('RESETTING PROLOG PROFILE INFORMATION'), nl,
4009 catch(profile_reset,
4010 error(existence_error(_,_),_),
4011 print_red('CAN ONLY BE USED WHEN RUNNING PROB FROM SOURCE')),
4012 eval0.
4013 eval_line("%%%") :- !, nl,print('PROFILE INFORMATION (Starting TK Viewer):'), nl,
4014 catch(
4015 (use_module(library(gauge)), gauge:view),
4016 error(existence_error(_,_),_),
4017 print_red('CAN ONLY BE USED WHEN RUNNING PROB FROM SOURCE')),
4018 nl,
4019 eval0.
4020 eval_line("!debug") :- !,
4021 print_repl_prompt('ENTERING PROLOG DEBUG MODE:'),
4022 catch(
4023 debug,
4024 error(existence_error(_,_),_),
4025 print_red('CAN ONLY BE USED WHEN RUNNING PROB FROM SOURCE')),
4026 nl,
4027 eval0.
4028 eval_line("@") :- !, get_preference(find_abort_values,OldVal),
4029 print_repl_prompt('Try more aggressively to detect ill-defined expressions: '),
4030 (OldVal=true -> Val=false ; Val=true), print(Val),nl,
4031 temporary_set_preference(find_abort_values,Val) , eval0.
4032 eval_line("!") :- !, toggle_eval_det,eval0.
4033 eval_line("!norm") :- !, toggle_normalising,eval0.
4034 eval_line(Codes) :- parse_eval_command(Codes,CommandName,Argument),!,
4035 debug_println(9,executing_eval_command(CommandName,Argument)),
4036 (exec_eval_command(CommandName,Argument) -> eval0
4037 ; format_with_colour_nl(user_error,[red,bold],'Command ~w failed',[CommandName]),
4038 eval0).
4039 eval_line(ExpressionOrPredicate) :- (trace_eval -> trace ; true),
4040 (eval_codes(ExpressionOrPredicate,exists,_,_,_,_)
4041 -> eval0
4042 ; print_red('Evaluation failed'),nl,eval0).
4043
4044 parse_eval_command([C|Rest],CommandName,Argument) :- [C]=":",
4045 eval_command(Cmd,CommandName),
4046 append(Cmd,RestArg,Rest),
4047 (RestArg = [Letter1|_] -> is_ws(Letter1) /* otherwise command name continues */ ; true),
4048 strip_ws(RestArg,Argument),
4049 (eval_command_help(CommandName,[],_), Argument = [_|_]
4050 -> format_with_colour_nl(user_error,[red],'WARNING: Command ~w does not take arguments!',[CommandName])
4051 ; eval_command_help(CommandName,[_|_],_), Argument = []
4052 -> format_with_colour_nl(user_error,[red],'WARNING: Command ~w requires arguments!',[CommandName])
4053 ; true).
4054
4055 % TO DO: some of these commands should also be made available in the Tcl/Tk Console
4056 eval_command("q",quit).
4057 eval_command("quit",quit).
4058 eval_command("halt",quit).
4059 eval_command("x",exit).
4060 eval_command("exit",exit).
4061 eval_command("f",find).
4062 eval_command("find",find).
4063 eval_command("*",apropos).
4064 eval_command("apropos",apropos).
4065 eval_command("help",help).
4066 eval_command("h",help).
4067 eval_command("?",help).
4068 eval_command("ctl",ctl(init)). % :ctl
4069 eval_command("ctlh",ctl(starthere)). % :ctlh
4070 eval_command("ltl",ltl(init)). % :ltl
4071 eval_command("ltlh",ltl(starthere)). % :ltlh
4072 eval_command("pctl",pctl(init)). % :pctl
4073 eval_command("pctlh",pctl(starthere)). % :pctlh
4074 eval_command("reset",reset_animator(hard)). % :reset
4075 eval_command("reset-history",reset_animator(history_only)). % :reset
4076 eval_command("statistics",statistics).
4077 eval_command("stats",statistics). % :stats
4078 eval_command("states",state_space_stats). % :states
4079 eval_command("state",show_state_info(2000)). % :state
4080 eval_command("statespace",state_space_display). % :statespace
4081 eval_command("u",unsat_core).
4082 %eval_command("core",unsat_core).
4083 eval_command("show",show_last_as_table). % :show
4084 eval_command("dot",show_last_as_dot(no_dot_viewing)). % :dot
4085 eval_command("dotty",show_last_as_dot(dotty)).
4086 eval_command("dotpdf",show_last_as_dot(dot)).
4087 eval_command("sfdp",show_last_as_dot(sfdp)).
4088 eval_command("browse",browse). % :browse
4089 eval_command("abstract_constants",check_abstract_constants). % :abstract_constants
4090 eval_command("det_check_constants",det_check_constants). % :det_check_constants
4091 eval_command("b",browse).
4092 eval_command("hbrowse",hbrowse). % :hbrowse browse hiearchy
4093 eval_command("hshow",hshow). % show inclusion hieararchy
4094 eval_command("comp",show_components). % :comp
4095 eval_command("replay",replay_repl_file). % :replay
4096 eval_command("trim",trimcore). % :trim
4097 eval_command("src",show_source). %:src
4098 eval_command("source",show_source). %:source
4099 eval_command("origin",show_origin). %:origin
4100 eval_command("edit",edit_main_file).
4101 eval_command("e",edit_main_file). % :e
4102 eval_command("comment",comment).
4103 eval_command("machine",show_machine_info(statistics)). %:machine
4104 eval_command("machine-stats",show_machine_info(statistics)). %:machine
4105 eval_command("files",show_machine_info(files)). %:files
4106 eval_command("syntax",syntax_help). % :syntax
4107 eval_command("open",open_file). % :open
4108
4109 available_commands(SLC) :-
4110 findall(Cmd,(eval_command(Cs,_),atom_codes(Cmd,[58|Cs])), LC),
4111 sort(LC,SLC).
4112
4113 eval_command_help(exit,[],'Exit ProB').
4114 eval_command_help(find,['P'],'Find state in state-space which makes LTL atomic proposition P true; LTL Propositions: {B-Pred}, e(Op), [Op], true, false, sink').
4115 eval_command_help(ltl(starthere),['F'],'Check LTL formula F starting from current state').
4116 eval_command_help(ltl,['F'],'Check LTL formula F; LTL Operators: G,F,X,U,W,R,not,&,or,=>; LTL Propositions: {B-Pred}, e(Op), [Op], true, false, sink; Past-LTL Operators: Y,H,O,S,T (dual to X,G,F,U,R)').
4117 eval_command_help(ctl(starthere),['F'],'Check CTL formula F starting from current state').
4118 eval_command_help(ctl(_),['F'],'Check CTL formula F in all initial states; CTL Syntax: ExUy,EXx,AXx,EFx,AGx,EX[Op]x,e(Op),{B-Pred}').
4119 eval_command_help(pctl(starthere),['F'],'Check PCTL formula F starting from current state').
4120 eval_command_help(pctl(_),['F'],'Check PCTL formula F; PCTL Operators: not, &, or, =>, {B-Pred}, e(Op), [Op], true, false, sink, P op {Exp} [PathFormula] with op in {<,<=,>=,>,=}; Path operators: X, U, F, G, U<=Bound, F<=Bound, G<=Bound').
4121 eval_command_help(browse,opt('PAT'),'Browse available constants, variables, sets and lets introduced in REPL').
4122 eval_command_help(apropos,['PAT'],'Find constant or variable whose names contains PAT').
4123 eval_command_help(hbrowse,['PAT'],'Browse machine hierarchy for all identifiers whose names contains PAT').
4124 eval_command_help(hshow,[],'Show machine inclusion hierarchy using topological sorting').
4125 eval_command_help(show_components,[],'Show components of PROPERTIES').
4126 eval_command_help(abstract_constants,[],'Show ABSTRACT_CONSTANTS and check if can be fully evaluated').
4127 eval_command_help(det_check_constants,[],'Check if values of CONSTANTS are forced and explain if they are').
4128 eval_command_help(show_last_as_table,[],'Show last evaluated expression in tabular form').
4129 eval_command_help(show_last_as_dot(_),['F'],'Show expression or predicate F as dot graph').
4130 eval_command_help(unsat_core,[],'Compute Unsatisfiable Core of last evaluated predicate').
4131 eval_command_help(help,opt('CMD'),'Provide help about REPL command CMD').
4132 eval_command_help(replay_repl_file,['FILE'],'Replay FILE of REPL commands').
4133 eval_command_help(reset_animator(_),[],'Reset history and statespace of animator').
4134 eval_command_help(show_source,['ID'],'Show origin and source code definition of identifier ID').
4135 eval_command_help(show_origin,['ID'],'Show origin of identifier ID and try opening in EDITOR').
4136 eval_command_help(show_machine_info(_),[],'Show statistics about loaded machine and files').
4137 eval_command_help(state_space_stats,[],'Show statistics about state space').
4138 eval_command_help(state_space_display,[],'Show complete state space transitions (could be very big !)').
4139 eval_command_help(show_state_info(_),[],'Show current state').
4140 eval_command_help(statistics,[],'Show statistics about last evaluation').
4141 % -machine_stats : cli_print_machine_info(statistics) -machine_files : cli_print_machine_info(files)
4142 eval_command_help(trim,[],'Trim memory usage of probcli (try and give memory back to the OS)').
4143 % implemented in eval_strings:
4144 eval_command_help(type,['E'],'Show type of expression E').
4145 eval_command_help(cvc4,['P'],'Solve predicate P using CVC4 solver').
4146 eval_command_help(kodkod,['P'],'Solve predicate P using SAT solver via Kodkod').
4147 eval_command_help(z3,['P'],'Solve predicate P using Z3 solver').
4148 eval_command_help('z3-free',['P'],'Solve predicate P using Z3 solver (ignoring current state)').
4149 eval_command_help('z3-file',['F'],'Solve predicate in File F using Z3 solver').
4150 eval_command_help('z3-free-file',['F'],'Solve predicate in File F using Z3 solver (ignoring current state)').
4151 eval_command_help(cdclt,['P'],'Solve predicate P using Prolog CDCL(T) solver').
4152 eval_command_help(cdclt-free,['P'],'Solve predicate P using Prolog CDCL(T) solver (ignoring current state)').
4153 eval_command_help(prob,['P'],'Solve predicate P using ProB solver (ignoring current state)').
4154 eval_command_help('prob-file',['F'],'Solve predicate in File F using ProB solver (ignoring current state)').
4155 eval_command_help(edit_main_file,opt('ID'),'Edit main file (or origin of identifier ID) using EDITOR (path_to_text_editor preference)').
4156 eval_command_help(comment,['STRING'],'provide STRING as a comment (mainly useful for :replay files)').
4157 eval_command_help(syntax_help,[],'Show a summary of the B syntax accepted by the REPL').
4158 eval_command_help(open_file,['FILE'],'Open FILE in preferred application.').
4159
4160 print_eval_command_help(Codes) :-
4161 eval_command(Codes,Cmd),
4162 eval_command_help(Cmd,Args,Descr),
4163 (Args = []
4164 -> format('Command ~w~n Syntax :~s~n ~w~n',[Cmd,Codes,Descr])
4165 ; Args=[Arg] -> format('Command ~w~n Syntax :~s ~w~n ~w~n',[Cmd,Codes,Arg,Descr])
4166 ; Args=opt(Arg) -> format('Command ~w~n Syntax :~s [~w]~n ~w~n',[Cmd,Codes,Arg,Descr])
4167 ; format('Command ~w~n Syntax :~s ~w~n ~w~n',[Cmd,Codes,Args,Descr])).
4168
4169 :- use_module(tools_commands,[show_dot_file/1, show_pdf_file/1, gen_dot_output/4]).
4170 :- use_module(state_space,[transition/4]).
4171 :- use_module(b_machine_hierarchy,[print_machine_topological_order/0]).
4172 exec_eval_command(quit,_) :- !, halt_exception(0).
4173 exec_eval_command(exit,_) :- !,halt.
4174 exec_eval_command(browse,CodesToMatch) :- !,
4175 (CodesToMatch=[] -> browse % maybe merge with apropos functionality
4176 ; exec_eval_command(apropos,CodesToMatch)).
4177 exec_eval_command(find,FORMULA) :-
4178 atom_codes(APF,FORMULA),cli_find_ltl_ap(APF).
4179 exec_eval_command(apropos,CodesToMatch) :- /* :* Pattern (apropos command) */
4180 browse_machine(CodesToMatch).
4181 exec_eval_command(hbrowse,CodesToMatch) :- /* :* Pattern (hbrowse command) */
4182 browse_all_machines(CodesToMatch).
4183 exec_eval_command(hshow,_) :- /* show inclusion hierarhcy */
4184 print_machine_topological_order.
4185 exec_eval_command(show_components,_) :-
4186 print_property_partitions.
4187 exec_eval_command(check_abstract_constants,_) :-
4188 check_abstract_constants.
4189 exec_eval_command(det_check_constants,_) :-
4190 det_check_constants.
4191 exec_eval_command(help,Arg) :-
4192 (Arg=[] -> eval_help
4193 ; print_eval_command_help(Arg) -> true
4194 ; (Arg=[58|RA],print_eval_command_help(RA)) -> true % remove : at front
4195 ; format('Cannot provide help about ~s~n',[Arg]),
4196 available_commands(LC), format('Available commands: ~w~n',[LC])
4197 ).
4198 exec_eval_command(ctl(Mode),FORMULA) :- % :ctl or :ctlh for ctl here
4199 atom_codes(F,FORMULA),
4200 (cli_ctl_model_check(F,Mode,_,Status)
4201 -> (Status=false -> write_history_to_user_output([show_init,show_states]) ; true)
4202 ; print('CTL Syntax: ExUy,EXx,AXx,EFx,AGx,EX[Op]x,e(Op),{B-Pred}'),nl).
4203 exec_eval_command(ltl(Mode),FORMULA) :- % :ltl or :ltlh with Mode = init or starthere
4204 atom_codes(F,FORMULA),
4205 (cli_ltl_model_check(F,Mode,_,Status)
4206 -> (Status=no -> write_history_to_user_output([show_init,show_states]) ; true)
4207 ; print('LTL Operators: G,F,X,U,W,R,not,&,or,=>,<=>'),nl,
4208 print('LTL Propositions: {B-Pred}, e(Op), [Op], true, false, sink'),nl,
4209 print('Past-LTL Operators: Y,H,O,S,T (dual to X,G,F,U,R)'),nl
4210 ).
4211 exec_eval_command(pctl(Mode),FORMULA) :- % :pctl or :pctlh with Mode = init or starthere
4212 atom_codes(F,FORMULA),
4213 (cli_pctl_model_check(F,Mode,_,Status)
4214 -> (Status=no -> write_history_to_user_output([show_init,show_states]) ; true)
4215 ; print('PCTL Propositional Operators: not, &, or, =>'),nl,
4216 print('PCTL State Formula: P op {Exp} [PathFormula] with op in {<,<=,>=,>,=}'),nl,
4217 print('PCTL Path Formulas: X phi, phi1 U phi2, F phi, G phi'),nl,
4218 print('PCTL Bounded Path Formulas: phi1 U<=Bound phi2, F<=Bound phi, G<=Bound phi'),nl,
4219 print('PCTL Propositions: {B-Pred}, e(Op), [Op], true, false, sink'),nl
4220 ).
4221 exec_eval_command(reset_animator(Hard),_) :- !,
4222 get_state_space_stats(TotalNodeSum,TotalTransSum,_,_),
4223 (Hard=hard ->
4224 format('Resetting statespace (~w states, ~w transitions)~n',[TotalNodeSum,TotalTransSum]),
4225 reset_animator
4226 ; format('Resetting animation history (keeping statespace: ~w states, ~w transitions)~n',[TotalNodeSum,TotalTransSum]),
4227 tcltk_reset % only resets animation history,...
4228 ).
4229 exec_eval_command(statistics,_) :- !, print_last_info.
4230 exec_eval_command(state_space_stats,_) :- !, % :states
4231 get_state_space_stats(TotalNodeSum,TotalTransSum,Processed,Ignored),
4232 (Ignored>0
4233 -> format('Statespace: ~w states (~w processed, ~w ignored) and ~w transitions.~n',
4234 [TotalNodeSum,Processed,Ignored,TotalTransSum])
4235 ; format('Statespace: ~w states (~w processed) and ~w transitions.~n',[TotalNodeSum,Processed,TotalTransSum])).
4236 exec_eval_command(state_space_display,_) :- !, % :statespace
4237 ( visited_expression(ID,State),
4238 functor(State,F,N),
4239 format('State ID ~w (~w/~w)~n',[ID,F,N]),
4240 transition(ID,OperationTerm,_OpID,ToID),
4241 get_operation_name(OperationTerm,OpName),
4242 format(' -> ~w (~w)~n',[ToID,OpName]),
4243 fail
4244 ;
4245 current_state_id(ID),
4246 format('Current State ID ~w~n',[ID])
4247 ).
4248 exec_eval_command(show_state_info(Limit),_) :- !, % :state
4249 current_expression(ID,CurState),
4250 expand_const_and_vars_to_full_store(CurState,EState),
4251 format('Current state id ~w : ~n',[ID]), % MAX_DISPLAY_SET
4252 translate:print_bstate_limited(EState,Limit,-1),nl,
4253 (\+ not_all_transitions_added(ID),
4254 format('Outgoing transitions of state id ~w:~n',[ID]),
4255 transition(ID,OperationTerm,_OpID,ToID),
4256 get_operation_name(OperationTerm,OpName),
4257 format(' -> ~w (~w)~n',[ToID,OpName]),
4258 fail
4259 ; true).
4260 exec_eval_command(unsat_core,_) :- !, % :core :u
4261 unsat_core_last_expression.
4262 exec_eval_command(trimcore,_) :- !, % :trim
4263 prob_trimcore_verbose.
4264 exec_eval_command(show_last_as_table,_) :- !, % :show
4265 show_last_expression_as_table.
4266 exec_eval_command(syntax_help,_) :- !, % :syntax
4267 syntax_help.
4268 exec_eval_command(show_last_as_dot(Show),Arg) :- !,
4269 (Arg = [] -> print('*** :dot requires an expression or predicate as argument.'),nl
4270 ; safe_absolute_file_name('~/probcli_repl.dot',AFile),
4271 set_eval_dot_file(AFile),
4272 format('Displaying evaluation result in: ~w~n',[AFile]),
4273 (eval_codes(Arg,exists,_,_,_,_) -> true ; true), unset_eval_dot_file,
4274 ( Show=no_dot_viewing -> true
4275 ; Show=dotty -> show_dot_file(AFile)
4276 ; safe_absolute_file_name('~/probcli_repl.pdf',PDFFile),
4277 gen_dot_output(AFile,Show,pdf,PDFFile),
4278 show_pdf_file(PDFFile)
4279 )).
4280 exec_eval_command(replay_repl_file,FILEC) :- !, % :replay
4281 atom_codes(File,FILEC),
4282 set_repl_input_file(not_verbose,File).
4283 exec_eval_command(show_source,IDC) :- !, % :src
4284 trim_id_back_quotes(IDC,TIDC),atom_codes(ID,TIDC),
4285 show_source(ID).
4286 exec_eval_command(show_origin,IDC) :- !, % :origin
4287 trim_id_back_quotes(IDC,TIDC),atom_codes(ID,TIDC),
4288 show_origin(ID).
4289 exec_eval_command(show_machine_info(X),_) :- !, % :machine
4290 cli_print_machine_info(X).
4291 exec_eval_command(edit_main_file,Arg) :- !, % :e
4292 (Arg=[] -> edit_main_file
4293 ; trim_quotes(Arg,FC), atom_codes(File,FC), file_exists(File) -> edit_file(File,unknown)
4294 ; exec_eval_command(show_origin,Arg)).
4295 exec_eval_command(open_file,FILEC) :- !, % :open
4296 (FILEC=[] -> open_file('.')
4297 ; atom_codes(File,FILEC),
4298 open_file(File)
4299 ).
4300 exec_eval_command(comment,_Arg) :- !. % do nothing; argument was a comment; mainly useful for :replay files
4301
4302
4303 trim_id_back_quotes([96|T],Res) :- append(Res,[96],T),!.
4304 trim_id_back_quotes(R,R).
4305
4306 trim_quotes([34|T],Res) :- append(Res,[34],T),!. % double quotes
4307 trim_quotes([39|T],Res) :- append(Res,[39],T),!. % single quotes
4308 trim_quotes(R,R).
4309
4310 :- use_module(tools_commands,[edit_file/2, open_file/1]).
4311 edit_main_file :- last_repl_error(File,Line),
4312 \+ functor(File,unknown,_), % File \= unknown(_),
4313 !,
4314 format('Showing first error from last command~n',[]),
4315 edit_file(File,Line).
4316 % Note: for the bbedit command we can also specify line numbers bbedit +LINE FILE
4317 edit_main_file :- file_loaded(_,MainFile), \+ empty_machine_loaded,
4318 !,edit_file(MainFile,unknown).
4319 edit_main_file :- format_with_colour_nl(user_error,[red],'No file loaded, cannot open EDITOR!',[]).
4320
4321
4322
4323 :- use_module(probsrc(error_manager),[extract_file_line_col/6]).
4324 open_file_at_position(OriginTerm) :-
4325 extract_file_line_col(OriginTerm,FILE,LINE,_COL,_Erow,_Ecol),
4326 edit_file(FILE,LINE).
4327
4328
4329 :- use_module(probsrc(bmachine),[source_code_for_identifier/6]).
4330 show_source(ID) :- source_code_for_identifier(ID,Kind,_Type,OriginStr,OriginTerm,Source),!,
4331 translate:translate_subst_or_bexpr(Source,PPS),
4332 %format('~w: ~w (Type: ~w)~norigin: ~w~nsource: ~w~n',[Kind,ID,_Type,Origin,PPS]).
4333 format('~w: ~w~norigin: ~w~nsource: ~w~n',[Kind,ID,OriginStr,PPS]),
4334 (OriginTerm=b(_,_,_),get_texpr_description(OriginTerm,Description)
4335 -> format('description: ~w~n',[Description]) ; true).
4336 show_source(ID) :- format_error_with_nl('! Could not find source for ~w',[ID]).
4337
4338 show_origin('') :- last_repl_error(_,_),!, % error occured: show error in editor like :e would
4339 edit_main_file.
4340 show_origin('') :- !,format_error_with_nl('! You need to provided an identifier',[]).
4341 show_origin(ID) :- source_code_for_identifier(ID,Kind,_Type,OriginStr,OriginTerm,_Source),!,
4342 format('~w: ~w~norigin: ~w~n',[Kind,ID,OriginStr]),
4343 open_file_at_position(OriginTerm).
4344 show_origin(ID) :- format_error_with_nl('! Could not find origin for ~w',[ID]).
4345
4346 profiling_on :- set_prolog_flag(profiling,on), print('% PROFILING ON'),nl.
4347
4348 % find a state satisfying LTL atomic property
4349 cli_find_ltl_ap(APF) :-
4350 if(ltl:find_atomic_property_formula(APF,ID),
4351 (format('Found state (id = ~w) satisfying LTL atomic property.~n',[ID]),
4352 tcltk_goto_state('LTL FIND',ID)),
4353 format('No explored state satsifies LTL atomic property.~n',[])).
4354
4355 eval_help :-
4356 print('ProB Interactive Expression and Predicate Evaluator '), nl,
4357 print('Type a valid B expressions or predicates, followed by RETURN or ENTER.'),nl,
4358 print('You can spread input over multiple lines by ending lines with "\\".'),nl,
4359 browse_machine([]),
4360 print('You can also type one of the following commands: '),nl,
4361 (option_verbose ->
4362 print(' + to save last expression to ProB unit tests.'),nl,
4363 print(' ! to go to deterministic propagation only mode.'),nl,
4364 print(' $ to print evaluation time for last expression.'),nl,
4365 print(' $$ to pretty-print last expression and its type.'),nl,
4366 print(' $$$ to pretty-print last expression in nested fashion.'),nl,
4367 print(' !p to toggle performance messages.'),nl,
4368 print(' !norm to toggle normalisation of results.'),nl,
4369 print(' :col to toggle colorizing of results.'),nl
4370 ; true),
4371 print(' :let x = E to define a new local variable x'),nl, % : optional for let
4372 print(' :unlet x to un-define a local variable'),nl,
4373 print(' #file=MYFILE to evaluate the formula in MYFILE'),nl,
4374 print(' @INVARIANT to evaluate or obtain invariant predicate'),nl,
4375 print(' @PROPERTIES, @GUARD-OpName ditto for properties and guards'),nl, % @FUZZ, @RANDOMISE also exist
4376 print(' :b or :b Prefix to browse the available identifiers'),nl,
4377 print(' :t E to get the type of an expression'),nl,
4378 print(' :r to reload the machine'),nl,
4379 print(' :show to display the last result as a table (if possible)'),nl,
4380 print(' :list CAT to display information with CAT : {files,variables,help,...}'),nl,
4381 print(' :* P to display constants/variables containing pattern P'),nl,
4382 print(' :core Pred to compute the unsat core for Pred'),nl,
4383 print(' :u to compute the unsat core for last evaluated result'),nl,
4384 print(' :stats to print the type and evaluation time for last query'),nl,
4385 print(' -PROBCLIARGS to pass command-line probcli arguments to the REPL'),nl,
4386 print(' (e.g., -v to switch to verbose mode or -p PREF VAL to set a preference)'),nl,
4387 print(' :ctl F or :ltl F to check a CTL or LTL formula.'),nl,
4388 print(' :f F to find a state satisfying LTL atomic property.'),nl,
4389 print(' :find-value PAT to find a value in current state matching PAT.'),nl,
4390 print(' :exec S to execute an operation or substitution S.'),nl,
4391 print(' :replay FILE to replay a file of commands.'),nl,
4392 print(' :z3 P, :cvc4 P, :kodkod P to solve predicate P using alternate solver'),nl,
4393 print(' :forall P to prove predicate P as universally quantified with default solver'),nl,
4394 print(' :prove P to prove predicate P using ProB\'s own WD prover'),nl,
4395 (option_verbose ->
4396 print(' :krt P, :pp P, :ml P to prove predicate P using Atelier-B provers if installed'),nl
4397 ; true),
4398 print(' :print P to pretty print predicate in a nested fashion'),nl,
4399 print(' :min P, :max P to find a minimal/maximal model for predicate P or %x.(P|E)'),nl,
4400 print(' :prefs to print current value of preferences'),nl,
4401 print(' :reset to reset the state space of the animator.'),nl, % :reset-history only resets history
4402 print(' :help CMD to obtain more help about a command.'),nl,
4403 print(' :state, :statespace, :states,'),nl,
4404 print(' :machine, :files, :source, :orgin, :machine-stats,'),nl,
4405 print(' :apropos, :hbrowse, :abstract_constants, :det_check_constants,'),nl,
4406 print(' :dot, :dotty, :sfdp, :trim, :comp - use :help CMD for more info'),nl,
4407 print(' :syntax to show a summary of the B syntax accepted by the REPL'),nl,
4408 print(' :q to exit.'),nl.
4409
4410 :- use_module(tools,[read_atom_from_file/3]).
4411 :- dynamic prob_summary/1.
4412
4413 :- read_atom_from_file(tclsrc('prob_summary.txt'),utf8,T), assertz(prob_summary(T)).
4414 % TODO: we could just include a shorter version with predicates and expressions
4415 % TODO: provide :syntax LTL or :syntax CTL help commands
4416 syntax_help :- prob_summary(S),
4417 format(user_output,'~w',S).
4418
4419
4420 browse :- browse_machine([]), browse_repl_lets.
4421
4422 :- use_module(bmachine,[get_machine_identifiers/2]).
4423 % the CodesToMatch parameters mimics the apropos command of the Clojure-REPL
4424 browse_machine(CodesToMatch) :-
4425 get_machine_identifiers(machines,MN), display_match('MACHINES',CodesToMatch,MN),
4426 (CodesToMatch =[] -> print_sets
4427 ; get_machine_identifiers(sets,SN), display_match('SETS',CodesToMatch,SN),
4428 get_machine_identifiers(set_constants,SCN), display_match('SETS-ELEMENTS',CodesToMatch,SCN)
4429 ),
4430 get_machine_identifiers(definition_files,DFN),
4431 (DFN=[] -> true ; display_match('DEFINITIONS FILES',CodesToMatch,DFN)),
4432 get_machine_identifiers(definitions,DN),
4433 (DN=[] -> true ; display_match('DEFINITIONS',CodesToMatch,DN)),
4434 get_machine_identifiers(constants,CN),
4435 display_match('CONSTANTS',CodesToMatch,CN),
4436 get_machine_identifiers(variables,VN),
4437 display_match('VARIABLES',CodesToMatch,VN),
4438 get_machine_identifiers(operations,Ops),
4439 display_match('OPERATIONS',CodesToMatch,Ops).
4440
4441 display_match(KIND,CodesToMatch,Ids) :- display_match(KIND,CodesToMatch,Ids,show_empty).
4442 display_match(KIND,CodesToMatch,Ids,ShowEmpty) :-
4443 include(prob_cli:atom_contains_codes(CodesToMatch),Ids,MatchingIds),
4444 length(MatchingIds,LenMIds),
4445 (LenMIds=0, ShowEmpty=show_only_if_match -> true
4446 ; sort(MatchingIds,SMatchingIds),
4447 (CodesToMatch=[]
4448 -> format(' ~w: ~w ~w~n',[KIND,LenMIds,SMatchingIds])
4449 ; length(Ids,LenIds),
4450 format('Matching ~w: ~w/~w ~w~n',[KIND,LenMIds,LenIds,SMatchingIds]))
4451 ).
4452
4453 % check if an atom contains a list of codes in its name
4454 atom_contains_codes([],_) :- !.
4455 atom_contains_codes(Codes,Name) :- atom_codes(Name,NC),
4456 append([_,Codes,_],NC).
4457
4458 :- use_module(b_global_sets,[b_global_set/1]).
4459 print_sets :- print('Available SETS: '), b_global_set(GS), print_set(GS),fail.
4460 print_sets :- nl.
4461
4462 :- use_module(probsrc(b_global_sets),[is_b_global_constant/3]).
4463 print_set(GS) :- print(GS), \+ is_b_global_constant(GS,_,_),!, print(' ').
4464 print_set(GS) :- print(' = {'), is_b_global_constant(GS,_,Cst), print(Cst), print(' '),fail.
4465 print_set(_) :- print(' } ').
4466
4467 :- use_module(b_machine_hierarchy,[get_machine_identifier_names/7]).
4468 % browse all machines, shows identifiers maybe not visible at top-level
4469 browse_all_machines(CodesToMatch) :-
4470 format('Searching machine hierarchy for identifiers matching ~s~n',[CodesToMatch]),
4471 get_machine_identifier_names(Name,Params,Sets,AVars,CVars,AConsts,CConsts),
4472 format('~nMACHINE ~w~n',[Name]),
4473 display_match('PARAMS',CodesToMatch,Params,show_only_if_match),
4474 display_match('SETS',CodesToMatch,Sets,show_only_if_match),
4475 display_match('ABSTRACT_VARIABLES',CodesToMatch,AVars,show_only_if_match),
4476 display_match('CONCRETE_VARIABLES',CodesToMatch,CVars,show_only_if_match),
4477 display_match('ABSTRACT_CONSTANTS',CodesToMatch,AConsts,show_only_if_match),
4478 display_match('CONCRETE_CONSTANTS',CodesToMatch,CConsts,show_only_if_match),
4479 fail.
4480 browse_all_machines(_).
4481
4482
4483 :- use_module(bmachine,[b_get_properties_from_machine/1]).
4484 print_property_partitions :- print('PARTITIONS OF PROPERTIES'),nl,
4485 b_get_properties_from_machine(Properties),
4486 predicate_components(Properties,Comp),
4487 length(Comp,Len), print(Len), print(' components found in PROPERTIES'),nl,
4488 nth1(Nr,Comp,component(P,Vars)),
4489 format('~n& // Component ~w/~w over identifiers ~w~n',[Nr,Len,Vars]),
4490 translate:print_bexpr(P),nl,fail.
4491 print_property_partitions :- nl, print(' ============== '),nl.
4492
4493 :- use_module(store,[lookup_value_for_existing_id/3]).
4494 :- use_module(b_machine_hierarchy,[abstract_constant/2]).
4495 check_abstract_constants :-
4496 format('Checking whether abstract constants can be expanded:~n',[]),
4497 current_expression(_ID,CurState),
4498 expand_const_and_vars_to_full_store(CurState,EState),
4499 abstract_constant(AID,_),
4500 lookup_value_for_existing_id(AID,EState,Val),
4501 get_value_type(Val,VF),
4502 format(user_output,'~n*** Evaluating ABSTRACT_CONSTANT (stored value: ~w):~n',[VF]),
4503 format_with_colour_nl(user_output,[blue],' ~w',[AID]),
4504 (debug_mode(off) -> true
4505 ; translate:translate_bvalue(Val,VS), format_with_colour_nl(user_output,[blue],' Stored value = ~w',[VS])),
4506 atom_codes(AID,C),
4507 % TO DO: provide info if value symbolic and can be expanded fully + add timing
4508 % term_size, unique in state space
4509 % this command is deprecated compared to -csv constants_analysis (i.e., tcltk_analyse_constants)
4510 eval_codes(C,exists,_,_EnumWarning,_LS,_),nl, % TO DO: call try_expand_and_convert_to_avl_with_check(Val)
4511 fail.
4512 check_abstract_constants.
4513
4514 :- use_module(probsrc(custom_explicit_sets),[is_interval_closure/3]).
4515 get_value_type(CS, Res) :- is_interval_closure(CS,_,_),!, Res = 'interval closure'.
4516 get_value_type(closure(_,_,_),Res) :- !, Res= 'symbolic closure'.
4517 get_value_type(avl_set(_), Res) :- !, Res= 'explicit AVL set'.
4518 get_value_type(Val,VF) :- functor(Val,VF,_).
4519
4520 :- use_module(b_state_model_check,[cbc_constants_det_check/1]).
4521 det_check_constants :- \+ current_state_corresponds_to_setup_constants_b_machine, !,
4522 format_with_colour_nl(user_error,[red],'This command requires to setup the constants first!',[]).
4523 det_check_constants :-
4524 current_state_id(ID),
4525 %format('Checking whether constants are forced in state ~w:~n',[ID]),
4526 cbc_constants_det_check(ID).
4527
4528 % showing relations as tables:
4529
4530 :- use_module(extrasrc(table_tools),[print_value_as_table/2]).
4531 show_last_expression_as_table :- \+ last_expression(_,_Expr),!,
4532 print_red('Please evaluate an expression or predicate first.'),nl.
4533 show_last_expression_as_table :-
4534 get_last_result_value(Expr,_,Value),
4535 print_value_as_table(Expr,Value).
4536
4537
4538 % a few definitions so that probcli commands work in REPL:
4539 :- use_module(translate,[set_unicode_mode/0, unset_unicode_mode/0, set_atelierb_mode/1, unset_atelierb_mode/0]).
4540 :- public pretty_print_internal_rep/4, pretty_print_internal_rep_to_B/1.
4541 pretty_print_internal_rep(PPFILE,MachName,TYPES,unicode) :- !,
4542 set_unicode_mode,
4543 call_cleanup(b_write_machine_representation_to_file(MachName,TYPES,PPFILE),unset_unicode_mode).
4544 pretty_print_internal_rep(PPFILE,'$auto',_TYPES,atelierb) :- animation_minor_mode(eventb),!,
4545 b_write_eventb_machine_to_classicalb_to_file(PPFILE). % old -ppB option:
4546 pretty_print_internal_rep(PPFILE,MachName,TYPES,atelierb) :- !,
4547 set_atelierb_mode(native),
4548 call_cleanup(b_write_machine_representation_to_file(MachName,TYPES,PPFILE),unset_atelierb_mode).
4549 pretty_print_internal_rep(PPFILE,MachName,TYPES,_) :- b_write_machine_representation_to_file(MachName,TYPES,PPFILE).
4550
4551 % -ppB option:
4552 pretty_print_internal_rep_to_B(PPFILE) :- b_write_eventb_machine_to_classicalb_to_file(PPFILE).
4553
4554 :- use_module(tools_printing,[tcltk_nested_read_prolog_file_as_codes/2]).
4555 % -pppl option: internal developer utility to pretty-print a Prolog file in nested fashion
4556 % can be useful to inspecting .prob AST files or .P XTL files
4557 pretty_print_prolog_file(PPFILE) :-
4558 file_loaded(_,MainFile), % TODO: check if main file is really Prolog file
4559 (loaded_main_file(Ext,_), \+( (Ext='P' ; Ext='prob' ; Ext= 'pl') )
4560 -> add_warning(probcli,'The -pppl command is designed to work with Prolog files (.P, .prob or .pl), not with: ',Ext) ; true),
4561 format('Pretty-Printing Prolog file ~w to ~w~n',[MainFile,PPFILE]),
4562 tcltk_nested_read_prolog_file_as_codes(MainFile,list(Codes)),
4563 safe_intelligent_open_file(PPFILE,write,Stream),
4564 format(Stream,'~s~n',[Codes]),
4565 close(Stream).
4566
4567 :- use_module(extrasrc(source_indenter),[indent_b_file/2]).
4568 indent_b_file(PPFILE) :-
4569 file_loaded(_,MainFile),
4570 format('Indenting B file ~w to ~w~n',[MainFile,PPFILE]),
4571 safe_intelligent_open_file(PPFILE,write,OutStream),
4572 call_cleanup(indent_b_file(MainFile,OutStream),close(OutStream)).
4573
4574
4575 % Simple Animator
4576
4577 interactive_animate_machine :-
4578 nl,print('IMPORTANT: Do not use this mode for automatic tools.'),nl,
4579 print('The output format can change arbitrarily in future versions.'),nl,
4580 print('Please terminate your input with a dot (.) and then type return.'),nl,nl,
4581 animate_machine2.
4582 animate_machine2 :-
4583 print_current_state,
4584 cli_computeOperations(Ops),
4585 length(Ops,Max),
4586 print('Enabled Operations: '),nl,
4587 print_options(Ops,1),
4588 print(' ==> '),!,
4589 read(Nr),
4590 (number(Nr),Nr>0,Nr=<Max
4591 -> cli_animateOperationNr(Nr,Ops,0)
4592 ; fail
4593 ),!,
4594 animate_machine2.
4595 animate_machine2.
4596
4597 print_current_state :- current_state_id(CurID), print('ID ==> '), print(CurID),nl,
4598 getStateValues(CurID,State),
4599 print_bindings(State),
4600 (specfile:b_or_z_mode,\+is_initialised_state(CurID)
4601 -> print_red(' Not yet initialised.'),print_mode_info, debug_println(10,state(State)) ; nl).
4602
4603 print_mode_info :- animation_mode(M), (animation_minor_mode(MM) -> true ; MM=''),
4604 format('Animation Mode = ~w [~w]~n',[M,MM]).
4605
4606 cli_computeOperations(Ops) :- option(animate_stats),!, % provide statistics about the animation
4607 nl,
4608 start_probcli_timer(Timer),
4609 current_state_id(CurID),
4610 tcltk_get_options(list(Ops)),
4611 ajoin(['Time to compute all operations in state ',CurID,': '],Msg),
4612 stop_probcli_timer(Timer,Msg).
4613 cli_computeOperations(Ops) :- tcltk_get_options(list(Ops)).
4614
4615 cli_animateOperationNr(Nr,Options,StepNr) :-
4616 (option(animate_stats)
4617 -> nth1(Nr,Options,Action),
4618 truncate_animate_action(Action,TA),
4619 (StepNr>1 -> format('performing step ~w : ~w~n',[StepNr,TA])
4620 ; format('performing ~w~n',[TA]))
4621 ; true),
4622 tcltk_perform_nr(Nr).
4623
4624 :- use_module(tools_strings,[truncate_atom/3]).
4625 % optionally truncate animation action atom for printing:
4626 truncate_animate_action(Action,TA) :-
4627 (option_verbose -> TA = Action
4628 ; \+ atom(Action) -> TA = Action
4629 ; truncate_atom(Action,100,TA)).
4630
4631 perform_random_step(StepNr) :- perform_random_step(_Ops,_Len,_RanChoice,StepNr).
4632 perform_random_step(Ops,Len,RanChoice,StepNr) :-
4633 cli_computeOperations(Ops),
4634 current_state_id(CurID), check_for_errors(CurID,StepNr),
4635 length(Ops,Len), Len>0,
4636 debug_println(20,perform_random_step(Len,StepNr)),
4637 L1 is Len+1,
4638 (do_det_checking, Len>1
4639 -> print_error('Non-deterministic step in animate or init'),
4640 print_error('State:'),
4641 print_current_state, print_error('Enabled Operations: '), print_options(Ops,1),
4642 error_occurred(det_check)
4643 ; true),
4644 random(1,L1,RanChoice),
4645 debug_println(20,random(L1,RanChoice)),
4646 cli_animateOperationNr(RanChoice,Ops,StepNr).
4647
4648 :- use_module(state_space,[visited_expression/2]).
4649 check_for_errors(CurID,StepNr) :- invariant_violated(CurID),
4650 \+ option(no_invariant_violations),
4651 get_preference(do_invariant_checking,true),
4652 ajoin(['INVARIANT VIOLATED after ',StepNr,' steps (state id ',CurID,').'],ErrMsg),
4653 format('~w~n',[ErrMsg]),
4654 visited_expression(CurID,CurState), print_state_silent(CurState),
4655 error_occurred_with_msg(invariant_violation,ErrMsg),
4656 fail.
4657 check_for_errors(CurID,_) :- get_state_errors(CurID).
4658 % TO DO: also check for assertion errors, goal, state_errors with abort
4659
4660 :- use_module(bmachine,[b_machine_has_constants_or_properties/0]).
4661 do_det_checking :- option(det_check),!.
4662 do_det_checking :- option(det_constants_check),current_state_id(root),
4663 b_or_z_mode, b_machine_has_constants_or_properties.
4664
4665 perform_random_steps(Nr,_) :- \+ number(Nr),!,
4666 print_error('Argument to animate not a number'), print_error(Nr),error_occurred(animate).
4667 perform_random_steps(Nr,_) :- Nr<0, !,
4668 print_error('Argument to animate is a negative number'), print_error(Nr),error_occurred(animate).
4669 perform_random_steps(0,_) :- !.
4670 perform_random_steps(Nr,ErrorOnDeadlock) :-
4671 (perform_random_initialisation_if_necessary(Steps) % if Nr=1 we currently will also execute the INITIALISATION ! TO DO: fix
4672 -> perform_random_steps_aux(Steps,Nr,ErrorOnDeadlock)
4673 ; % we have setup_constants_fails or initialisation_fails
4674 print_error('Could not initialise model for animation')
4675 ).
4676
4677 perform_random_steps_aux(Nr,Max,_) :- Nr >= Max,!, debug_println(9,performed_random_steps(Nr)).
4678 perform_random_steps_aux(Nr,Max,ErrorOnDeadlock) :-
4679 N1 is Nr+1,
4680 (perform_random_step(N1)
4681 -> perform_random_steps_aux(N1,Max,ErrorOnDeadlock)
4682 ; /* deadlock */
4683 write_xml_element_to_log(deadlock_found,[step/Nr]),
4684 (ErrorOnDeadlock=true, \+ option(no_deadlocks)) ->
4685 print_error('Deadlock occurred during -animate, at step number:'), print_error(Nr),
4686 error_occurred(animate)
4687 ; print('% Deadlock occurred during -animate, at step number:'), print(Nr),nl
4688 ).
4689
4690 perform_random_initialisation_if_necessary(Steps) :-
4691 b_or_z_mode, current_state_id(State), State=root,!, perform_random_initialisation(Steps).
4692 perform_random_initialisation_if_necessary(0).
4693
4694 perform_random_initialisation :- perform_random_initialisation(_).
4695 perform_random_initialisation(Steps) :- current_state_id(State), State \= root, !,
4696 print_error('init can only be used in initial state'), print_error(State),error_occurred(initialisation),
4697 Steps=0.
4698 perform_random_initialisation(Steps) :- b_mode, b_machine_has_constants_or_properties,!,
4699 (perform_random_step(Ops,_Len,RanChoice,1)
4700 -> nth1(RanChoice,Ops,Choice), %print(Choice),nl,
4701 (Choice = 'PARTIAL_SETUP_CONSTANTS'
4702 -> error_occurred(setup_constants_inconsistent)
4703 ; true)
4704 ; error_occurred(setup_constants_fails),fail), % $setup_constants TODO: properties unknown or unsat
4705 perform_random_init_after_setup_constants, Steps=2. % $initialise_machine
4706 perform_random_initialisation(Steps) :- (perform_random_step(1) -> Steps=1 ; error_occurred(initialisation_fails),fail).
4707
4708
4709 perform_random_init_after_setup_constants :- \+ option(initialise), we_need_only_static_assertions(_),!,
4710 printsilent('% NOT INITIALISING MACHINE (not required)'),nls.
4711 % debug_println(20,'% NOT INITIALISING MACHINE (not required)').
4712 perform_random_init_after_setup_constants :-
4713 (perform_random_step(2) % 2 is the step nr not the number of steps
4714 -> true
4715 ; error_occurred(initialisation_fails),
4716 fail).
4717
4718 :- use_module(cbcsrc(enabling_analysis),[tcltk_cbc_enabling_analysis/1, print_enable_table/1, is_timeout_enabling_result/1]).
4719 do_enabling_analysis_csv(EnablingCsvFile,NOW) :-
4720 start_probcli_timer(Timer1),
4721 start_xml_feature(enabling_analysis,file,EnablingCsvFile,FINFO),
4722 tcltk_cbc_enabling_analysis(list(R)),
4723 stop_probcli_timer(Timer1,'% Finished CBC Enabling Analysis',_TotWallTime),
4724 print_cbc_stats(R,NOW),
4725 debug_println(9,writing_to_file(EnablingCsvFile)),
4726 my_tell(EnablingCsvFile),
4727 print_enable_table(R),
4728 told,!,
4729 stop_xml_feature(enabling_analysis,FINFO).
4730 do_enabling_analysis_csv(EnablingCsvFile,_) :-
4731 add_error(enabling_analysis,'Enabling analysis failed',EnablingCsvFile),
4732 stop_xml_group_in_log(enabling_analysis).
4733
4734 print_cbc_stats(Res,_NOW) :- length(Res,Len), Ops is Len-2, % Header + Init
4735 CBC_Calls is Ops*(Ops+1), % +1 for INITIALISATION
4736 findall(TO,(member(list([_|T]),Res), member(TO,T),is_timeout_enabling_result(TO)),TOS),
4737 length(TOS,NrTOS),
4738 format('% CBC Enabling Stats:~n% Nr of events: ~w~n% Nr of cbc calls: ~w, Timeout results: ~w~n',[Ops,CBC_Calls,NrTOS]),
4739 write_xml_element_to_log(cbc_enabling_stats,[nr_events/Ops,cbc_calls/CBC_Calls,nr_timeouts/NrTOS]).
4740
4741
4742 :- use_module(cbcsrc(enabling_analysis),[feasible_operation_with_timeout/3]).
4743 do_feasibility_analysis(ATimeOut,EnablingCsvFile) :-
4744 arg_is_number(ATimeOut,TimeOut),
4745 start_xml_feature(feasibility_analysis,file,EnablingCsvFile,FINFO),
4746 findall(list([Op,Res]),feasible_operation_with_timeout(Op,TimeOut,Res),R),
4747 debug_println(9,writing_to_file(EnablingCsvFile)),
4748 my_tell(EnablingCsvFile),
4749 print_enable_table([list(['Event','Feasibility'])|R]),
4750 told,!,
4751 stop_xml_feature(feasibility_analysis,FINFO).
4752 do_feasibility_analysis(_,EnablingCsvFile) :-
4753 add_error(feasibility_analysis,'Feasibility analysis failed',EnablingCsvFile),
4754 stop_xml_group_in_log(feasibility_analysis).
4755
4756 :- use_module(b_read_write_info,[tcltk_read_write_matrix/1]).
4757 generate_read_write_matrix(CsvFile) :-
4758 tcltk_read_write_matrix(list(Matrix)),
4759 my_tell(CsvFile),
4760 print_enable_table(Matrix),
4761 told,!.
4762 generate_read_write_matrix(CsvFile) :-
4763 add_error(read_write_matrix,'Generating Read-Write-Matrix failed',CsvFile).
4764
4765
4766 my_tell(File) :-
4767 catch(
4768 tell(File),
4769 error(_E,_), % existence_error(_,_)
4770 add_error_fail(tell,'File cannot be written to: ',File)).
4771
4772 print_options([],_).
4773 print_options([H|T],N) :-
4774 print(' '), print(N), print(':'), print(H),nl,
4775 N1 is N+1,
4776 print_options(T,N1).
4777
4778 print_nr_list(List) :- print_nr_list(List,0,1,no_repeats).
4779
4780 print_nr_list([],NM1,_,Repeats) :- !, print_repeats(NM1,Repeats).
4781 print_nr_list([H|T],_,N,repeated(H,SinceN)) :- !, N1 is N+1,
4782 print_nr_list(T,N,N1,repeated(H,SinceN)).
4783 print_nr_list([H|T],NM1,N,Repeats) :- !,
4784 print_repeats(NM1,Repeats),
4785 N1 is N+1,
4786 print_nr_list(T,N,N1,repeated(H,N)).
4787 print_nr_list(X,_,_,_) :- print('### not a list: '), print(X),nl.
4788
4789 print_repeats(N,repeated(H,N)) :- !,
4790 format(' ~w: ~w~n',[N,H]).
4791 print_repeats(N,repeated(H,Since)) :- !, Repeats is 1+N-Since,
4792 format(' ~w - ~w: ~w (~w repetitions)~n',[Since,N,H,Repeats]).
4793 print_repeats(_,_).
4794
4795 print_bindings([]) :- !.
4796 print_bindings([binding(Var,_,PPV)|T]) :- !, print(Var),print('='),print(PPV),
4797 (T=[] -> true ; print(', '), print_bindings(T)).
4798 print_bindings([binding(Var,_,PPV,_Tag)|T]) :- !, print(Var),print('='),print(PPV),
4799 (T=[] -> true ; print(', '), print_bindings(T)).
4800 print_bindings(X) :- print('### Internal Error: illegal binding list: '), print(X),nl.
4801
4802 :- dynamic expected_error_occurred/1.
4803 :- dynamic error_did_not_occur/1.
4804 reset_expected_error_occurred :- retractall(expected_error_occurred(_)).
4805 check_all_expected_errors_occurred(NOW) :-
4806 %error_manager:display_error_statistics,
4807 get_errors, get_state_space_errors,
4808 retractall(error_did_not_occur(_)),
4809 expected_error(Type),
4810 \+ expected_error_occurred(Type),
4811 print('*** Expected Error of following type to occur: '), print(Type),nl,
4812 writeln_log_time(expected_error_did_not_occur(NOW,Type)),
4813 assertz(error_did_not_occur(Type)),
4814 (option(strict_raise_error) -> definite_error_occurred ; fail).
4815 check_all_expected_errors_occurred(_NOW) :-
4816 (expected_error(_)
4817 -> (error_did_not_occur(_) -> print('*** Some expected errors did NOT occur !')
4818 ; print('All expected errors occurred.')),nl
4819 ; true).
4820
4821 expected_error(Type) :- option(expect_error(Type)).
4822 expected_error(Type) :- option(expect_error_pos(Type,_Line,_Col)).
4823
4824 error_occurred(warning(Type)) :- !, error_occurred(Type,warning).
4825 error_occurred(Type) :- error_occurred(Type,error).
4826
4827 get_error_category_and_type(warning(Cat),Category,Type) :- !, Category=Cat,Type=warning.
4828 get_error_category_and_type(C,C,error).
4829
4830 error_occurred_with_msg(Type,Msg) :- error_occurred_with_msg(Type,Msg,not_yet_extracted).
4831 error_occurred_with_msg(warning(Type),Msg,Span) :- !, error_occurred(Type,warning,Span,Msg).
4832 error_occurred_with_msg(Type,Msg,Span) :- error_occurred(Type,error,Span,Msg).
4833
4834 error_occurred(Type,ErrOrWarn) :- error_occurred(Type,ErrOrWarn,not_yet_extracted,'').
4835
4836 error_occurred(Type,ErrOrWarning,ExtractedSpan,Msg) :-
4837 option(expect_error_pos(Type,Line,Col)),!,
4838 write_xml_element_to_log(expected_error_occurred,[category/Type, (type)/ErrOrWarning, message/Msg]),
4839 assertz(expected_error_occurred(Type)),
4840 (get_error_or_warning_span(ExtractedSpan,Type,EL,EC)
4841 -> (option(expect_error_pos(Type,EL,EC))
4842 -> debug_println(9,expect_error_pos_ok(Type,EL,EC))
4843 ; format('*** Unexpected line ~w and column ~w for error ~w!~n*** Expected line ~w and column ~w.~n',[EL,EC,Type,Line,Col]),
4844 definite_error_occurred
4845 )
4846 ; format('*** Could not obtain position information for error ~w! Expected line ~w and column ~w.~n',[Type,Line,Col]),
4847 %display_error_statistics,
4848 definite_error_occurred).
4849 error_occurred(Type,ErrOrWarning,ExtractedSpan,Msg) :-
4850 option(expect_error(Type)),!,
4851 inc_counter(cli_expected_errors),
4852 get_xml_span(ExtractedSpan,XML),
4853 write_xml_element_to_log(expected_error_occurred,[category/Type, (type)/ErrOrWarning, message/Msg|XML]),
4854 assertz(expected_error_occurred(Type)).
4855 error_occurred(Type,ErrOrWarning,ExtractedSpan,Msg) :-
4856 (probcli_time_stamp(NOW) -> true ; NOW=unknown),
4857 writeln_log(error_occurred(NOW,Type)),
4858 get_xml_span(ExtractedSpan,XML),
4859 (option(optional_error(Type)) ->
4860 write_xml_element_to_log(optional_error_occurred,[category/Type, (type)/ErrOrWarning, message/Msg|XML]),
4861 formatsilent('% Optional error occured: ~w~n',[Type])
4862 ;
4863 write_xml_element_to_log(error_occurred,[category/Type, (type)/ErrOrWarning, message/Msg|XML]),
4864 (ErrOrWarning = warning -> safe_inc_counter(cli_warnings) ; safe_inc_counter(cli_errors)),
4865 flush_output, % ensure we can later associate position of error message
4866 (option(strict_raise_error) ->
4867 print_error('*** Unexpected error occurred ***'),
4868 print_error(Type),
4869 findall(Err,option(expect_error(Err)),Ls), (Ls=[] -> true ; print_error(expected(Ls))),
4870 definite_error_occurred
4871 ; ErrOrWarning=error,serious_error(Type)
4872 -> print_error('*** Serious error occurred ***'),
4873 print_error(Type),
4874 definite_error_occurred
4875 ; print_probcli_error_non_strict(Type,ErrOrWarning)
4876 )
4877 ).
4878
4879 safe_inc_counter(Counter) :-
4880 catch(inc_counter(Counter), E,
4881 format(user_error,'~n*** Exception in counter library, probably not yet initialized: ~w.~n~n',[E])).
4882
4883
4884 get_xml_span(Span,XML) :- extract_file_line_col(Span,FullFilename,Line,Col,EndLine,EndCol),!,
4885 XML = [file/FullFilename,start_line/Line,end_line/EndLine,start_col/Col,end_col/EndCol|XT],
4886 get_xml_add_description(Span,XT).
4887 get_xml_span(Span,XML) :- get_xml_add_description(Span,XML).
4888
4889 get_xml_add_description(Span,XML) :-
4890 extract_additional_description(Span,Msg),!,
4891 XML = [additional_description/Msg].
4892 get_xml_add_description(_,[]).
4893
4894 get_error_or_warning_span(not_yet_extracted,Type,EL,EC) :- check_error_span_file_linecol(Type,_File,EL,EC,_,_).
4895 get_error_or_warning_span(not_yet_extracted,Type,EL,EC) :- check_error_span_file_linecol(warning(Type),_File,EL,EC,_,_).
4896 get_error_or_warning_span(Span,_,EL,EC) :- Span \= not_yet_extracted, extract_line_col(Span,EL,EC,_,_).
4897
4898
4899 % a list of serious errors: if these occur; then return code different from 0 even in non-strict mode
4900 serious_error(get_java_command_path).
4901 serious_error(internal_error(_)).
4902
4903 print_probcli_error_non_strict(parse_machine_predicate_error,_) :-
4904 !. % have already been reported
4905 print_probcli_error_non_strict(Type,ErrOrWarning) :-
4906 (ErrOrWarning=warning -> print_error('*** warning occurred ***')
4907 ; print_error('*** error occurred ***')),
4908 print_error(Type).
4909
4910 definite_error_occurred :- print_error('*** Abnormal termination of probcli !'),
4911 (file_loaded(_,File) -> print_error('*** for_file'(File)) ; true),
4912 (current_probcli_command(Cmd) -> print_error('*** for_command'(Cmd)) ; true),
4913 (probcli_time_stamp(NOW) -> halt_prob(NOW,1)
4914 ; writeln_log(halt(1)),
4915 halt_exception(1)
4916 ).
4917
4918 :- dynamic current_probcli_command/1.
4919 set_current_probcli_command(X) :- retractall(current_probcli_command(_)),
4920 assertz(current_probcli_command(X)).
4921 unset_current_probcli_command :- retractall(current_probcli_command(_)).
4922
4923 halt_prob(ExitCode) :-
4924 (probcli_time_stamp(NOW) -> halt_prob(NOW,ExitCode) ; halt_prob(0,ExitCode)).
4925 halt_prob(NOW,ExitCode) :-
4926 write_xml_element_to_log(probcli_halted_prematurely,[now/NOW]),
4927 close_all_xml_groups_in_log_until('probcli-run'),
4928 stop_xml_probcli_run(NOW),
4929 halt_exception(ExitCode).
4930
4931
4932 :- dynamic accumulated_infos/3, individual_file_infos/3, merged_individual_file_infos/3.
4933 accumulate_infos(Context,Infos) :- option(benchmark_info_csv_output(_,_,_)), % -bench_csv
4934 file_loaded(_,File),
4935 get_additional_infos(Infos,Infos2), % additional infos if -machine_stats provided
4936 sort(Infos2,SInfos), % infos is a list of the form Info-Value
4937 debug_println(19,assert_file_infos(File,Context,SInfos)),
4938 assertz(individual_file_infos(File,Context,SInfos)), % store for later csv summary printing
4939 fail.
4940 accumulate_infos(Context,Infos) :- accumulate_infos_2(Context,Infos).
4941
4942 % useful if this is not related to a loaded file, like -eval_file:
4943 accumulate_file_infos(File,Context,Infos) :-
4944 get_additional_stats(Infos,Infos2),
4945 sort(Infos2,SInfos), % infos is a list of the form Info-Value
4946 assertz(individual_file_infos(File,Context,SInfos)).
4947
4948 % join/merge accumulated infos for multiple runs (benchmarking) for a particular context/category
4949 % currently we support this for model-checking
4950 merge_accumulated_infos(Context) :- individual_file_infos(File,Context,_),!,
4951 findall(Infos,individual_file_infos(File,Context,Infos),[Infos1|RestInfos]),
4952 merge_acc(Infos1,RestInfos,1,Result),
4953 assertz(merged_individual_file_infos(File,Context,Result)).
4954
4955 merge_acc(Cur,[],_,Cur).
4956 merge_acc(Cur,[Next|T],Nr,Res) :-
4957 N1 is Nr+1,
4958 merge_acc_infos(Cur,Next,N1,NextCur),
4959 merge_acc(NextCur,T,N1,Res).
4960
4961 % merge two accumulated infos lists
4962 merge_acc_infos([],S,_,Res) :- !, Res=S.
4963 merge_acc_infos(S,[],_,Res) :- !, Res=S.
4964 merge_acc_infos([C1|T1],[C2|T2],Nr,[Cat-ResVal|MT]) :-
4965 get_info(C1,Cat,Val1), get_info(C2,Cat,Val2),
4966 merge_value(Cat,Val1,Val2,Nr,ResVal),!,
4967 merge_acc_infos(T1,T2,Nr,MT).
4968 merge_acc_infos([C1|T1],T2,Nr,[C1|MT]) :-
4969 add_warning(merge_acc_infos,'Missing value: ',C1),
4970 merge_acc_infos(T1,T2,Nr,MT).
4971
4972 % merge individual values
4973 merge_value(Cat,Val1,_Val2,_,ResVal) :- keep_first_value(Cat),!, ResVal=Val1.
4974 merge_value(_,Val,Val,_,ResVal) :- !, ResVal=Val.
4975 merge_value(Cat,Val1,Val2,Nr,ResVal) :- compute_average(Cat),!, ResVal is (Val1*(Nr-1)/Nr) + (Val2 / Nr).
4976 merge_value(Cat,Val1,Val2,Nr,ResVal) :-
4977 add_warning(merge_value,'Differing values: ',val(Cat,Val1,Val2)),
4978 ResVal is (Val1*(Nr-1)/Nr) + (Val2 / Nr).
4979
4980 compute_average(runtime).
4981 compute_average(total_runtime).
4982 compute_average(walltime).
4983
4984 keep_first_value(memory_used). % memory consumption of the first run is relevant
4985
4986
4987 % also store additional infos if -machine_stats provided; useful for benchmarking/articles
4988 :- use_module(covsrc(hit_profiler),[retract_profile_stats/2]).
4989 get_additional_infos(I,Res) :- option(cli_print_machine_info(statistics)),!,
4990 findall(Key-Nr,b_machine_statistics(Key,Nr),I2,I),
4991 get_additional_stats(I2,Res).
4992 get_additional_infos(I,Res) :- get_additional_stats(I,Res).
4993 get_additional_stats(I,Res) :-
4994 findall(Key-Nr,retract_profile_stats(Key,Nr),Res,I). % include additional profiling stats and retract/reset them
4995
4996 accumulate_infos_2(_,[]).
4997 accumulate_infos_2(Context,[Info|T]) :- get_info(Info,FF,Nr),
4998 (number(Nr) -> Nr>0 ; add_internal_error('Can only accumulate numbers:',FF-Nr),fail), !,
4999 (retract(accumulated_infos(Context,FF,OldNr)) ->true ; OldNr=0),
5000 N1 is OldNr+Nr,
5001 assertz(accumulated_infos(Context,FF,N1)),
5002 accumulate_infos_2(Context,T).
5003 accumulate_infos_2(Context,[_|T]) :- accumulate_infos_2(Context,T).
5004 get_info(FF-Nr,FF,Nr).
5005 get_info(FF/Nr,FF,Nr).
5006
5007 :- use_module(tools_io,[safe_intelligent_open_file/3]).
5008 print_accumulated_infos(NrFilesProcessed) :-
5009 (option(benchmark_info_csv_output(File,FileMode,CSVMode)) % TODO: allow multiple entries
5010 -> safe_intelligent_open_file(File,FileMode,Stream) % FileMode is write or append
5011 ; Stream=user_output, CSVMode=csv
5012 ),
5013 call_cleanup(pr_acc_infos_aux(Stream,NrFilesProcessed,FileMode,CSVMode),
5014 close(Stream)), !.
5015 print_accumulated_infos(NrFilesProcessed) :-
5016 add_internal_error('Call failed:',print_accumulated_infos(NrFilesProcessed)).
5017
5018 get_csv_mode(csv,csv).
5019 get_csv_mode(tex,latex).
5020 get_csv_mode(latex,latex).
5021
5022 %:- use_module(library(system),[ datime/1]).
5023 pr_acc_infos_aux(Stream,NrFilesProcessed,FileMode,CSVMode) :-
5024 (NrFilesProcessed>1,accumulated_infos(_,_,_) -> true ; option(benchmark_info_csv_output(_,_,_))),!,
5025 print_individual_file_infos_csv(Stream,FileMode,CSVMode),
5026 start_xml_group_in_log(summary,files_processed,NrFilesProcessed),
5027 ((FileMode = append ; NrFilesProcessed = 1)
5028 -> true % do not print accumulated info line
5029 ; format(Stream,'Analysis summary (~w files processed): ',[NrFilesProcessed]),
5030 findall(Context-F-Nr,accumulated_infos(Context,F,Nr),L), sort(L,SL),
5031 maplist(prob_cli:pracc(Stream),SL),nl(Stream)
5032 ),
5033 % TO DO: write infos to XML log
5034 (option(print_version(VERSIONKIND)) ->
5035 datime(datime(Year,Month,Day,Hour,Min,_Sec)),
5036 format(Stream,'CSV file generated at ~w:~w on the date ~w/~w/~w using probcli:~n',[Hour,Min,Year,Month,Day]),
5037 print_version(VERSIONKIND,Stream),
5038 print_csv_prefs(Stream)
5039 ; true),
5040 (option(cli_print_statistics(memory)) -> print_memory_statistics(Stream) ; true),
5041 stop_xml_group_in_log_no_statistics(summary).
5042 pr_acc_infos_aux(_,_NrFilesProcessed,_Mode,_).
5043
5044 print_csv_prefs(Stream) :- \+ \+ option(set_preference_group(_,_)),
5045 format(Stream,'PREFERENCE GROUP,Setting~n',[]),
5046 option(set_preference_group(P,V)),
5047 format(Stream,'~w,~w~n',[P,V]),
5048 fail.
5049 print_csv_prefs(Stream) :- \+ \+ option(set_pref(_,_)),
5050 format(Stream,'PREFERENCE,Value~n',[]),
5051 option(set_pref(P,V)),
5052 format(Stream,'~w,~w~n',[P,V]),
5053 fail.
5054 print_csv_prefs(_).
5055
5056 pracc(Stream,Context-F-Nr) :- format(Stream,'~w:~w:~w ',[Context,F,Nr]).
5057 :- use_module(probsrc(tools),[gen_relative_path_to_cur_dir/2]).
5058 % print CSV summary of run
5059 print_individual_file_infos_csv(Stream,FileMode,CSVMode) :-
5060 findall(C,individual_file_infos(_,C,_),All), sort(All,AllContexts),
5061 member(Context,AllContexts), % iterate over all Contexts
5062 (individual_file_infos(_,Context,HInfos) -> true), % pick one as header
5063 (FileMode=append
5064 -> true % do not print header line, we append to an existing table
5065 ; format(Stream,'~nFILE,ANALYSIS,',[]),
5066 print_titles(HInfos,CSVMode,Stream),nl(Stream)
5067 ),
5068 % TO DO: ensure Infos and SHInfos identical, else add 0 for missing categories
5069 (merged_individual_file_infos(File,Context,Infos)
5070 -> true % just print averages
5071 ; individual_file_infos(File,Context,Infos)
5072 ),
5073 gen_relative_path_to_cur_dir(File,RelFile),
5074 format(Stream,'~w,~w,',[RelFile,Context]),
5075 print_vals(Infos,HInfos,CSVMode,Stream),nl(Stream),
5076 fail.
5077 print_individual_file_infos_csv(_,_,_).
5078
5079
5080
5081 print_vals(_,[],_,_) :- !.
5082 print_vals([H|T],[Header|HT],Mode,Stream) :- get_info(Header,Title,_),
5083 get_info(H,Title,Nr), !,
5084 write_atom(Mode,Stream,Nr),
5085 (T=[] -> write_csv_terminator(Mode,Stream) ; write_csv_sep(Mode,Stream), print_vals(T,HT,Mode,Stream)).
5086 print_vals(Vals,[_|HT],Mode,Stream) :- % a value is missing for this file
5087 write(Stream,'-'),
5088 (HT=[] -> write_csv_terminator(Mode,Stream) ; write_csv_sep(Mode,Stream), print_vals(Vals,HT,Mode,Stream)).
5089 print_titles([],_,_).
5090 print_titles([H|T],Mode,Stream) :- get_info(H,FF,_),
5091 write_atom(Mode,Stream,FF),
5092 (T=[] -> write_csv_terminator(Mode,Stream) ; write_csv_sep(Mode,Stream), print_titles(T,Mode,Stream)).
5093
5094 :- use_module(probsrc(tools),[latex_escape_atom/2]).
5095 write_atom(latex,Stream,Atom) :- atom(Atom), latex_escape_atom(Atom,EAtom),!,
5096 write(Stream,EAtom).
5097 write_atom(_,Stream,Term) :- write(Stream,Term).
5098
5099 write_csv_sep(latex,Stream) :- !,write(Stream,' & ').
5100 write_csv_sep(_,Stream) :- write(Stream,',').
5101 write_csv_terminator(latex,Stream) :- !,write(Stream,' \\\\').
5102 write_csv_terminator(_,_).
5103
5104 write_important_xml_element_to_log(Category,Infos) :-
5105 include(prob_cli:important_info,Infos,II),
5106 write_xml_element_to_log(Category,II).
5107 important_info(FF/Nr) :-
5108 \+ irrelevant_xml_info(FF),
5109 (Nr=0 -> \+ irrelevant_xml_if_zero(FF) ; true).
5110 irrelevant_xml_info(true_after_expansion).
5111 irrelevant_xml_info(false_after_expansion).
5112 irrelevant_xml_info(unknown_after_expansion).
5113 irrelevant_xml_info(total_after_expansion).
5114 irrelevant_xml_if_zero(timeout).
5115 irrelevant_xml_if_zero(enum_warning).
5116
5117
5118 % check_required_infos(ExpectedInfos,ActualInfos,ErrType)
5119 check_required_infos([],_,_).
5120 check_required_infos([H|T],Infos,ErrType) :-
5121 (check_single_info(H,Infos)
5122 -> check_required_infos(T,Infos,ErrType)
5123 ; translate_err_type(ErrType,ES),
5124 format_with_colour_nl(user_error,[red],
5125 '*** Unexpected result while checking: ~w~n*** expected : ~w~n*** in : ~w',
5126 [ES,H,Infos]),
5127 error_occurred(ErrType)).
5128 translate_err_type(check_assertions,'ASSERTIONS') :- !.
5129 translate_err_type(cli_check_assertions,'ASSERTIONS') :- !.
5130 translate_err_type(check_goal,'GOAL') :- !.
5131 translate_err_type(load_po_file,'PROOF OBLIGATIONS') :- !.
5132 translate_err_type(cli_wd_check,'WD PROOF OBLIGATIONS') :- !.
5133 translate_err_type(check_cache_stats,'CACHE STATISTICS') :- !.
5134 translate_err_type(X,X).
5135
5136 check_single_info(Label-Nr,Infos) :- !, member(Label-ActualNr,Infos),
5137 match_info(Nr,ActualNr).
5138 check_single_info(H,List) :- member(H,List).
5139 match_info(X,X).
5140 match_info(comparison_operator(Comp,Nr),ActualNr) :-
5141 number(Nr), number(ActualNr),call(Comp,ActualNr,Nr).
5142
5143 :- use_module(tools_platform, [max_tagged_integer/1]).
5144 :- public mc_ok_arg/2.
5145 mc_ok_arg(Arg,X) :- Arg==all,!,max_tagged_integer(X).
5146 mc_ok_arg(Arg,N) :- arg_is_number(Arg,N).
5147
5148
5149 :- dynamic option/1.
5150 assert_all_options([]).
5151 assert_all_options([Opt|T]) :- assert_option(Opt),
5152 assert_all_options(T).
5153
5154 :- use_module(pathes_extensions_db,[probcli_command_requires_extension/2]).
5155 cli_option_not_available(Opt,ProBExtension,Reason) :-
5156 probcli_command_requires_extension(Opt,ProBExtension),
5157 unavailable_extension(ProBExtension,Reason).
5158
5159 check_unavailable_options :-
5160 ? option(Opt),
5161 cli_option_not_available(Opt,ProBExtension,Reason),
5162 (recognised_option(Name,Opt,_,_) -> true ; Name=Opt),
5163 ajoin(['probcli command ', Name,' cannot be performed because extension not available (',Reason,'):'],Msg),
5164 add_error(probcli,Msg,ProBExtension),
5165 fail.
5166 check_unavailable_options.
5167
5168 assert_option(silent) :- option(force_no_silent),!. % ignoring silent flag
5169 assert_option(Opt) :- assertz(option(Opt)), treat_option(Opt).
5170
5171 :- use_module(tools_printing,[set_no_color/1, reset_no_color_to_default/0]).
5172 treat_option(silent) :- !, set_silent_mode(on),set_error_manager_silent_mode(on).
5173 treat_option(force_no_silent) :- !, set_silent_mode(off),set_error_manager_silent_mode(off).
5174 treat_option(no_color) :- !, set_no_color(true).
5175 treat_option(_).
5176
5177 reset_options :- retractall(option(_)),
5178 set_silent_mode(off), set_error_manager_silent_mode(off),
5179 reset_no_color_to_default.
5180
5181 % replace a leading double-dash -- by a single dash and replace inner dashes by underscores
5182 normalise_option_atom(X,RX) :- atom(X),!,
5183 atom_codes(X,CodesX),
5184 % remove leading dash
5185 (CodesX=[45,45,H|T], H\=45 % Double dash --Option
5186 -> maplist(prob_cli:convert_dash_to_underscore,[H|T],HT2),
5187 RXCodes=[45|HT2]
5188 ; CodesX = [Dash|T], is_dash(Dash) % single dash
5189 -> maplist(prob_cli:convert_dash_to_underscore,T,T2),
5190 RXCodes=[45|T2]
5191 ; maplist(prob_cli:convert_dash_to_underscore,CodesX,RXCodes)
5192 ),
5193 atom_codes(RX,RXCodes).
5194 normalise_option_atom(T,T).
5195
5196 is_dash(45). % regular dash
5197 is_dash(8212). % Unicode double dash; sometimes automatically generated from -- by e.g., macOS Mail program
5198
5199 :- public normalise_pref_name/2. % called via recognised_option
5200 % replace dashes by underscores
5201 normalise_pref_name(X,RX) :- atom(X),!,
5202 atom_codes(X,CodesX),
5203 maplist(prob_cli:convert_dash_to_underscore,CodesX,C2),
5204 atom_codes(RX,C2).
5205 normalise_pref_name(T,T).
5206
5207 convert_dash_to_underscore(45,R) :- !, R=95.
5208 convert_dash_to_underscore(X,X).
5209
5210 recognised_cli_option(X,Opt,Args,Condition) :- normalise_option_atom(X,RX),
5211 ? recognised_option(RX,Opt,Args,Condition).
5212
5213 % get a list of all options
5214 get_all_options(SOpts) :-
5215 findall(O, recognised_option(O,_,_,_), Opts),
5216 sort(Opts,SOpts).
5217
5218 :- use_module(tools_matching,[fuzzy_match_codes_lower_case/2]).
5219 % compute a set of possible fuzzy matches
5220 get_possible_fuzzy_match_options(Option,FuzzyMatches) :-
5221 normalise_option_atom(Option,RX),
5222 atom_codes(RX,OCodes),
5223 get_all_options(SOpts),
5224 findall(Target,(member(Target,SOpts),atom_codes(Target,TargetCodes),
5225 fuzzy_match_codes_lower_case(OCodes,TargetCodes)),FuzzyMatches).
5226
5227 :- use_module(tools_matching,[get_possible_completions_msg/3]).
5228 get_possible_options_completion_msg(Option,Msg) :-
5229 normalise_option_atom(Option,RX),
5230 get_all_options(SOpts),
5231 get_possible_completions_msg(RX,SOpts,Msg).
5232
5233 recognised_option(X,Opt,[],true) :- recognised_option(X,Opt). % options without arguments
5234 recognised_option(X,Opt,Args,true) :- recognised_option(X,Opt,Args). % options with arguments but no code needed to check arguments
5235
5236 recognised_option('-mc',cli_mc(N,[]),[Arg],prob_cli:mc_ok_arg(Arg,N)).
5237 recognised_option('-bench_model_check',cli_mc(LimitNr,[reset_state_space,repeat(Rep)]),[Arg],tools:arg_is_number(Arg,Rep)) :- max_tagged_integer(LimitNr).
5238 recognised_option('-model_check',cli_mc(LimitNr,[]),[],true) :- max_tagged_integer(LimitNr).
5239 recognised_option('-timeout',timeout(N),[Arg],tools:arg_is_number(Arg,N)). % for model checking, refinement checking and for disprover per PO
5240 recognised_option('-time_out',timeout(N),[Arg],tools:arg_is_number(Arg,N)).
5241 recognised_option('-global_time_out',timeout(N),[Arg],tools:arg_is_number(Arg,N)). % better name, to avoid conflict with -p timeout N which also works
5242 recognised_option('-s',socket(S,true),[Arg],tools:arg_is_number(Arg,S)).
5243 recognised_option('-cc',coverage(N,N2,just_check_stats),[Arg,Arg2],
5244 (arg_is_number_or_wildcard(Arg,N),arg_is_number_or_wildcard(Arg2,N2))).
5245 recognised_option('-csp_guide',add_csp_guide(File),[File],
5246 prob_cli:check_file_arg(File,'csp_guide')).
5247 recognised_option('-prologOut',csp_translate_to_file(PlFile),[PlFile],
5248 prob_cli:check_file_arg(PlFile,'prologOut')).
5249 recognised_option('-load_state',load_state(Filename),[Filename],
5250 prob_cli:check_file_arg(Filename,'load_state')).
5251 recognised_option('-refchk',refinement_check(Filename,trace,100000),[Filename],
5252 prob_cli:check_file_arg(Filename,'refchk')).
5253 recognised_option('-ref_check',refinement_check(Filename,FailuresModel,100000),[Shortcut,Filename],
5254 (prob_cli:check_file_arg(Filename,'ref_check'),
5255 prob_cli:check_failures_mode(Shortcut,FailuresModel))).
5256 recognised_option('-refinement_check',Option,Args,Code) :- recognised_option('-refchk',Option,Args,Code).
5257 recognised_option('-hash',check_statespace_hash(H,_),[Arg],tools:arg_is_number(Arg,H)).
5258 recognised_option('-hash64',check_statespace_hash(H,'64bit'),[Arg],tools:arg_is_number(Arg,H)).
5259 recognised_option('-hash32',check_statespace_hash(H,'32bit'),[Arg],tools:arg_is_number(Arg,H)).
5260 recognised_option('-check_op_cache_stats',
5261 check_op_cache([next_state_calls-H1,inv_check_calls-H2,
5262 operations_cached-H3,invariants_cached-H4]),[Arg1,Arg2,Arg3,Arg4],
5263 (tools:arg_is_number_or_wildcard(Arg1,H1), tools:arg_is_number_or_wildcard(Arg2,H2),
5264 tools:arg_is_number_or_wildcard(Arg3,H3), tools:arg_is_number_or_wildcard(Arg4,H4))).
5265 recognised_option('-ltllimit',ltl_limit(Nr),[Arg], tools:arg_is_number(Arg,Nr)).
5266 recognised_option('-ltlfile',ltl_file(Filename),[Filename],
5267 prob_cli:check_file_arg(Filename,'ltlfile')).
5268 recognised_option('-check_disprover_result',cli_check_disprover_result([true-TNr,false-FNr,unknown-UNr,failure-0]),[T,F,U],
5269 (arg_is_number_or_wildcard(T,TNr),arg_is_number_or_wildcard(F,FNr),arg_is_number_or_wildcard(U,UNr))).
5270 recognised_option('-aa',cli_check_assertions(all,[true/TNr,false/FNr,unknown/UNr]),[T,F,U],
5271 (arg_is_number_or_wildcard(T,TNr),arg_is_number_or_wildcard(F,FNr),arg_is_number_or_wildcard(U,UNr))).
5272 recognised_option('-ma',cli_check_assertions(main,[true/TNr,false/FNr,unknown/UNr]),[T,F,U],
5273 (arg_is_number_or_wildcard(T,TNr),arg_is_number_or_wildcard(F,FNr),arg_is_number_or_wildcard(U,UNr))).
5274 recognised_option('-wd',cli_wd_check(DNr,TNr),[D,T],
5275 (arg_is_number_or_wildcard(T,TNr),arg_is_number_or_wildcard(D,DNr))).
5276 recognised_option('-check_cache_stats',cli_cache_stats_check([value_persistance_reused_transitions-RNr,
5277 value_persistance_stored_transitions-SNr]),[R,S],
5278 (arg_is_number_or_wildcard(S,SNr),arg_is_number_or_wildcard(R,RNr))).
5279 recognised_option('-kodkod_comparision',kodkod_comparision(Nr),[Arg],tools:arg_is_number(Arg,Nr)).
5280 recognised_option('-kodkod_performance',kodkod_performance(File,Nr),[File,Arg],tools:arg_is_number(Arg,Nr)).
5281 recognised_option('-animate',cli_random_animate(N,true),[Steps],tools:arg_is_number(Steps,N)).
5282 recognised_option('-execute',execute(N,true,current_state(1)),[Steps],tools:arg_is_number(Steps,N)).
5283 recognised_option('-execute_repeat',execute(N,true,current_state(R)),[Steps,Rep],
5284 (tools:arg_is_number(Steps,N),tools:arg_is_number(Rep,R))).
5285 recognised_option('-execute_expect_steps',execute_expect_steps(N),[Steps],tools:arg_is_number(Steps,N)).
5286 recognised_option('-logxml_write_vars',logxml_write_ids(variables,Prefix),[Prefix],true).
5287 recognised_option('-logxml_write_ids',logxml_write_ids(all,Prefix),[Prefix],true).
5288 recognised_option('-zmq_master',zmq_master(Identifier),[Identifier], true).
5289 recognised_option('-cbc_tests', cbc_tests(Depth,EndPred,Output),[Depth,EndPred,Output],
5290 prob_cli:check_file_arg(Output,'cbc_tests')).
5291 recognised_option('-mcm_tests', mcm_tests(Depth,MaxStates,EndPred,Output),[Depth,MaxStates,EndPred,Output],
5292 prob_cli:check_file_arg(Output,'mcm_tests')).
5293 recognised_option('-test_description', test_description(File), [File],
5294 prob_cli:check_file_arg(File,'test_description')).
5295 recognised_option('-all_paths', all_deadlocking_paths(File), [File],
5296 prob_cli:check_file_arg(File,'all_paths')).
5297 recognised_option('-dot',dot_command(Category,File,default),[Category,File],
5298 prob_cli:check_file_arg(File,'dot')).
5299 recognised_option('-spdot',dot_command(state_space,File,default),[File], prob_cli:check_file_arg(File,'spdot')). % we keep this : it is shown in Wiki
5300 % recognised_option('-spmdot',dot_command(signature_merge,File,default),[File], prob_cli:check_file_arg(File,'spmdot')).
5301 % recognised_option('-spddot',dot_command(dfa_merge,File,default),[File], prob_cli:check_file_arg(File,'spddot')).
5302 % recognised_option('-sgdot',dot_command(state_as_graph,File,default),[File], prob_cli:check_file_arg(File,'sgdot')).
5303 recognised_option('-dotexpr',dot_command_for_expr(Category,Expr,File,[],default),[Category,Expr,File],
5304 prob_cli:check_file_arg(File,'dotexpr')).
5305 recognised_option('-dot_expr',Opt,Args,Call) :- recognised_option('-dotexpr',Opt,Args,Call).
5306 %recognised_option('-sgedot',dot_command_for_expr(expr_as_graph,Expr,File,[],default),[Expr,File], prob_cli:check_file_arg(File,'sgedot')).
5307 % recognised_option('-sptdot',dot_command_for_expr(transition_diagram,Expr,File,[],default),[Expr,File],prob_cli:check_file_arg(File,'sptdot')).
5308 %recognised_option('-invdot',dot_command(invariant,File,default),[File], prob_cli:check_file_arg(File,'invdot')).
5309 %recognised_option('-propdot',dot_command(properties,File,default),[File], prob_cli:check_file_arg(File,'propdot')).
5310 %recognised_option('-assdot',dot_command(assertions,File,default),[File], prob_cli:check_file_arg(File,'assdot')).
5311 %recognised_option('-deaddot',dot_command(deadlock,File,default)(File),[File], prob_cli:check_file_arg(File,'deaddot')).
5312 recognised_option('-puml',plantuml_command(Category,File),[Category,File],
5313 prob_cli:check_file_arg(File,'plantuml')).
5314 recognised_option('-pumlexpr',plantuml_command(Category,File,[Expr]),[Category,Expr,File],
5315 prob_cli:check_file_arg(File,'plantuml')).
5316 recognised_option('-puml_expr',Opt,Args,Call) :- recognised_option('-pumlexpr',Opt,Args,Call).
5317 recognised_option('-csv',csv_table_command(Category,[],[],File),[Category,File],
5318 prob_cli:check_file_arg(File,'csv')).
5319 recognised_option('-csvexpr',csv_table_command(Category,[Expr],[],File),[Category,Expr,File],
5320 prob_cli:check_file_arg(File,'csvexpr')).
5321 recognised_option('-csv_expr',Opt,Args,Call) :- recognised_option('-csvexpr',Opt,Args,Call).
5322 recognised_option('-csv_hist',Opt,Args,Call) :- recognised_option('-csvhist',Opt,Args,Call).
5323 recognised_option('-csvhist',evaluate_expression_over_history_to_csv_file(Expr,File),[Expr,File],
5324 prob_cli:check_file_arg(File,'csvhist')).
5325 %recognised_option('-get_min_max_coverage',csv_table_command(minmax_table,[],[text_output],File),[File]). % deprecated
5326 recognised_option('-min_max_coverage',csv_table_command(minmax_table,[],[text_output],File),[File],
5327 prob_cli:check_file_arg(File,'min_max_coverage')).
5328 recognised_option('-get_coverage_information',get_coverage_information(File),[File],
5329 prob_cli:check_file_arg(File,'get_coverage_information')).
5330 %recognised_option('-vc',csv_table_command(minmax_table,[],[text_output],user_output)).
5331 recognised_option('-read_write_matrix_csv',generate_read_write_matrix_csv(CsvFile),
5332 [CsvFile],
5333 prob_cli:check_file_arg(CsvFile,'read_write_matrix_csv')).
5334 recognised_option('-feasibility_analysis_csv',feasibility_analysis_csv(TimeOut,EnablingCsvFile),
5335 [TimeOut,EnablingCsvFile],
5336 prob_cli:check_file_arg(EnablingCsvFile,'feasibility_analysis_csv')).
5337 recognised_option('-l',log(Log,prolog),[Log],
5338 prob_cli:check_file_arg(Log,'l')).
5339 recognised_option('-log',log(Log,prolog),[Log],
5340 prob_cli:check_file_arg(Log,'log')).
5341 recognised_option('-logxml',log(Log,xml),[Log],
5342 prob_cli:check_file_arg(Log,'logxml')). % see cli_start_logging
5343 recognised_option('-logtlc',logtlc(Log),[Log],
5344 prob_cli:check_file_arg(Log,'logtlc')).
5345 recognised_option('-pp',pretty_print_internal_rep(File,'$auto',needed,ascii),[File],
5346 prob_cli:check_file_arg(File,'pp')).
5347 recognised_option('-ppunicode',pretty_print_internal_rep(File,'$auto',needed,unicode),[File],
5348 prob_cli:check_file_arg(File,'pp')).
5349 recognised_option('-ppf',pretty_print_internal_rep(File,'$auto',all,ascii),[File],
5350 prob_cli:check_file_arg(File,'ppf')).
5351 recognised_option('-ppAB',pretty_print_internal_rep(File,'$auto',all,atelierb),[File],
5352 prob_cli:check_file_arg(File,'ppAB')).
5353 recognised_option('-pp_with_name',pretty_print_internal_rep(File,MachName,all,ascii),[MachName,File],
5354 prob_cli:check_file_arg(File,'pp_with_name')). % provide explicit machine name
5355 recognised_option('-ppB',pretty_print_internal_rep_to_B(File),[File],
5356 prob_cli:check_file_arg(File,'ppB')). % deprecated; is now superseded by ppAB for Event-B machines
5357 recognised_option('-pppl',pretty_print_prolog_file(File),[File],
5358 prob_cli:check_file_arg(File,'pppl')).
5359 recognised_option('-ppi',indent_b_file(File),[File],
5360 prob_cli:check_file_arg(File,'ppi')).
5361 recognised_option('-save_state',save_state_space(Filename),[Filename],
5362 prob_cli:check_file_arg(Filename,'save_state')). % possibly save_state_space would be a better name
5363 recognised_option('-save',save_state_for_refinement(Filename),[Filename],
5364 prob_cli:check_file_arg(Filename,'save')).
5365 recognised_option('-sptxt',print_values(Filename),[Filename],
5366 prob_cli:check_file_arg(Filename,'sptxt')).
5367 recognised_option('-sstxt',print_all_values(Dirname),[Dirname],
5368 prob_cli:check_file_arg(Dirname,'sstxt')).
5369 recognised_option('-latex',process_latex_file(In,Out),[In,Out],
5370 (prob_cli:check_file_arg(In,'latex'),prob_cli:check_file_arg(Out,'latex'))).
5371 recognised_option('-bench_csv',benchmark_info_csv_output(File,write,csv),[File],prob_cli:check_file_arg(File,'bench_csv')).
5372 recognised_option('-bench_csv_append',benchmark_info_csv_output(File,append,csv),[File],prob_cli:check_file_arg(File,'bench_csv')).
5373 recognised_option('-bench_tex',benchmark_info_csv_output(File,write,latex),[File],prob_cli:check_file_arg(File,'bench_tex')).
5374 recognised_option('-trace_replay',trace_check(Style,File,default_trace_replay),[Style,File],prob_cli:check_file_arg(File,'trace_replay')). % can be json, ..
5375 recognised_option('-det_trace_replay',trace_check(Style,File,deterministic_trace_replay),[Style,File],prob_cli:check_file_arg(File,'det_trace_replay')).
5376 recognised_option('-replay',eval_repl([File]),[File],prob_cli:check_file_arg(File,'replay')). % used to be -eval
5377 recognised_option('-state_trace',state_trace(File),[File],prob_cli:check_file_arg(File,'state_trace')).
5378 recognised_option('-typecheckertest',typechecker_test(File),[File],prob_cli:check_file_arg(File,'typecheckertest')).
5379 recognised_option('-enabling_analysis_csv',enabling_analysis_csv(EnablingCsvFile),[EnablingCsvFile],
5380 prob_cli:check_file_arg(EnablingCsvFile,'enabling_analysis_csv')).
5381 recognised_option('-dot_output',dot_analyse_output_prefix(Path),[Path],prob_cli:check_file_arg(Path,'dot_output')).
5382 recognised_option('-evaldot',evaldot(File),[File],prob_cli:check_file_arg(File,'evaldot')).
5383 recognised_option('-his',history(File),[File],prob_cli:check_file_arg(File,'his')).
5384 recognised_option('-visb_click',visb_click(SVGID),[SVGID],true).
5385 recognised_option('-visb',visb_history(JSONFile,HTMLFile,[]),[JSONFile,HTMLFile],
5386 (prob_cli:check_file_arg(JSONFile,'visb'),prob_cli:check_file_arg(HTMLFile,'visb'))).
5387 recognised_option('-visb_with_vars',
5388 visb_history(JSONFile,HTMLFile,[show_constants(all),show_sets(all),show_variables(all)]),
5389 [JSONFile,HTMLFile],
5390 (prob_cli:check_file_arg(JSONFile,'visb_with_vars'),prob_cli:check_file_arg(HTMLFile,'visb_with_vars'))).
5391 recognised_option('-rule_report',rule_report(File), [File], prob_cli:check_file_arg(File,'rule_report')).
5392 recognised_option('-bench_alloy_cmd',run_benchmark(alloy,CmdNames,AlloyFilePath),[CmdNames,AlloyFilePath],prob_cli:check_file_arg(AlloyFilePath,'bench_alloy_cmd')).
5393 recognised_option('-bench_smt_cbc_inv',run_benchmark(smt,cbc_inv,Folder),[Folder],prob_cli:check_file_arg(Folder,'bench_smt_cbc_inv')).
5394 recognised_option('-bench_smt_cbc_deadlock',run_benchmark(smt,cbc_deadlock,Folder),[Folder],prob_cli:check_file_arg(Folder,'bench_smt_cbc_deadlock')).
5395 recognised_option('-bench_smt_bmc',run_benchmark(smt,bmc,Folder),[Folder],prob_cli:check_file_arg(Folder,'bench_smt_bmc')).
5396 recognised_option('-eval_file',eval_string_or_file(file(default),F,exists,_ANY,norecheck),[F],prob_cli:check_file_arg(F,'eval_file')).
5397 recognised_option('-evalt_file',eval_string_or_file(file(default),F,exists,'TRUE',norecheck),[F],prob_cli:check_file_arg(F,'evalt_file')).
5398 recognised_option('-eval_rule_file',eval_string_or_file(file(default),F,forall,_ANY,norecheck),[F],prob_cli:check_file_arg(F,'eval_rule_file')).
5399 recognised_option('-solve_file',eval_string_or_file(file(Solver),F,exists,_ANY,norecheck),[Solver,F],prob_cli:check_file_arg(F,'eval_file')).
5400
5401 recognised_option('-zmq_assertions',zmq_assertion(Identifier),[Identifier],true).
5402 recognised_option('-zmq_worker',zmq_worker(Identifier),[Identifier], true).
5403 %recognised_option('-zmq_worker2',zmq_worker2(MasterIP, Port, ProxyID, Logfile),[MasterIP, SPort, SProxyID, Logfile],
5404 % tools:(arg_is_number(SPort,Port), arg_is_number(SProxyID, ProxyID))).
5405 recognised_option('-p',set_pref(NPREF,PREFVAL),[PREF,PREFVAL],prob_cli:normalise_pref_name(PREF,NPREF)).
5406 recognised_option('-pref',set_pref(NPREF,PREFVAL),[PREF,PREFVAL],prob_cli:normalise_pref_name(PREF,NPREF)).
5407 recognised_option('-prob_application_type',set_application_type(T),[T],true).
5408 recognised_option('-cbc_redundant_invariants',cbc_redundant_invariants(Nr),[X],tools:arg_is_number(X,Nr)).
5409 recognised_option('-expcterrpos',expect_error_pos(Type,LNr,CNr),[Type,Line,Col],
5410 (tools:arg_is_number(Line,LNr),tools:arg_is_number(Col,CNr))).
5411 recognised_option('-pref_group',set_preference_group(NGroup,Val),[Group,Val],
5412 (prob_cli:normalise_option_atom(Group,NGroup))).
5413 recognised_option('-save_all_traces_until',generate_all_traces_until(Formula,FilePrefix),
5414 [Formula,FilePrefix],
5415 true). % we could check LTL formula and FilePrefix
5416 recognised_option('-check_machine_file_sha',check_machine_file_sha(FILE,SHA1),[FILE,SHA1],
5417 prob_cli:check_file_arg(FILE,'check_machine_file_sha')).
5418 recognised_option('-sha1sum',Command,Args,Call) :-
5419 recognised_option('-check_machine_file_sha',Command,Args,Call).
5420 recognised_option('-animate_until_ltl_steps',animate_until_ltl(Formula,no_loop,ltl_found,Steps),[Formula,A],
5421 tools:arg_is_number(A,Steps)).
5422
5423 % recognised_option/3
5424 recognised_option('-prefs',set_prefs_from_file(PREFFILE),[PREFFILE]).
5425 %recognised_option('-plugin',plugin(Plugin), [Plugin]).
5426 recognised_option('-card',set_card(SET,SCOPE),[SET,SCOPE]).
5427 recognised_option('-argv',set_argv(ARGV),[ARGV]).
5428 recognised_option('-goal',set_goal(GOAL),[GOAL]).
5429 recognised_option('-property',add_additional_property(PRED),[PRED]).
5430 recognised_option('-scope',set_searchscope(GOAL),[GOAL]).
5431 recognised_option('-searchscope',set_searchscope(GOAL),[GOAL]).
5432 recognised_option('-search_scope',set_searchscope(GOAL),[GOAL]).
5433 recognised_option('-eval',eval_string_or_file(string,E,exists,_,norecheck),[E]).
5434 recognised_option('-evalt',eval_string_or_file(string,E,exists,'TRUE',norecheck),[E]).
5435 recognised_option('-evalf',eval_string_or_file(string,E,exists,'FALSE',norecheck),[E]).
5436 recognised_option('-evalt_rc',eval_string_or_file(string,E,exists,'TRUE',recheck(ascii)),[E]).
5437 recognised_option('-evalf_rc',eval_string_or_file(string,E,exists,'FALSE',recheck(ascii)),[E]).
5438 recognised_option('-evalu',eval_string_or_file(string,E,exists,'UNKNOWN',norecheck),[E]).
5439 recognised_option('-evalnwd',eval_string_or_file(string,E,exists,'NOT-WELL-DEFINED',norecheck),[E]).
5440 recognised_option('-parsercp',parsercp(L),[L]). % deprecated
5441 recognised_option('-parserport',parserport(L),[L]).
5442 recognised_option('-expcterr',expect_error(Type),[Type]).
5443 recognised_option('-expecterr',expect_error(Type),[Type]).
5444 recognised_option('-expect',expect_error(Type),[Type]).
5445 recognised_option('-opterr',optional_error(Type),[Type]).
5446 recognised_option('-his_option',history_option(Option),[Option]). % trace_file, json, show_init, show_states
5447 recognised_option('-cache',cache_storage(D,strict),[D]). % for value_persistance caching
5448 recognised_option('-ccache',cache_storage(D,create_if_needed),[D]). % ditto
5449 recognised_option('-show_cache',show_cache(default),[]).
5450 recognised_option('-show_cache_verbose',show_cache(verbose),[]).
5451 recognised_option('-cache_statistics',cli_print_statistics(value_persistance_stats),[]).
5452 recognised_option('-cache_stats',cli_print_statistics(value_persistance_stats),[]). % synonym
5453 % see also -check_cache_stats
5454 recognised_option('-clear_cache',clear_value_persistance_cache,[]).
5455 recognised_option('-clear_cache_for',clear_value_persistance_cache(Machine),[Machine]).
5456
5457 recognised_option('-MAIN',csp_main(ProcessName),[ProcessName]).
5458
5459 recognised_option('-ltlformula',ltl_formula_model_check(Formula,_),[Formula]).
5460 recognised_option('-ltlformulat',ltl_formula_model_check(Formula,true),[Formula]).
5461 recognised_option('-ltlformulaf',ltl_formula_model_check(Formula,false),[Formula]).
5462 recognised_option('-ctlformula',ctl_formula_model_check(Formula,_),[Formula]).
5463 recognised_option('-ctlformulat',ctl_formula_model_check(Formula,true),[Formula]).
5464 recognised_option('-ctlformulaf',ctl_formula_model_check(Formula,false),[Formula]).
5465 recognised_option('-pctlformula',pctl_formula_model_check(Formula,_),[Formula]).
5466 recognised_option('-pctlformulat',pctl_formula_model_check(Formula,true),[Formula]).
5467 recognised_option('-pctlformulaf',pctl_formula_model_check(Formula,false),[Formula]).
5468 recognised_option('-animate_until_ltl',animate_until_ltl(Formula,no_loop,_,_),[Formula]).
5469 recognised_option('-animate_until_ltl_state_property',animate_until_ltl(Formula,ltl_state_property,_,_),[Formula]).
5470
5471
5472 %recognised_option('-cspref',csp_in_situ_refinement_check(assertRef('False',val_of(AbsP1,no_loc_info_available),Type,val_of(ImplP2,no_loc_info_available),no_loc_info_available),'False'),[AbsP1,Type,ImplP2]).
5473 recognised_option('-cspref',csp_in_situ_refinement_check(AbsP1,Type,ImplP2),[AbsP1,Type,ImplP2]).
5474 % -cspref R [F= Q
5475 recognised_option('-cspdeadlock',csp_checkAssertion(Proc,Model,'deadlock free'),[Proc,Model]).
5476 % -cspdeadlock R F
5477 recognised_option('-cspdeterministic',csp_checkAssertion(Proc,Model,'deterministic'),[Proc,Model]).
5478 % -cspdeterministic R F
5479 recognised_option('-csplivelock',csp_checkAssertion(Proc,'FD','livelock free'),[Proc]).
5480 % -csplivelock R
5481 % -csp_assertion "P [F= Q"
5482 recognised_option('-csp_assertion',check_csp_assertion(Assertion),[Assertion]).
5483 recognised_option('-csp_eval', eval_csp_expression(Expr),[Expr]).
5484 recognised_option('-get_csp_assertions_as_string',csp_get_assertions,[]).
5485
5486 recognised_option('-variable_coverage',csv_table_command(variable_coverage,[],[text_output],user_output),[]).
5487 recognised_option('-vacuity_check',vacuity_check,[]).
5488 recognised_option('-wd_check',cli_wd_check(_,_),[]).
5489 recognised_option('-wd_check_all',cli_wd_check(X,X),[]).
5490 recognised_option('-well_definedness_check',cli_wd_check(_,_),[]).
5491 recognised_option('-wd_inv_proof',cli_wd_inv_proof(_,_,_),[]).
5492 recognised_option('-lint',cli_lint,[]). % extended static check (ESC, esc)
5493 recognised_option('-lint_operations',cli_lint(operations),[]).
5494 recognised_option('-lint_variables',cli_lint(variables),[]).
5495 recognised_option('-cbc',constraint_based_check(OpName),[OpName]). % cbc invariant checking
5496 recognised_option('-cbc_invariant',constraint_based_check(OpName),[OpName]).
5497 recognised_option('-cbc_deadlock',cbc_deadlock_check(true),[]).
5498 recognised_option('-cbc_assertions',cbc_assertions(true,[]),[]).
5499 recognised_option('-cbc_main_assertions',cbc_assertions(true,[main_assertions]),[]).
5500 recognised_option('-cbc_assertions_proof',cbc_assertions(false,[]),[]). % do not allow enumeration warnings
5501 recognised_option('-cbc_assertions_tautology_proof',cbc_assertions(false,[tautology_check]),[]). % do not allow enumeration warnings + disregard PROPERTIES, used for Atelier-B proof/disproof; TO DO: also call WD prover
5502 recognised_option('-cbc_assertions_tautology_proof_check',cbc_assertions(false,[tautology_check,contradiction_check]),[]).
5503 recognised_option('-cbc_option',cbc_option(OPT),[OPT]). % should be tautology_check,contradiction_check, unsat_core
5504 recognised_option('-cbc_result_file',cbc_result_file(FILE),[FILE]). % write result to FILE
5505 recognised_option('-cbc_refinement',cbc_refinement,[]).
5506 recognised_option('-cbc_deadlock_pred',cbc_deadlock_check(GoalPred),[GoalPred]).
5507 recognised_option('-cbc_sequence',cbc_sequence(OpSequence,'',single_solution),[OpSequence]).
5508 recognised_option('-cbc_sequence_all',cbc_sequence(OpSequence,'',findall),[OpSequence]).
5509 recognised_option('-cbc_sequence_with_target',cbc_sequence(OpSequence,TargetPredString,single_solution),[OpSequence,TargetPredString]).
5510 recognised_option('-cbc_sequence_with_target_all',cbc_sequence(OpSequence,TargetPredString,findall),[OpSequence,TargetPredString]).
5511 recognised_option('-comment',comment(UserComment),[UserComment]). % not processed by tool, but will be stored in log-file and used by log_analyser
5512 recognised_option('-junit',junit(Dir),[Dir]).
5513 recognised_option('-mcm_cover', mcm_cover(Event),[Event]).
5514 recognised_option('-cbc_cover', cbc_cover(Event),[Event]).
5515 recognised_option('-cbc_cover_match', cbc_cover(match_event(Event)),[Event]). % find events which have Event String occuring somewhere in name
5516 recognised_option('-cbc_cover_all', cbc_cover_all,[]). % is now default if no cbc_cover provided
5517 recognised_option('-cbc_cover_final', cbc_cover_final,[]).
5518 recognised_option('-bmc', cbc_tests(Depth,'#not_invariant',''),[Depth]).
5519 recognised_option('-bdc', cbc_tests(Depth,'#deadlock',''),[Depth]).
5520 recognised_option('-enabling_analysis',enabling_analysis_csv(user_output),[]).
5521 recognised_option('-feasibility_analysis',feasibility_analysis_csv(1000,user_output),[]).
5522 recognised_option('-read_write_matrix',generate_read_write_matrix_csv(user_output),[]).
5523 recognised_option('-scc_trace',check_scc_for_ltl_formula(LtlFormula,SCC),[LtlFormula,SCC]).
5524 recognised_option('-selfcheck_module',selfcheck(M,[]),[M]).
5525 recognised_option('-mc_mode',depth_breadth_first_mode(M),[M]). % can be mixed, hash, heuristic
5526 recognised_option('-assertion',cli_check_assertions(specific(X),[false/0,unknown/0]),[X]).
5527 recognised_option('-cbc_assertion',cbc_assertions(true,[specific(X)]),[X]). % check only a specific assertion
5528 recognised_option('-symbolic_model_check', cli_symbolic_model_check(Algorithm), [Algorithm]).
5529 recognised_option('-ltsmin2',ltsmin2(EndpointPath), [EndpointPath]).
5530 recognised_option('-ltsmin_ltl_output',ltsmin_ltl_output(Path), [Path]).
5531 recognised_option('-ltsmin_option', ltsmin_option(X),[X]).
5532 recognised_option('-machine_hash_check',cli_print_machine_info(hash(X)),[X]).
5533 recognised_option('-install',install_prob_lib(X,[]),[X]).
5534 recognised_option('-install_dry_run',install_prob_lib(X,[dryrun]),[X]).
5535
5536
5537 recognised_option('-dot_all',dot_generate_for_all_formulas). % generate dot also for true formulas
5538 recognised_option('-animate_all',cli_random_animate(2147483647,false)).
5539 recognised_option('-execute_all',execute(2147483647,false,current_state(1))).
5540 recognised_option('-execute_all_inits',execute(2147483647,false,from_all_initial_states)).
5541 recognised_option('-animate_stats',animate_stats).
5542 recognised_option('-execute_monitor',execute_monitoring).
5543 recognised_option('-check_goal',check_goal).
5544 recognised_option('-ltlassertions',ltl_assertions).
5545 recognised_option('-assertions',cli_check_assertions(all,[false/0,unknown/0])).
5546 recognised_option('-main_assertions',cli_check_assertions(main,[false/0,unknown/0])).
5547 recognised_option('-properties',cli_check_properties).
5548 recognised_option('-properties_core',cli_core_properties(_)). % variable as arg: try various algorithms in order
5549 recognised_option('-properties_core_wd',cli_core_properties(wd_prover)).
5550 recognised_option('-properties_core_z2',cli_core_properties(z3_bup(2))).
5551 recognised_option('-properties_core_z3',cli_core_properties(z3_bup(3))).
5552 recognised_option('-selfcheck',selfcheck(_,[])).
5553 recognised_option('-pacheck',pa_check). % predicate analysis for Kodkod
5554 recognised_option('-det_check',det_check). % check if animation is deterministic
5555 recognised_option('-det_constants',det_constants_check). % check if animation for setup_constants is deterministic
5556 recognised_option('-bf',breadth_first).
5557 recognised_option('-breadth',breadth_first).
5558 recognised_option('-df',depth_first).
5559 recognised_option('-depth',depth_first).
5560 recognised_option('-strict',strict_raise_error).
5561 recognised_option('-silent',silent).
5562 recognised_option('-quiet',silent).
5563 recognised_option('-q',silent).
5564 recognised_option('-force_no_silent',force_no_silent). % override provided silent flag; useful for gitlab test debugging
5565 recognised_option('-statistics',cli_print_statistics(full)).
5566 recognised_option('-stats',cli_print_statistics(full)).
5567 recognised_option('-memory_stats',cli_print_statistics(memory)).
5568 recognised_option('-memory_statistics',cli_print_statistics(memory)).
5569 recognised_option('-memory',cli_print_statistics(memory)).
5570 recognised_option('-profile_stats',cli_print_statistics(sicstus_profile)).
5571 recognised_option('-profile_statistics',cli_print_statistics(sicstus_profile)).
5572 recognised_option('-op_cache_profile',cli_print_statistics(op_cache_profile)).
5573 recognised_option('-hit_profile',cli_print_statistics(hit_profile)). % mainly for ProB developers
5574 recognised_option('-reset_profile_statistics',reset_profiler). % mainly for use in REPL
5575 recognised_option('-nodead',no_deadlocks).
5576 recognised_option('-no_dead',no_deadlocks).
5577 recognised_option('-no_deadlocks',no_deadlocks).
5578 recognised_option('-noinv',no_invariant_violations).
5579 recognised_option('-no_inv',no_invariant_violations).
5580 recognised_option('-no_invariant_violations',no_invariant_violations).
5581 recognised_option('-nogoal',no_goal).
5582 recognised_option('-no_goal',no_goal).
5583 recognised_option('-noltl',no_ltl). % just used for TLC at the moment
5584 recognised_option('-no_ltl',no_ltl).
5585 recognised_option('-noass',no_assertion_violations).
5586 recognised_option('-no_ass',no_assertion_violations).
5587 recognised_option('-no_assertion_violations',no_assertion_violations).
5588 recognised_option('-no_state_errors',no_state_errors). % disable checking for general_errors and transition related state_errors
5589 recognised_option('-nocounter',no_counter_examples).
5590 recognised_option('-no_counter_examples',no_counter_examples).
5591 recognised_option('-nocolor',no_color).
5592 recognised_option('-no_color',no_color).
5593 recognised_option('-no_colour',no_color).
5594 recognised_option('-disable_time_out',set_preference_group(time_out,disable_time_out)).
5595 recognised_option('-disable_timeout',set_preference_group(time_out,disable_time_out)).
5596 %recognised_option('-POR',with_reduction).
5597 recognised_option('-i',animate).
5598 recognised_option('-repl',eval_repl([])). % used to be -eval
5599 recognised_option('-c',coverage(false)).
5600 recognised_option('-cs',coverage(just_summary)).
5601 recognised_option('-coverage',coverage(false)).
5602 recognised_option('-coverage_summary',coverage(just_summary)).
5603 recognised_option('-machine_stats',cli_print_machine_info(statistics)).
5604 recognised_option('-machine_statistics',cli_print_machine_info(statistics)).
5605 recognised_option('-machine_files',cli_print_machine_info(files(no_sha))).
5606 recognised_option('-machine_files_sha',cli_print_machine_info(files(with_sha))).
5607 recognised_option('-machine_hash',cli_print_machine_info(hash(_))).
5608 recognised_option('-check_abstract_constants',check_abstract_constants).
5609 recognised_option('-op_cache_stats',check_op_cache([])).
5610 recognised_option('-op_cache_statistics',check_op_cache([])).
5611 recognised_option('-cv',coverage(true)).
5612 recognised_option('-v',verbose(19)).
5613 recognised_option('-vv',verbose(5)).
5614 recognised_option('-vvv',verbose(1)).
5615 recognised_option('-verbose',verbose(19)).
5616 recognised_option('-debug',verbose(19)).
5617 recognised_option('-verbose_off',verbose_off). % mainly useful in REPL
5618 recognised_option('-voff',verbose_off). % mainly useful in REPL
5619 recognised_option('-very_verbose',verbose(5)).
5620 recognised_option('-profiling_on',profiling_on). % Prolog profiling
5621 recognised_option('-profile',cli_print_statistics(prob_profile)). % ProB Operation profiling
5622 recognised_option('-prob_profile',cli_print_statistics(prob_profile)). % ProB Operation profiling
5623 recognised_option('-prob_statistics',cli_print_statistics(prob_profile)). % synonym
5624 recognised_option('-prob_stats',cli_print_statistics(prob_profile)). % synonym
5625 recognised_option('-version',print_version(full)).
5626 recognised_option('-cpp_version',print_version(cpp)).
5627 recognised_option('-V',print_version(full)).
5628 recognised_option('-svers',print_version(short)).
5629 recognised_option('-short_version',print_version(short)).
5630 recognised_option('-check_lib',print_version(lib)).
5631 recognised_option('-check_java_version',check_java_version).
5632 recognised_option('-java_version',print_version(java)).
5633 recognised_option('-release_java_parser',release_java_parser).
5634 recognised_option('-fast_read_prob',fast_read_prob).
5635 recognised_option('-file_info',file_info).
5636 recognised_option('-t',default_trace_check).
5637 recognised_option('-init',initialise).
5638 recognised_option('-initialise',initialise).
5639 recognised_option('-ll',log('/tmp/prob_cli_debug.log',prolog)). % see cli_start_logging
5640 recognised_option('-ss',socket(9000,true)). % standard socket 9000
5641 recognised_option('-sf',socket(_,true)). % free socket
5642 recognised_option('-local_socketserver',socket(_,true)). % do not allow remote socket connections
5643 recognised_option('-remote_socketserver',socket(_,false)). % allow remote socket connections
5644 recognised_option('-help',help).
5645 recognised_option('-h',help).
5646 recognised_option('-rc',runtimechecking).
5647 recognised_option('-test_mode',test_mode).
5648 recognised_option('-check_complete',check_complete).
5649 recognised_option('-check_complete_operation_coverage', check_complete_operation_coverage).
5650 recognised_option('-mc_with_tlc', cli_start_mc_with_tlc).
5651 recognised_option('-mc_with_lts_sym', cli_start_sym_mc_with_lts(symbolic)).
5652 recognised_option('-mc_with_lts_seq', cli_start_sym_mc_with_lts(sequential)).
5653 recognised_option('-core',disprover_options([disprover_option(unsat_core),unsat_core_algorithm/linear])).
5654 recognised_option('-export_po',disprover_options([disprover_option(export_po_as_machine(user_output))])).
5655 recognised_option('-ltsmin',ltsmin).
5656 recognised_option('-trace',prolog_trace). % enter Prolog debugger on development system after starting up ProB
5657
5658 % some utilities to be able to call the above options directly from repl:
5659 :- public silent/0, coverage/1, help/0.
5660 % predicate to set_verbose_mode
5661 %verbose :- tcltk_turn_debugging_on(19).
5662 %very_verbose :- tcltk_turn_debugging_on(5).
5663 verbose(Nr) :- tcltk_turn_debugging_on(Nr).
5664 verbose_off :- tcltk_turn_debugging_off.
5665 file_info :- file_loaded(true,MainFile), print_file_info(MainFile).
5666 coverage(ShowEnabledInfo) :- probcli_time_stamp(NOW), cli_show_coverage(ShowEnabledInfo,NOW).
5667
5668 silent :- (option(silent) -> true ; assert_option(silent)).
5669 help :- eval_help.
5670 dot_command(DCommand,DotFile,DotEngine) :- call_dot_command_with_engine(DCommand,DotFile,[],DotEngine).
5671 dot_command_for_expr(DECommand,Expr,DotFile,Opts,DotEngine) :-
5672 call_dot_command_with_engine_for_expr(DECommand,Expr,DotFile,Opts,DotEngine).
5673
5674 plantuml_command(PCommand,UmlFile) :- call_plantuml_command(PCommand,UmlFile).
5675 plantuml_command_for_expr(PECommand,Expr,UmlFile,Opts) :-
5676 call_plantuml_command_for_expr(PECommand,Expr,UmlFile,Opts).
5677
5678 :- use_module(tools_io,[safe_intelligent_open_file/3]).
5679 csv_table_command(TCommand,Formulas,Options,CSVFile) :-
5680 append(Formulas,[TableResult],ActualArgs),
5681 OptionalArgs=[],
5682 format_with_colour_nl(user_output,[blue],'Calling table command ~w',[TCommand]),
5683 call_command(table,TCommand,_,ActualArgs,OptionalArgs),
5684 write_table_to_csv_file(CSVFile,Options,TableResult),
5685 format_with_colour_nl(user_output,[blue],'Finished exporting ~w to ~w',[TCommand,CSVFile]).
5686
5687
5688 save_state_space(StateFile) :- debug_println(20,'% Saving state space to file'),
5689 state_space:tcltk_save_state_space(StateFile).
5690 :- public load_state/1. % for REPL
5691 load_state(StateFile) :- debug_println(20,'% Loading state space from file'),
5692 state_space:tcltk_load_state(StateFile).
5693 :- public execute/3. % for REPL
5694 execute(ESteps,ErrOnDeadlock,From) :- cli_execute(ESteps,ErrOnDeadlock,From).
5695
5696 option_verbose :- option(verbose(_)).
5697 option_very_verbose :- debug_level_active_for(5).
5698
5699 set_random_seed_to_deterministic_start_seed :-
5700 % in test_mode we do not change the random number generator's initial seed
5701 true. %getrand(CurrState),setrand(CurrState). % this seems to be a no-op
5702
5703 :- if(predicate_property(set_random(_), _)).
5704 % SWI-Prolog's native API for reinitializing the RNG state.
5705 % The equivalent of this call is also performed automatically by SWI
5706 % when a random number is requested for the first time.
5707 set_new_random_seed :- set_random(seed(random)).
5708 :- else.
5709 % SICStus way of (re)initializing the RNG state.
5710 % Note that on SICStus, the initial RNG state after startup is always the same,
5711 % so it *must* be manually reinitialized like this to get actually random results!
5712 %:- use_module(library(random),[setrand/1]).
5713 set_new_random_seed :-
5714 now(TimeStamp), % getting the unix time
5715 setrand(TimeStamp). % setting new random seed by every execution of probcli
5716 :- endif.
5717
5718 halt_exception :- halt_exception(0).
5719 halt_exception(Code) :- throw(halt(Code)).
5720
5721 % -----------------
5722
5723 start_xml_feature(FeatureName,[CErrs1,CWarns1,CEErrs1]) :-
5724 debug_format(20,'% Starting ~w~n',[FeatureName]),
5725 get_counter(cli_errors,CErrs1), get_counter(cli_warnings,CWarns1), get_counter(cli_expected_errors,CEErrs1),
5726 start_xml_group_in_log(FeatureName).
5727
5728 start_xml_feature(FeatureName,Attr,Value,[CErrs1,CWarns1,CEErrs1]) :-
5729 debug_format(20,'% Starting ~w (~w=~w)~n',[FeatureName,Attr,Value]),
5730 get_counter(cli_errors,CErrs1), get_counter(cli_warnings,CWarns1), get_counter(cli_expected_errors,CEErrs1),
5731 start_xml_group_in_log(FeatureName,Attr,Value).
5732
5733 stop_xml_feature(FeatureName,[CErrs1,CWarns1,CEErrs1]) :-
5734 get_counter(cli_errors,CErrs2), get_counter(cli_warnings,CWarns2), get_counter(cli_expected_errors,CEErrs2),
5735 CErrs is CErrs2-CErrs1, CWarns is CWarns2-CWarns1, CEErrs is CEErrs2-CEErrs1,
5736 (CEErrs>0
5737 -> write_xml_element_to_log('probcli-errors',[errors/CErrs,warnings/CWarns,expected_errors/CEErrs])
5738 ; write_xml_element_to_log('probcli-errors',[errors/CErrs,warnings/CWarns])
5739 ),
5740 debug_format(20,'% Finished ~w (errors=~w, warnings=~w, expected_errors=~w)~n',[FeatureName,CErrs,CWarns,CEErrs]),
5741 stop_xml_group_in_log(FeatureName),
5742 !.
5743 stop_xml_feature(FeatureName,L) :-
5744 add_internal_error('Illegal or failed call:',stop_xml_feature(FeatureName,L)).
5745
5746 %(CErrs>0 -> (file_loaded(_,MainFile) -> true ; MainFile=unknown), Time=unknown, % TO DO: determine time
5747 % create_and_print_junit_result(['Feature',MainFile], FeatureName, Time, error) ; true).
5748 % Note: call stop_xml_group_in_log if the feature stops unexpectedly and you do not have the Info list available
5749
5750 % -----------------
5751
5752 :- public user:runtime_entry/1.
5753 user:runtime_entry(start) :- go_cli.
5754
5755 %save :- save_program('probcli.sav').
5756
5757 :- use_module(eventhandling,[announce_event/1]).
5758 :- announce_event(compile_prob).