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