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