| 1 | % (c) 2009-2026 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, | |
| 2 | % Heinrich Heine Universitaet Duesseldorf | |
| 3 | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) | |
| 4 | ||
| 5 | % tcltk_interface.pl | |
| 6 | :- module(tcltk_interface,[ | |
| 7 | tcltk_goto_state/2, | |
| 8 | tcltk_add_new_transition_transid/6, | |
| 9 | tcltk_add_new_transition/5, | |
| 10 | tcltk_get_options/1, tcltk_get_options_dest_info/1, tcltk_get_state/1, tcltk_get_state/2, | |
| 11 | tcltk_get_options_or_candidates/2, tcltk_get_options_candidate_nr_name/2, | |
| 12 | potentially_enabled_operation/4, | |
| 13 | tcltk_get_options_nr_description/2, | |
| 14 | tcltk_get_history_nr_description/2, | |
| 15 | tcltk_get_history_nr_origin_str/2, tcltk_edit_history_nr_origin_str/1, | |
| 16 | ||
| 17 | tcltk_get_state_errors/1, tcltk_get_detailed_state_error/6, | |
| 18 | tcltk_open_state_error_in_editor/1, | |
| 19 | tcltk_get_line_col/5, | |
| 20 | tcltk_current_state_invariant_violated/0, | |
| 21 | tcltk_get_status/3, | |
| 22 | tcltk_get_ops_with_virtual_timeout/1, | |
| 23 | tcltk_get_ops_with_real_timeout/1, | |
| 24 | tcltk_get_ops_user_interrupt_occurred/0, | |
| 25 | ||
| 26 | tcltk_compute_options/2, | |
| 27 | can_generate_dot_from_last_state_error/0, | |
| 28 | tcltk_initialise/0, tcltk_reset/0, | |
| 29 | ||
| 30 | tcltk_perform_nr/1, tcltk_random_perform/0, tcltk_random_perform/1, | |
| 31 | tcltk_perform_nr_option/3, | |
| 32 | tcltk_perform_action_term/2, | |
| 33 | tcltk_is_sync_event/1, | |
| 34 | ||
| 35 | tcltk_exists_an_open_node/0, tcltk_goto_an_open_node/0, | |
| 36 | tcltk_goto_max_reached_node/0, tcltk_goto_timeout_node/0, | |
| 37 | tcltk_state_exists_with_invariant_violated/0, | |
| 38 | tcltk_goto_an_invariant_violation/0, tcltk_goto_node_with_id/1, | |
| 39 | tcltk_try_goto_node_with_id/1, | |
| 40 | tcltk_current_node_has_no_real_transition/0, tcltk_current_node_has_real_transition/0, | |
| 41 | tcltk_current_node_has_partial_transition/0, | |
| 42 | tcltk_goto_a_non_deterministic_node/1, tcltk_goto_a_non_deterministic_output_node/1, | |
| 43 | tcltk_goto_a_branching_node/0, tcltk_goto_a_non_resetable_node/0, | |
| 44 | tcltk_state_space_only_has_root_node/0, tcltk_no_constants_or_no_inititalisation_found/0, | |
| 45 | tcltk_goto_event_list_property_violation/3, tcltk_goto_state_enabling_operation/2, | |
| 46 | tcltk_find_max_reached_node/0, tcltk_find_max_reached_node/1, | |
| 47 | tcltk_search_among_existing_nodes/6, | |
| 48 | find_invariant_violation_among_not_checked_nodes/1, | |
| 49 | ||
| 50 | tcltk_model_check/11, do_model_check/12, | |
| 51 | tcltk_set_dbf_mode/1, tcltk_dbf_modes/1, | |
| 52 | tcltk_mark_current_node_to_be_recomputed_wo_timeout/0, | |
| 53 | tcltk_mark_current_node_to_be_recomputed_with_random_enum/0, | |
| 54 | tcltk_finish_current_node_to_be_recomputed_with_random_enum/0, | |
| 55 | tcltk_hash_model_checking_imprecise/0, | |
| 56 | tcltk_clear_state_space_and_refocus_to_current_state/0, | |
| 57 | ||
| 58 | tcltk_constraint_based_check/1, | |
| 59 | tcltk_constraint_based_check_op/2, tcltk_constraint_based_check_op/3, | |
| 60 | tcltk_constraint_based_check/2, tcltk_constraint_based_check_with_timeout/2, | |
| 61 | tcltk_cbc_find_trace/2, tcltk_cbc_find_trace/4, | |
| 62 | tcltk_cbc_refinement_check/2, | |
| 63 | tcltk_constraint_find_valid_state/0, | |
| 64 | tcltk_constraint_find_maximal_valid_state/0, | |
| 65 | tcltk_constraint_find_dynamic_assertion_violation/0, | |
| 66 | tcltk_constraint_find_valid_state_with_pred/3, | |
| 67 | tcltk_constraint_find_deadlock_state/1, | |
| 68 | tcltk_constraint_find_deadlock_state_with_goal/2, | |
| 69 | tcltk_constraint_find_deadlock_state_with_goal/3, | |
| 70 | tcltk_constraint_find_static_assertion_violation/1, | |
| 71 | tcltk_check_if_feasible_operation/4, | |
| 72 | cbc_constraint_find_static_assertion_violation/2, | |
| 73 | ||
| 74 | tcltk_can_backtrack/0, tcltk_can_backtrack/1, | |
| 75 | tcltk_can_forward/0, tcltk_can_forward/1, | |
| 76 | tcltk_prepare_for_reload/0, | |
| 77 | tcltk_backtrack/0, tcltk_backtrack/1, tcltk_fast_forward/0, tcltk_forward/0, | |
| 78 | tcltk_execute_trace_to_current_node/0, tcltk_find_shortest_trace_to_current_node/1, | |
| 79 | tcltk_execute_longest_trace_from/1, | |
| 80 | tcltk_get_history/1, | |
| 81 | tcltk_perform_action_string/3, | |
| 82 | tcltk_perform_action/2, | |
| 83 | tcltk_perform_action/4, | |
| 84 | ||
| 85 | tcltk_open_xtl_file/1, | |
| 86 | tcltk_open_z_file/1, tcltk_open_z_tex_file/1, | |
| 87 | tcltk_open_alloy_file/1, tcltk_open_alloy_prolog_ast_file/1, | |
| 88 | tcltk_open_cspm_file/1, | |
| 89 | tcltk_add_csp_file/1, | |
| 90 | tcltk_load_packaged_eventb_file/1, | |
| 91 | tcltk_load_cnf_file/1, | |
| 92 | ||
| 93 | tcltk_verify_alloy_cmd/4, | |
| 94 | tcltk_get_alloy_cmd_names/1, | |
| 95 | tcltk_load_alloy_cmd_in_current_translation/1, | |
| 96 | ||
| 97 | tcltk_machine_has_assertions/0, | |
| 98 | tcltk_unique_top_level_operation/1, tcltk_top_level_operations/1, | |
| 99 | ||
| 100 | compute_all_transitions_if_necessary/0, | |
| 101 | compute_all_transitions_if_necessary/2, | |
| 102 | compute_state_information_if_necessary/0, % compute transitions and invariant | |
| 103 | compute_invariant_if_necessary/3, | |
| 104 | check_invariantKO/2, | |
| 105 | check_invariantKO/3, | |
| 106 | catch_clpfd_overflow_call_for_state/4, | |
| 107 | compute_ample_set/3, | |
| 108 | compute_all_transitions/2, | |
| 109 | add_transition/4, | |
| 110 | add_trans_id/5, | |
| 111 | add_trans_id_infos/6, | |
| 112 | ||
| 113 | tcltk_has_eventtrace/1, tcltk_show_eventtrace/2, | |
| 114 | tcltk_execute_model/3, | |
| 115 | tcltk_execute_trace_to_node/1, | |
| 116 | find_shortest_trace_to_node/4, | |
| 117 | ||
| 118 | tcltk_explore_csp_process/2, tcltk_visualize_csp_process/2, | |
| 119 | get_csp_process_id/2, get_csp_process_stats/1, | |
| 120 | ||
| 121 | tcltk_add_user_executed_operation/2, tcltk_add_user_executed_operation/3, | |
| 122 | tcltk_add_user_executed_operation_typed/4, tcltk_add_user_executed_operation_typed/6, | |
| 123 | tcltk_add_user_executed_statement/3, | |
| 124 | tcltk_add_user_modify_variable_transition/2, tcltk_add_user_modify_variable_transition/4, | |
| 125 | tk_get_possible_language_specific_top_level_event/3, | |
| 126 | ||
| 127 | tcltk_analyse_option/2, | |
| 128 | tcltk_analyse/6, | |
| 129 | tcltk_show_typing_of_variables_and_constants/1, | |
| 130 | tcltk_show_current_state/1, | |
| 131 | tcltk_eval/4, interruptable_tcltk_eval/4, | |
| 132 | tcltk_eval_as_table/2, | |
| 133 | tcltk_find_value_as_table/3, find_value_in_cur_state/4, | |
| 134 | tcltk_time_call/1, eval_elapsed_time/1, | |
| 135 | tcltk_check_csp_assertions/2, tcltk_check_csp_assertion/4, tcltk_check_csp_assertion/5, | |
| 136 | checkAssertion/5, | |
| 137 | tcltk_get_vacuous_guards/1, | |
| 138 | tcltk_get_vacuous_invariants/1, tcltk_get_vacuous_invariants_table/1, | |
| 139 | tcltk_operations_covered_info/3, operation_name_covered/1, | |
| 140 | tcltk_show_expression_as_dot/2, | |
| 141 | generate_dot_from_formula/2, | |
| 142 | generate_dot_from_invariant/1, generate_dot_from_properties/1, generate_dot_from_assertions/1, | |
| 143 | generate_dot_from_deadlock_po/1, generate_dot_from_goal/1, generate_dot_from_last_span_predicate/1, | |
| 144 | generate_dot_from_operation/2, generate_dot_from_operation_with_params/4, | |
| 145 | write_dot_file_for_pred_expr/2, | |
| 146 | write_dot_file_for_value_as_tree/2, | |
| 147 | evaluate_expression_over_history_to_csv_file/2, tcltk_evaluate_expression_over_history/2, | |
| 148 | translate_error_for_tclk/2, | |
| 149 | tcltk_set_initial_machine/0, tcltk_clear_machine/0, | |
| 150 | % set_tcltk_cspm_mode/0, unset_tcltk_cspm_mode/0, | |
| 151 | tcltk_open_b_file/1, tcltk_open_b_file_for_minor_mode/2, | |
| 152 | tcltk_run_ltsmin/5, | |
| 153 | tcltk_save_history_as_trace_file/1, | |
| 154 | tcltk_animate_until/4, | |
| 155 | ||
| 156 | tcltk_bv_get_tops/1, | |
| 157 | tcltk_bv_get_structure/3, | |
| 158 | tcltk_bv_is_leaf/2, | |
| 159 | tcltk_bv_get_values/3, | |
| 160 | tcltk_bv_get_value/3, | |
| 161 | tcltk_bv_show_formula_as_dot_tree/2, | |
| 162 | tcltk_bv_show_formula_as_dot_graph/2, | |
| 163 | tcltk_bv_show_value_as_dot_tree/2, | |
| 164 | tcltk_bv_get_pp_formula_string/2, | |
| 165 | tcltk_show_identifier_value_as_dot_tree/2, % a version of the above independent of bvisual | |
| 166 | tcltk_bv_get_unlimited_value/3, tcltk_bv_get_unlimited_value_atom/2, | |
| 167 | ||
| 168 | tcltk_get_constants_predicate/1, tcltk_get_constants_predicate/3, | |
| 169 | ||
| 170 | get_cbc_data_base_id_checks/1, get_cbc_data_base_text_checks/1, | |
| 171 | ||
| 172 | tcltk_write_uml_sequence_chart/1, | |
| 173 | ||
| 174 | get_ltl_formulas_from_file/2, | |
| 175 | tcltk_mcts_auto_play/0, tcltk_mcts_auto_play/1, mcts_auto_play_available/0, | |
| 176 | tcltk_simplify_predicate/2, % not used | |
| 177 | tcltk_get_possible_completions/2, | |
| 178 | ||
| 179 | tcltk_start_simulation/0, | |
| 180 | tcltk_peform_simulation_steps/4, tcltk_simulation_time/1, tcltk_delay_until_next_step/1, | |
| 181 | tcltk_backtrack_simulation_step/0, tcltk_can_backtrack_simulation_step/0, | |
| 182 | tk_get_simb_history_table/1, tcltk_get_simb_history_length/1, | |
| 183 | tk_get_simb_scheduling_table/1, tk_get_simb_activations/1, tk_get_simb_activation_details/3, | |
| 184 | tk_get_simb_scheduling_table_stats/1, | |
| 185 | tcltk_print_simb_activation_graph/1 | |
| 186 | ]). | |
| 187 | ||
| 188 | ||
| 189 | :- meta_predicate call_pred_on_expanded_state(3,-,-,-). | |
| 190 | :- meta_predicate map_over_history(3,-). | |
| 191 | :- meta_predicate tcltk_time_call(0). | |
| 192 | :- meta_predicate catch_clpfd_overflow_call_for_state(-,-,0,0). | |
| 193 | :- meta_predicate add_csp_process_id1(-,-,1). | |
| 194 | ||
| 195 | %prob_use_module(X) :- load_files(X,[if(changed),load_type(source),compilation_mode(compile)]). | |
| 196 | ||
| 197 | /* load all necessary modules */ | |
| 198 | :- use_module(library(random)). | |
| 199 | :- use_module(library(lists)). | |
| 200 | ||
| 201 | :- use_module(library(ordsets)). | |
| 202 | :- use_module(library(avl)). | |
| 203 | ||
| 204 | :- use_module(module_information). | |
| 205 | :- module_info(group,tcltk). | |
| 206 | :- module_info(description,'Interface between the Tcl/Tk GUI, the CLI and the internal modules.'). | |
| 207 | ||
| 208 | :- use_module(typechecker). | |
| 209 | :- use_module(self_check). | |
| 210 | :- use_module(probsrc(preferences)). | |
| 211 | :- use_module(probsrc(debug)). | |
| 212 | :- use_module(error_manager). | |
| 213 | :- use_module(kernel_waitflags). | |
| 214 | :- use_module(probsrc(tools)). | |
| 215 | :- use_module(probsrc(specfile)). | |
| 216 | :- use_module(probsrc(state_space_exploration_modes)). | |
| 217 | :- use_module(probsrc(translate)). | |
| 218 | :- use_module(probsrc(b_state_model_check)). | |
| 219 | :- use_module(probsrc(bmachine)). | |
| 220 | :- use_module(probsrc(b_interpreter)). | |
| 221 | :- use_module(probsrc(b_trace_checking)). | |
| 222 | :- use_module(probsrc(bsyntaxtree)). | |
| 223 | :- use_module(kernel_objects). | |
| 224 | :- use_module(probsrc(state_space)). | |
| 225 | :- use_module(extension('plspec/plspec/plspec_core'),[set_error_handler/1]). | |
| 226 | :- use_module(extension('plspec/plspec/prettyprinter'),[pretty_print_error/1]). | |
| 227 | prob_plspec_error_handler(ErrTerm) :- pretty_print_error(ErrTerm), | |
| 228 | add_internal_error('Error detected by plspec',ErrTerm). | |
| 229 | :- set_error_handler(tcltk_interface:prob_plspec_error_handler). | |
| 230 | :- use_module(model_checker). | |
| 231 | :- use_module(dotsrc(visualize_graph)). | |
| 232 | :- use_module(dotsrc(state_space_reduction)). | |
| 233 | :- use_module(dotsrc(state_custom_dot_graph)). | |
| 234 | :- use_module(succeed_max). | |
| 235 | %:- use_module(testcase_generator). | |
| 236 | :- use_module(prozsrc(proz),[open_proz_file/2]). | |
| 237 | :- use_module(dotsrc(reduce_graph_state_space)). | |
| 238 | :- use_module(b_read_write_info). | |
| 239 | %:- use_module(flow). | |
| 240 | :- use_module(probltlsrc(ltl),[parse_and_preprocess_formula/3, parse_ltlfile/2, | |
| 241 | pp_ltl_formula/2, ltl_model_check_with_ce1/5, | |
| 242 | is_fairness_implication/1, tcltk_play_ltl_counterexample/2]). | |
| 243 | :- use_module(probltlsrc(ctl),[ctl_model_check_with_ce/6, tcltk_play_ctl_counterexample/2]). | |
| 244 | %:- use_module('promela/promela_ncprinter'). | |
| 245 | :- use_module(extrasrc(bvisual2),[bv_get_top_level/1, bv_expand_formula/3, bv_get_values/3, bv_get_btvalue/4, | |
| 246 | bv_get_stored_formula_expr/2, bv_is_explanation_node/1, bv_get_value_unlimited/3]). | |
| 247 | :- use_module(b_show_history). | |
| 248 | :- use_module(probcspsrc(haskell_csp),[parse_single_csp_declaration/3]). | |
| 249 | %:- use_module(probcspsrc(slicer_csp),[slice_from_program_point/14]). | |
| 250 | :- use_module(value_persistance, [save_constants/1,add_new_transitions_to_cache/1]). | |
| 251 | :- use_module(cbcsrc(cbc_path_solver),[create_testcase_path_nondet/4,verify_alloy_command/5]). | |
| 252 | :- use_module(dotsrc(uml_generator),[write_uml_sequence_chart/1]). | |
| 253 | ||
| 254 | /* main program | |
| 255 | * ============ | |
| 256 | */ | |
| 257 | ||
| 258 | ||
| 259 | /* | |
| 260 | Start server for LTSmin | |
| 261 | */ | |
| 262 | ||
| 263 | :- use_module(extension('ltsmin/ltsmin'),[start_ltsmin/4]). | |
| 264 | ||
| 265 | ||
| 266 | % Backend = symbolic or sequential | |
| 267 | tcltk_run_ltsmin(Backend,NoDead,NoInv,UsePOR,Res) :- | |
| 268 | % in case of POR we can also enable/disable use_cbc_analysis preference | |
| 269 | (UsePOR == true -> MoreFlags = [por] ; MoreFlags=[]), | |
| 270 | start_ltsmin(Backend, [NoDead, NoInv], MoreFlags,Result), | |
| 271 | get_check_name(NoDead,NoInv,Kind), | |
| 272 | process_ltsmin_result(Result,Kind,Res). | |
| 273 | ||
| 274 | % get_check_name(+NoDead,+NoInv,-Kind) | |
| 275 | get_check_name(true,false,Kind) :- Kind = 'INVARIANT'. | |
| 276 | get_check_name(false,true,Kind) :- Kind = 'DEADLOCK'. | |
| 277 | ||
| 278 | :- use_module(tools_printing,[format_with_colour_nl/4]). | |
| 279 | :- use_module(extension('ltsmin/ltsmin_trace'),[csv_to_trace/3]). | |
| 280 | process_ltsmin_result(ltsmin_model_checking_ok,Kind,no_counter_example_found) :- | |
| 281 | format_with_colour_nl(user_output,green,'LTSMin found no ~w Counter Example',Kind). | |
| 282 | process_ltsmin_result(ltsmin_counter_example_found(CsvFile),Kind,counter_example_found) :- | |
| 283 | format_with_colour_nl(user_output,[red,bold],'LTSMin found ~w Counter Example',Kind), | |
| 284 | csv_to_trace(CsvFile,States,Transitions), | |
| 285 | length(Transitions,TLen), format('*** REPLAYING TRACE with length ~w: ~w~n', [TLen, Transitions]), | |
| 286 | % print(States),nl, | |
| 287 | % length(States,SLen), print(state_len(SLen)),nl, | |
| 288 | (replay_ltsmin_trace(States,Transitions) -> true | |
| 289 | ; add_error(process_ltsmin_result,'Could not replay trace:',Transitions)). | |
| 290 | ||
| 291 | replay_ltsmin_trace([],[]). | |
| 292 | replay_ltsmin_trace([State|TS],[TransName|TT]) :- | |
| 293 | (find_successor_state(State,TransName) | |
| 294 | -> replay_ltsmin_trace(TS,TT) | |
| 295 | ; add_error(replay_ltsmin_trace,'Could not execute:',trans_to(TransName,State)),fail). | |
| 296 | ||
| 297 | :- use_module(state_space,[visited_expression/2]). | |
| 298 | find_successor_state(EState,'$init_state') :- !, | |
| 299 | tcltk_reset, | |
| 300 | compute_all_inits, !, | |
| 301 | is_initial_state_id(NewID), | |
| 302 | visited_expression(NewID,State), % print(found_initial(State,EState,NewID)),nl, | |
| 303 | expand_const_and_vars_to_full_store(State,EState), !, | |
| 304 | tcltk_execute_trace_to_node(NewID). | |
| 305 | find_successor_state(EState,TransName) :- | |
| 306 | tcltk_get_options(_), | |
| 307 | current_options(Options), % print(Options),nl, | |
| 308 | member( (_,_Action,ActionOpAsTerm,NewID), Options), | |
| 309 | get_operation_name(ActionOpAsTerm,TransName), | |
| 310 | visited_expression(NewID,State), % print(found_transition(State,EState,NewID,ActionOpAsTerm)),nl, | |
| 311 | expand_const_and_vars_to_full_store(State,EState), !, % TODO: only compare variables | |
| 312 | tcltk_goto_state(ActionOpAsTerm,NewID). | |
| 313 | ||
| 314 | % compute all INITIALISATIONS | |
| 315 | compute_all_inits :- compute_all_transitions_if_necessary(root), fail. | |
| 316 | compute_all_inits :- is_concrete_constants_state_id(ID), compute_all_transitions_if_necessary(ID), fail. | |
| 317 | compute_all_inits. | |
| 318 | ||
| 319 | /* -------------------------------------------------------------------- */ | |
| 320 | ||
| 321 | %tcltk_find_untyped_vars(Vs) :- find_untyped_vars(Vs), Vs \== []. | |
| 322 | ||
| 323 | %tcltk_find_untyped_consts(Vs) :- find_untyped_consts(Vs), Vs \== []. | |
| 324 | ||
| 325 | ||
| 326 | tcltk_find_max_reached_node :- tcltk_find_max_reached_node(_). | |
| 327 | tcltk_find_max_reached_node(ID) :- max_reached_or_timeout_for_node(ID). | |
| 328 | ||
| 329 | ||
| 330 | tcltk_current_node_has_no_real_transition :- | |
| 331 | \+ tcltk_current_node_has_real_transition. | |
| 332 | tcltk_current_node_has_real_transition :- | |
| 333 | current_state_id(CurID), | |
| 334 | transition(CurID,Trans,_), | |
| 335 | (CurID \= root -> true | |
| 336 | ; Trans = '$partial_setup_constants' | |
| 337 | -> properties_were_filtered(Nr), Nr>0 % we probably have the partial transition due to prob-ignore pragmas | |
| 338 | % TODO: detect whether any of the other non-ignored conjuncts were false/unknown | |
| 339 | ; true),!. | |
| 340 | tcltk_current_node_has_partial_transition :- | |
| 341 | current_state_id(CurID), | |
| 342 | transition(CurID,'$partial_setup_constants',_),!. | |
| 343 | ||
| 344 | /* --------------------------------------------------------------------- */ | |
| 345 | tcltk_goto_state(ActionAsTerm,StateID) :- | |
| 346 | (var(StateID) -> print_message(var_state(tcltk_goto_state(ActionAsTerm,StateID))) ; true), | |
| 347 | (visited_expression_id(StateID) | |
| 348 | -> true | |
| 349 | ; ajoin(['State ',StateID,' does not exist. Could be due to insufficient memory. Transition: '],Msg), | |
| 350 | add_warning(tcltk_goto_state,Msg,ActionAsTerm), | |
| 351 | fail | |
| 352 | ), | |
| 353 | (current_state_id(CurID) -> true ; print('*** no_current_state_id ***'),nl), | |
| 354 | ((transition(CurID,ActionAsTerm,OpID,StateID) | |
| 355 | ; ActionAsTerm=jump, % jump is used by ProB2 and eclipse interface; TODO: use $jump or something similar to avoid confusion with real operation names | |
| 356 | transition(CurID,_,OpID,StateID) | |
| 357 | ) | |
| 358 | -> /* ok: proper transition */ | |
| 359 | set_current_state_id(StateID), | |
| 360 | add_to_op_trace_ids(OpID), | |
| 361 | add_id_to_history(CurID) | |
| 362 | ; (CurID=StateID | |
| 363 | -> true | |
| 364 | ; ActionAsTerm=jump, find_id_in_history(StateID,Pos) | |
| 365 | -> tcltk_backtrack(Pos) | |
| 366 | ; ActionAsTerm=jump, find_id_in_forward_history(StateID,Pos) | |
| 367 | -> tcltk_forward(Pos) | |
| 368 | ; set_current_state_id(StateID), | |
| 369 | add_to_op_trace_ids(jump(StateID)), | |
| 370 | add_id_to_history(CurID) | |
| 371 | ) | |
| 372 | ). | |
| 373 | ||
| 374 | find_id_in_history(StateId,Position) :- history(H), nth1(Position,H,StateId). | |
| 375 | find_id_in_forward_history(StateId,Position) :- forward_history(H), nth1(Position,H,forward(StateId,_)). | |
| 376 | ||
| 377 | add_id_to_history(CurID) :- | |
| 378 | (retract(history(History))-> true | |
| 379 | ; add_warning(add_id_to_history,'No history for: ',CurID),History=[]), | |
| 380 | (History=[],CurID\=root | |
| 381 | -> add_message(add_id_to_history,'Adding missing root to history: ',CurID), | |
| 382 | assertz(history([CurID,root])) % fix error in synchronisation between ProB2UI and prolog; should be fixed now | |
| 383 | ; assertz(history([CurID|History])) | |
| 384 | ), | |
| 385 | retractall(forward_history(_)). | |
| 386 | ||
| 387 | ||
| 388 | ||
| 389 | tcltk_add_new_transition(FromID,Action,ToID,ToTempl,TransInfo) :- | |
| 390 | tcltk_add_new_transition_transid(FromID,Action,ToID,ToTempl,TransInfo,_TransId). | |
| 391 | ||
| 392 | tcltk_add_new_transition_transid(FromID,Action,ToID,ToTempl,TransInfo,TransId) :- | |
| 393 | add_new_transition_transid_with_infos(FromID,[],Action,ToID,ToTempl,TransInfo,TransId). | |
| 394 | ||
| 395 | % variation with precomputed infos for the initial id (FromID) | |
| 396 | add_new_transition_transid_with_infos(FromID,PrecomputedInfos,Action,ToID,ToTempl,TransInfo,TransId) :- | |
| 397 | get_operation_internal_name(Action,OpName), % will use $initialise_machine; important for test 961 and PROOF_INFO | |
| 398 | get_id_of_node_and_add_if_required_with_skip_check(ToTempl,ToID,Exists,FromID,OpName,PrecomputedInfos), | |
| 399 | %% print_message(tcltk_add_new_transition(FromID,Action,ToID,Exists)), %% | |
| 400 | ( Exists=exists, | |
| 401 | (preferences:preference(store_only_one_incoming_transition,true), | |
| 402 | \+ operation_not_yet_covered(OpName) % otherwise store at least one transition to achieve coverage | |
| 403 | %-> transition(FromID,_,_,_) % add transition to prevent deadlock being detected | |
| 404 | ; transition(FromID,Action,TransId,ToID), % identical transition already exists | |
| 405 | (preference(eventtrace,true) % STORE_DETAILED_TRANSITION_INFOS; TODO: should we use a separate preference? | |
| 406 | -> check_relevant_transition_info_stored(TransInfo,TransId) % check if we also have the same transition infos | |
| 407 | ; true | |
| 408 | ) | |
| 409 | ) | |
| 410 | -> true % // the transition already exists | |
| 411 | ; % we have a new transition: | |
| 412 | (preferences:preference(forget_state_space,true) | |
| 413 | -> (any_transition(FromID,_,_) -> true | |
| 414 | ; store_transition(FromID,'$NO_DEADLOCK',FromID,TransId)) /* just add dummy transition */ | |
| 415 | ; store_transition(FromID,Action,ToID,TransId), | |
| 416 | (store_transition_infos(TransInfo,TransId) -> true | |
| 417 | ; add_internal_error('storing transition info failed', store_transition_infos(TransInfo,TransId)) | |
| 418 | ) | |
| 419 | ), | |
| 420 | mark_operation_as_covered(OpName), | |
| 421 | (FromID \= ToID, b_or_z_mode, not_all_transitions_added(ToID) | |
| 422 | -> add_additional_destination_infos(FromID,OpName,ToID) % e.g., PROOF_INF | |
| 423 | ; true | |
| 424 | ) | |
| 425 | ). | |
| 426 | ||
| 427 | % a version that checks for query/skip operations and then simply returns old id | |
| 428 | get_id_of_node_and_add_if_required_with_skip_check(_ToTempl,ToID,Exists,FromID,OpName,_PrecomputedInfos) :- | |
| 429 | animation_mode(b), % csp_and_b mode is *not* ok ; see test 1701 for example | |
| 430 | b_operation_cannot_modify_state(OpName), | |
| 431 | !, | |
| 432 | Exists=exists,ToID=FromID. | |
| 433 | get_id_of_node_and_add_if_required_with_skip_check(ToTempl,ToID,Exists,FromID,OpName,PrecomputedInfos) :- | |
| 434 | get_id_of_node_and_add_if_required(ToTempl,ToID,Exists,FromID,OpName,PrecomputedInfos). | |
| 435 | ||
| 436 | ||
| 437 | :- use_module(probsrc(bit_sets),[bitset_intersection/3]). | |
| 438 | % will only be called for ToID different from FromID | |
| 439 | add_additional_destination_infos(FromID,ActionName,ToID) :- %print(add_dest(FromID,ActionName,ToID)),nl, | |
| 440 | ( b_operation_preserves_invariant(ActionName,Full), | |
| 441 | \+ invariant_still_to_be_checked(FromID), | |
| 442 | \+ invariant_violated(FromID) % if Invariant does not hold in previous state, | |
| 443 | % we have no idea about invariants in the new state (proof assumes invariant holds before) | |
| 444 | -> | |
| 445 | (retract(specialized_inv(ToID,OldMask)) -> true ; OldMask = empty), | |
| 446 | (Full=full_invariant | |
| 447 | -> assertz(specialized_inv(ToID,invariant_preserved)) | |
| 448 | % unfortunately we cannot yet retract invariant_not_yet_checked | |
| 449 | ; OldMask=invariant_preserved | |
| 450 | -> assertz(specialized_inv(ToID,invariant_preserved)) | |
| 451 | ; b_specialized_invariant_mask_for_op(ActionName,Mask) -> | |
| 452 | (OldMask == empty -> NewMask = Mask ; bitset_intersection(Mask,OldMask,NewMask)), | |
| 453 | assertz(specialized_inv(ToID,NewMask)) | |
| 454 | ; add_internal_error('Illegal operation: ',add_additional_destination_infos(FromID,ActionName,ToID) ), | |
| 455 | assertz(specialized_inv(ToID,OldMask)) | |
| 456 | ) | |
| 457 | ; true | |
| 458 | ). | |
| 459 | /* | |
| 460 | Store names of incoming transitions in an AVL tree | |
| 461 | Used to calculate invariant in presence of proof information | |
| 462 | */ | |
| 463 | % we could store this information to allow us to quickly generate traces from root to any state | |
| 464 | %add_additional_destination_infos(FromID,ActionName,ToID) :- | |
| 465 | % (reached_via(ToID,_,_) -> true ; %TODO: probably we should also store transition id | |
| 466 | % assertz(reached_via(ToID,ActionName,FromID))). | |
| 467 | % TO DO: we could store pge disabling information here disabled_operations | |
| 468 | ||
| 469 | ||
| 470 | ||
| 471 | ||
| 472 | :- use_module(state_space_exploration_modes,[set_depth_breadth_first_mode/1,dbf_modes/3]). | |
| 473 | ||
| 474 | ||
| 475 | tcltk_set_dbf_mode(Nr) :- dbf_modes(Nr,Mode,_),!, | |
| 476 | set_depth_breadth_first_mode(Mode). | |
| 477 | tcltk_set_dbf_mode(Nr) :- add_error(tcltk_set_dbf_mode,'Unknown mode: ',Nr). | |
| 478 | ||
| 479 | tcltk_dbf_modes(list(Names)) :- findall(N,dbf_modes(_,_,N),Names). | |
| 480 | ||
| 481 | ||
| 482 | :- dynamic prev_randomise_enumeration_order/1. | |
| 483 | ||
| 484 | ||
| 485 | tcltk_mark_current_node_to_be_recomputed_wo_timeout :- | |
| 486 | current_state_id(CurID), | |
| 487 | format('Recomputing state id=~w without TIME_OUT~n',[CurID]), | |
| 488 | tcltk_mark_node_for_recomputed(CurID), | |
| 489 | (use_no_timeout(CurID) -> true ; assertz(use_no_timeout(CurID))). | |
| 490 | ||
| 491 | % used for recomputing a state with random enumeration | |
| 492 | tcltk_mark_current_node_to_be_recomputed_with_random_enum :- | |
| 493 | current_state_id(CurID), | |
| 494 | format('Recomputing state id=~w with random enumeration~n',[CurID]), | |
| 495 | tcltk_mark_node_for_recomputed(CurID), | |
| 496 | % retractall(transition(CurID,_,_,_)), % we no longer delete the transitions; this can cause problems with the history | |
| 497 | % (if CurID appears earlier in the history and we remove the transition) and lead to error messages | |
| 498 | % also: for the user it may be good to add new transitions incrementally | |
| 499 | temporary_set_preference(randomise_enumeration_order,true,PREV), | |
| 500 | assertz(prev_randomise_enumeration_order(PREV)). | |
| 501 | ||
| 502 | tcltk_finish_current_node_to_be_recomputed_with_random_enum :- | |
| 503 | retract(prev_randomise_enumeration_order(PREV)), | |
| 504 | reset_temporary_preference(randomise_enumeration_order,PREV). | |
| 505 | ||
| 506 | tcltk_mark_node_for_recomputed(ID) :- | |
| 507 | (not_all_transitions_added(ID) -> true | |
| 508 | ; add_id_at_front(ID)), | |
| 509 | retractall(max_reached_for_node(ID)), | |
| 510 | retractall(time_out_for_node(ID,_,_)), | |
| 511 | % TODO: clear b_operation_cache:operation_cached_time_out for relevant nodes | |
| 512 | (transition(ID,'$partial_setup_constants',ID2) | |
| 513 | -> delete_node(ID2) ; true), | |
| 514 | retractall(state_space:transition(ID,'$partial_setup_constants',_,_)). | |
| 515 | ||
| 516 | transitions_computed_for_node(ID) :- | |
| 517 | \+(not_all_transitions_added(ID)), | |
| 518 | \+ is_not_interesting(ID). | |
| 519 | ||
| 520 | ||
| 521 | ||
| 522 | ||
| 523 | tcltk_set_initial_machine :- | |
| 524 | tcltk_clear_machine, | |
| 525 | b_set_initial_machine, | |
| 526 | set_animation_mode(b). | |
| 527 | ||
| 528 | % new profiler | |
| 529 | %:- use_module('../extensions/profiler/profiler.pl'). | |
| 530 | % old profiler | |
| 531 | %:- use_module(runtime_profiler,[reset_runtime_profiler/0]). | |
| 532 | ||
| 533 | % the following clears the entire state space and uses the current state as now starting initial state | |
| 534 | tcltk_clear_state_space_and_refocus_to_current_state :- | |
| 535 | Op = 'REFOCUS-ANIMATOR', | |
| 536 | current_expression(_CurID,CurState), | |
| 537 | (CurState = const_and_vars(ConstID,VarState) -> | |
| 538 | visited_expression(ConstID,ConstState), | |
| 539 | transition(root,SetupConstantAction,_,ConstID) | |
| 540 | ; ConstState=[]), | |
| 541 | announce_event(reset_specification), | |
| 542 | (ConstState=[] | |
| 543 | -> add_trans_id(root,Op,CurState,NewID,_TransId) | |
| 544 | ; add_trans_id(root,SetupConstantAction,ConstState,NewConstID,_), | |
| 545 | add_trans_id(NewConstID,Op,const_and_vars(NewConstID,VarState),NewID,_), | |
| 546 | (retract_open_node(NewConstID) -> true ; true), | |
| 547 | tcltk_goto_state(Op,NewConstID) | |
| 548 | ), | |
| 549 | tcltk_goto_state(Op,NewID), | |
| 550 | (retract_open_node(root) -> true ; true). | |
| 551 | ||
| 552 | :- use_module(eventhandling, [announce_event/1]). | |
| 553 | tcltk_clear_machine :- | |
| 554 | announce_event(reset_specification), | |
| 555 | announce_event(clear_specification), | |
| 556 | reset_tcltk_interface, | |
| 557 | set_animation_mode(b), | |
| 558 | bmachine:b_set_empty_machine, | |
| 559 | reset_errors, | |
| 560 | % reset_dynamics, % new profiler | |
| 561 | % Now done via event handling: b_interpreter:reset_b_interpreter,reset_model_checker, | |
| 562 | garbage_collect_atoms. % reclaim atoms if possible | |
| 563 | ||
| 564 | :- use_module(prob2_interface, [start_animation/0, update_preferences_from_spec/0]). | |
| 565 | tcltk_initialise :- | |
| 566 | update_preferences_from_spec, | |
| 567 | start_animation, | |
| 568 | tcltk_try_reload. | |
| 569 | ||
| 570 | tcltk_reset :- reset_errors, | |
| 571 | history(H), op_trace_ids(T), | |
| 572 | current_state_id(CurID), | |
| 573 | (forward_history(FH) -> true ; FH=[]), | |
| 574 | state_space_reset, | |
| 575 | gen_forward_history(T,[CurID|H],FH,FwdHist), | |
| 576 | retractall(forward_history(_)), | |
| 577 | assertz(forward_history(FwdHist)). | |
| 578 | ||
| 579 | gen_forward_history([],H,R,R) :- (H=[root] -> true ; print(unexpected_remaining_hist(H)),nl). | |
| 580 | gen_forward_history([A|TT],[ID|TH],Acc,Res) :- | |
| 581 | gen_forward_history(TT,TH,[forward(ID,A)|Acc],Res). | |
| 582 | ||
| 583 | ||
| 584 | ||
| 585 | /* ---- getting available options ----- */ | |
| 586 | ||
| 587 | tcltk_get_options_dest_info(L) :- | |
| 588 | tcltk_get_options_dest_info(L,[]). %[no_query_operations]). | |
| 589 | tcltk_get_options_dest_info(list(DestinationInfos),Options) :- | |
| 590 | debug_println(9,start_tcltk_get_options_dest_info), | |
| 591 | % get a list of all options which are skip events | |
| 592 | current_state_id(CurID), | |
| 593 | compute_all_transitions_if_necessary(CurID), | |
| 594 | tcltk_get_candidates_dest_info(List1), | |
| 595 | findall(Res, (transition(CurID,ActionAsTerm,ID), % check no_query_operations | |
| 596 | (member(no_query_operations,Options) -> \+ query_op_transition(ActionAsTerm) ; true), | |
| 597 | option_dest_info(ID,ActionAsTerm,CurID,Res)), | |
| 598 | DestinationInfos,List1). | |
| 599 | ||
| 600 | option_dest_info(DestID,ActionAsTerm,CurID,Res) :- DestID=CurID,!, | |
| 601 | (query_op_transition(ActionAsTerm) -> Res=query ; Res=skip). | |
| 602 | option_dest_info(DestID,_,_,Res) :- not_all_transitions_added(DestID),!, Res=open. | |
| 603 | option_dest_info(DestID,_,_,Res) :- invariant_violated(DestID),!,Res=invariant_violated. | |
| 604 | option_dest_info(DestID,_,_,Res) :- is_deadlocked(DestID),!,Res=deadlock. | |
| 605 | option_dest_info(DestID,_,_,Res) :- node_satisfies_goal(DestID),!,Res=goal. | |
| 606 | option_dest_info(_DestID,_,_,unknown). | |
| 607 | ||
| 608 | query_op_transition(Term) :- b_or_z_mode, | |
| 609 | get_operation_name(Term,OpName), | |
| 610 | b_operation_cannot_modify_state(OpName). | |
| 611 | ||
| 612 | tcltk_get_options(Options) :- tcltk_get_options(Options,no_desc). | |
| 613 | ||
| 614 | % get list of enabled operations/events: | |
| 615 | tcltk_get_options(list(Options),GetDesc) :- | |
| 616 | current_state_id(CurID), debug_println(9,start_tcltk_get_options(CurID)), | |
| 617 | catch(tcltk_compute_options(CurID,TransSpecs), | |
| 618 | user_interrupt_signal, ( | |
| 619 | assert_time_out_for_node(CurID,'unspecified_operation_interrupted_by_user',user_interrupt_signal), | |
| 620 | tcltk_get_computed_options(CurID,TransSpecs) | |
| 621 | )), | |
| 622 | extract_actions(TransSpecs,CurID,ActionsAndIDs,Actions,GetDesc), | |
| 623 | set_current_options(ActionsAndIDs), | |
| 624 | debug_println(9,finished_tcltk_get_options(CurID)), | |
| 625 | Actions = Options. | |
| 626 | ||
| 627 | :- dynamic current_candidate_options/1. | |
| 628 | ||
| 629 | % a newer version of tcltk_options which returns list of potentially enabled events | |
| 630 | % in case MAX_OPERATIONS is set to 0; these virtual events are appended at the end of the | |
| 631 | % current transitions (which at the start are empty; but can be populated by executed by predicate) | |
| 632 | % if GetDesc = get_desc then it will try to get operation descriptions (e.g., via desc pragma) | |
| 633 | tcltk_get_options_or_candidates(list(List),GetDesc) :- | |
| 634 | retractall(current_candidate_options(_)), | |
| 635 | tcltk_get_options(list(List1),GetDesc), | |
| 636 | current_state_id(CurID), | |
| 637 | (state_can_have_additional_candidates(CurID,List1,Candidates) | |
| 638 | -> assert(current_candidate_options(Candidates)), | |
| 639 | maplist(get_cand_name,Candidates,List2), | |
| 640 | append(List1,List2,List) | |
| 641 | ; List=List1). | |
| 642 | get_cand_name(candidate(OpName,TO),OpNameRes) :- | |
| 643 | (TO==true -> ajoin([OpName,' (*timeout*)'],OpNameRes) ; OpNameRes=OpName). | |
| 644 | ||
| 645 | :- use_module(specfile,[max_operations_zero_for_setup_constants/0,max_operations_zero_for_initialisation/0]). | |
| 646 | % check if a state can have additional, unexplored transition candidates | |
| 647 | % either because of MAX_OPERATIONS or MAX_INITIALISATIONS or because of symbolic XTL transitions | |
| 648 | state_can_have_additional_candidates(CurID,List1,Res) :- List1=[], | |
| 649 | candidate_setup_constants_or_init(CurID,OpName),!, | |
| 650 | Res = [candidate(OpName,false)]. | |
| 651 | state_can_have_additional_candidates(_,_,Res) :- \+ \+ max_op_zero_or_xtl_mode(_), | |
| 652 | tcltk_get_candidate_operations(Res). | |
| 653 | ||
| 654 | % check if SETUP_CONSTANTS or INITIALISATION were not computed due to MAX_INITIALISATION | |
| 655 | candidate_setup_constants_or_init(root,Candidate) :- !, b_or_z_mode, | |
| 656 | (b_machine_has_constants_or_properties | |
| 657 | -> max_operations_zero_for_setup_constants, | |
| 658 | Candidate = '$setup_constants' | |
| 659 | ; max_operations_zero_for_initialisation, | |
| 660 | Candidate = '$initialise_machine' | |
| 661 | ). | |
| 662 | candidate_setup_constants_or_init(CurID,'$initialise_machine') :- b_or_z_mode, | |
| 663 | is_concrete_constants_state_id(CurID), | |
| 664 | max_operations_zero_for_initialisation. | |
| 665 | ||
| 666 | % in case of MAX_OPERATIONS=0 just show the potentially enabled (regular) operations | |
| 667 | tcltk_get_candidate_operations(Candidates) :- | |
| 668 | current_state_id(CurID), | |
| 669 | findall(candidate(OpName,TimeOutOcc), | |
| 670 | (max_op_zero_or_xtl_mode(OpName), | |
| 671 | potentially_enabled_operation(CurID,OpName,TimeOutOcc,_Precise) | |
| 672 | ),Candidates). | |
| 673 | ||
| 674 | :- use_module(specfile,[max_operations_zero_for_operation/1]). | |
| 675 | max_op_zero_or_xtl_mode(OpName) :- | |
| 676 | xtl_mode,!, | |
| 677 | xtl_transition_parameters(OpName,_Paras). | |
| 678 | max_op_zero_or_xtl_mode(OpName) :- max_operations_zero_for_operation(OpName). | |
| 679 | ||
| 680 | :- use_module(xtl_interface,[xtl_symbolic_transition_potentially_enabled/2]). | |
| 681 | :- use_module(tools_timeout,[time_out_with_factor_call/4]). | |
| 682 | % get operations with MAX_OPERATIONS=0 which are potentially enabled | |
| 683 | potentially_enabled_operation(StateId,OpName,TimeOutOccurred,PreciseGuard) :- b_or_z_mode,!, | |
| 684 | b_top_level_operation(OpName), | |
| 685 | max_operations_zero_for_operation(OpName), | |
| 686 | Simplify=true, | |
| 687 | get_quantified_operation_enabling_condition(OpName, Guard, _, PreciseGuard, Simplify), | |
| 688 | (time_out_with_factor_call( | |
| 689 | eclipse_interface:test_boolean_expression_in_node(StateId,Guard,'operation Guard'), | |
| 690 | 0.1, [max_time_out(2000), | |
| 691 | silent], | |
| 692 | (format('TIME-OUT checking if ~w is enabled; assuming it could be.~n',[OpName]),TimeOutOccurred=true) | |
| 693 | ) | |
| 694 | -> (var(TimeOutOccurred) -> TimeOutOccurred=false ; true)). | |
| 695 | potentially_enabled_operation(StateId,OpName,false,imprecise) :- xtl_mode,!, | |
| 696 | visited_expression(StateId,State), | |
| 697 | xtl_symbolic_transition_potentially_enabled(OpName,State). | |
| 698 | ||
| 699 | % get the name of a currently stored candidate option/operation | |
| 700 | % the option list was empty and we inserted a list of candidate operations | |
| 701 | % (e.g., because MAX_OPERATIONS was 0) | |
| 702 | tcltk_get_options_candidate_nr_name(Nr,OpName) :- | |
| 703 | current_candidate_options(List), | |
| 704 | current_options(List1), length(List1,Len), | |
| 705 | N1 is Nr-Len, % the candidate of potentially enabled events are listed after the regular options | |
| 706 | nth1(N1,List,candidate(OpName,_)). | |
| 707 | ||
| 708 | % get destination info for candidate operations in the Operations View | |
| 709 | tcltk_get_candidates_dest_info(L) :- current_state_id(CurID), | |
| 710 | current_candidate_options(Cands),!, | |
| 711 | maplist(get_cand_dest(CurID),Cands,L). | |
| 712 | tcltk_get_candidates_dest_info([]). | |
| 713 | get_cand_dest(_,candidate(_,true),R) :- !, R=time_out. | |
| 714 | get_cand_dest(CurID,candidate(OpName,_),Res) :- | |
| 715 | transition(CurID,ActionTerm,_ActId,_DestID), | |
| 716 | get_operation_name(ActionTerm,OpName),!, | |
| 717 | % it is a candidate for which we already have a transition | |
| 718 | Res = reached_candidate. | |
| 719 | get_cand_dest(_,_,candidate). | |
| 720 | ||
| 721 | :- use_module(tools_timeout,[time_out_call/2]). | |
| 722 | :- use_module(translate,[translate_event_with_src_and_target_id/4]). | |
| 723 | % GetDesc is either no_desc or get_desc | |
| 724 | extract_actions([],_,[],[],_). | |
| 725 | extract_actions([(ActionId,Term,Dst)|T],CurID,[(ActionId,Str,Term,Dst)|Srest],[Str|ET],GetDesc) :- | |
| 726 | extract_action(CurID,Term,Dst,Str,GetDesc), | |
| 727 | extract_actions(T,CurID,Srest,ET,GetDesc). | |
| 728 | ||
| 729 | extract_action(CurID,ActionAsTerm,DestID,Str,get_desc) :- | |
| 730 | tcltk_get_operation_description_for_trans(CurID,ActionAsTerm,DestID,Desc),!, Str=Desc. | |
| 731 | extract_action(CurID,ActionAsTerm,DestID,Str,_) :- | |
| 732 | time_out_call(translate_event_with_src_and_target_id(ActionAsTerm,CurID,DestID,Str), Str='**TIMEOUT**'). | |
| 733 | ||
| 734 | % compute transitions and invariant info | |
| 735 | compute_state_information_if_necessary :- | |
| 736 | current_state_id(CurID), | |
| 737 | compute_state_information_if_necessary(CurID). | |
| 738 | compute_state_information_if_necessary(CurID) :- | |
| 739 | compute_all_transitions_if_necessary(CurID,true). % CheckInvariant=true | |
| 740 | ||
| 741 | tcltk_compute_options(CurID,ActionsAndIDs) :- | |
| 742 | compute_state_information_if_necessary(CurID), | |
| 743 | %print(found_transitions(CurID)),nl, | |
| 744 | tcltk_get_computed_options(CurID,ActionsAndIDs). | |
| 745 | ||
| 746 | tcltk_get_computed_options(CurID,ActionsAndIDs) :- | |
| 747 | findall((ActId,ActionAsTerm,DestID), | |
| 748 | transition(CurID,ActionAsTerm,ActId,DestID), | |
| 749 | % TO DO: sort or group, especially if we randomize transition/3 | |
| 750 | ActionsAndIDs). | |
| 751 | ||
| 752 | tcltk_get_status(INVVIOLATED,MAXREACHED,TIMEOUT) :- debug_println(9,start_tcltk_get_status), | |
| 753 | current_state_id(CurID), | |
| 754 | (time_out_for_invariant(CurID) -> INVVIOLATED = 2 | |
| 755 | ; get_invariant_violated(CurID) -> INVVIOLATED = 1 | |
| 756 | ; not_invariant_checked(CurID) -> INVVIOLATED = 3 | |
| 757 | ; not_interesting(CurID) -> INVVIOLATED = 3 | |
| 758 | ; INVVIOLATED = 0 | |
| 759 | ), | |
| 760 | (max_reached_for_node(CurID) -> MAXREACHED = 1 | |
| 761 | ; not_interesting(CurID) -> MAXREACHED = 2 | |
| 762 | ; MAXREACHED = 0), | |
| 763 | (time_out_for_node(CurID,_,time_out) -> TIMEOUT = 1 | |
| 764 | ; time_out_for_node(CurID,_,user_interrupt_signal) -> TIMEOUT = 3 % CTRL-C | |
| 765 | ; time_out_for_node(CurID,_,virtual_time_out(kodkod_timeout)) -> TIMEOUT = 1 % KODKOD; regular time-out | |
| 766 | ; time_out_for_node(CurID,_,_) -> TIMEOUT = 2 % virtual_time_out | |
| 767 | ; TIMEOUT = 0), | |
| 768 | debug_println(9,got_status(INVVIOLATED,MAXREACHED,TIMEOUT)). | |
| 769 | ||
| 770 | tcltk_get_ops_with_virtual_timeout(OpNameList) :- | |
| 771 | current_state_id(StateId), | |
| 772 | ops_with_timeout(StateId,OpNameList,virtual_time_out(_)). | |
| 773 | tcltk_get_ops_with_real_timeout(OpNameList) :- | |
| 774 | current_state_id(StateId), | |
| 775 | ops_with_timeout(StateId,OpNameList,time_out). | |
| 776 | % Note: possibilities are currently: time_out, user_interrupt_signal, virtual_time_out(_) | |
| 777 | tcltk_get_ops_user_interrupt_occurred :- | |
| 778 | current_state_id(StateId), | |
| 779 | time_out_for_node(StateId,_,user_interrupt_signal). | |
| 780 | ops_with_timeout(StateId,OpNameList,Type) :- | |
| 781 | findall(OpName, time_out_for_node(StateId,OpName,Type), OpNameList). | |
| 782 | ||
| 783 | ||
| 784 | %%fd_copy_term(X,Y,true) :- copy_term(X,Y). | |
| 785 | ||
| 786 | ||
| 787 | ||
| 788 | /* --------------------------------------------------------------------- */ | |
| 789 | ||
| 790 | tcltk_get_history(list(StringHistory)) :- debug_println(9,start_tcltk_get_trace), | |
| 791 | get_action_trace(History), | |
| 792 | convert_trace_to_list_of_strings(History,StringHistory). | |
| 793 | ||
| 794 | convert_trace_to_list_of_strings([],[]). | |
| 795 | convert_trace_to_list_of_strings([action(AS,_)|T],[AS|CT]) :- !, | |
| 796 | %truncate_atom(AS,1000,TruncatedAS), % especially SETUP_CONSTANTS, INITIALISATION can be very large; leading to performance issues | |
| 797 | % get_action_trace now truncates | |
| 798 | convert_trace_to_list_of_strings(T,CT). | |
| 799 | convert_trace_to_list_of_strings([H|T],[H|CT]) :- convert_trace_to_list_of_strings(T,CT). | |
| 800 | ||
| 801 | tcltk_write_uml_sequence_chart(File) :- | |
| 802 | write_uml_sequence_chart(File). | |
| 803 | ||
| 804 | /* --------------------------------------------------------------------- */ | |
| 805 | ||
| 806 | :- dynamic cached_state_as_strings/2. | |
| 807 | :- use_module(probsrc(state_space),[try_compute_depth_of_state_id/2]). | |
| 808 | %tcltk_get_state(list(List)) :- !,List=[]. % comment in to disable State Properties View in ProB Tcl/Tk | |
| 809 | tcltk_get_state(list(List)) :- debug_println(9,start_tcltk_get_state), | |
| 810 | current_expression(CurID,CurState), | |
| 811 | compute_state_information_if_necessary(CurID), | |
| 812 | (time_out_for_invariant(CurID) -> List = [invariant_time_out|List1] | |
| 813 | ; invariant_violated(CurID) -> List = [invariant_violated|List1] | |
| 814 | ; invariant_not_yet_checked(CurID) -> List = [invariant_not_checked|List1] | |
| 815 | ; CurID=root -> List = List1 | |
| 816 | ; CurState = concrete_constants(_) -> List = List1 | |
| 817 | ; specfile:b_or_z_mode -> List=[invariant_ok|List1] | |
| 818 | % only in b_or_z_mode do we add not_invariant_checked facts and check invariant while model checking/animating | |
| 819 | ; List=List1), | |
| 820 | (try_compute_depth_of_state_id(CurID,Depth), | |
| 821 | translate:translate_properties_with_limit(['='(depth,Depth)],[DS]) | |
| 822 | -> List1 = [DS|StateAsStrings] | |
| 823 | ; List1 = StateAsStrings), | |
| 824 | (cached_state_as_strings(CurID,StateAsStrings) % TO DO: separate constant / variable properties ? | |
| 825 | -> true | |
| 826 | ; retractall(cached_state_as_strings(_,_)), | |
| 827 | time_out_call(tcltk_get_state(StateAsStrings,CurState), | |
| 828 | StateAsStrings = ['***TIMEOUT-PROPERTY***']), | |
| 829 | assertz(cached_state_as_strings(CurID,StateAsStrings)) | |
| 830 | ), | |
| 831 | debug_println(9,finished_tcltk_get_state). | |
| 832 | ||
| 833 | tcltk_get_state(StateAsStrings,State) :- | |
| 834 | %print(get_state),nl, | |
| 835 | findall(Prop,property(State,Prop),StateProps), | |
| 836 | %print(translating(StateProps)),nl, | |
| 837 | translate:translate_properties_with_limit(StateProps,StateAsStrings). | |
| 838 | %print(translated(StateAsStrings)),nl. | |
| 839 | ||
| 840 | ||
| 841 | tcltk_get_state_errors(list(ErrorsAsStrings)) :- | |
| 842 | get_current_state_errors(_CurID,Errors), | |
| 843 | translate_state_errors(Errors,ErrorsAsStrings). | |
| 844 | ||
| 845 | get_current_state_errors(CurID,Errors) :- | |
| 846 | current_state_id(CurID), | |
| 847 | findall(Error,( state_error(CurID,_,Error), Error \== invariant_violated ), Errors). | |
| 848 | ||
| 849 | :- dynamic last_detailed_error/3. | |
| 850 | ||
| 851 | reset_tcltk_interface :- debug_println(19,reset_tcltk), | |
| 852 | retractall(cbc_inv_error_found(_,_)), reset_nr_cbc_sols, | |
| 853 | retractall(find_flag(_,_)), | |
| 854 | retractall(resetable_node(_)), | |
| 855 | retractall(non_det_constant(_)), | |
| 856 | retractall(current_candidate_options(_)), | |
| 857 | retractall(cached_state_as_strings(_,_)), | |
| 858 | retractall(last_detailed_error(_,_,_)). | |
| 859 | ||
| 860 | tcltk_get_detailed_state_error(Num,ErrorMsg,Srow,Scol,Erow,Ecol) :- | |
| 861 | retractall(last_detailed_error(_,_,_)), | |
| 862 | get_current_state_errors(CurID,Errors), | |
| 863 | nth0(Num,Errors,Error), | |
| 864 | !, | |
| 865 | explain_state_error(Error,Span,ErrorMsg), | |
| 866 | assertz(last_detailed_error(CurID,Span,ErrorMsg)), % save info, so that we can debug if Span contains a span_predicate | |
| 867 | %(generate_dot_from_last_span_predicate('~/Desktop/err.dot') -> true ; true), | |
| 868 | (extract_line_col_for_main_file(Span,Srow,Scol,Erow,Ecol) | |
| 869 | -> true | |
| 870 | ; Srow= -1, Scol= -1, Erow= -2, Ecol= -2). | |
| 871 | ||
| 872 | ||
| 873 | :- use_module(probsrc(tools_commands),[edit_file/2]). | |
| 874 | :- use_module(specfile,[b_absolute_file_name_relative_to_opened_file/2]). | |
| 875 | % show location of state error in external editor | |
| 876 | tcltk_open_state_error_in_editor(Num) :- | |
| 877 | get_current_state_errors(_,Errors), | |
| 878 | nth0(Num,Errors,Error), | |
| 879 | (get_state_error_span(Error,Span) | |
| 880 | -> (extract_file_line_col(Span,FILE,LINE,_COL,_Erow,_Ecol) | |
| 881 | -> b_absolute_file_name_relative_to_opened_file(FILE,AFILE), | |
| 882 | edit_file(AFILE,LINE) | |
| 883 | ; add_error(tcltk_open_state_error_in_editor,'Could not extract file position: ',Span) | |
| 884 | ) | |
| 885 | ; add_error(tcltk_open_state_error_in_editor,'Could not extract source location for state error: ',Num) | |
| 886 | ). | |
| 887 | ||
| 888 | can_generate_dot_from_last_state_error :- | |
| 889 | last_detailed_error(_CurID,ErrSpan,_),!, | |
| 890 | get_inner_span(ErrSpan,span_predicate(_,_,_)). | |
| 891 | can_generate_dot_from_last_state_error :- | |
| 892 | current_state_id(CurID), state_error(CurID,_,_). % not sure if it is really possible to extract span predicate though | |
| 893 | generate_dot_from_last_span_predicate(FileName) :- | |
| 894 | current_state_id(CurID), | |
| 895 | (last_detailed_error(CurID,ErrSpan,_ErrorMsg) % also works with expressions | |
| 896 | -> true | |
| 897 | ; tcltk_get_detailed_state_error(0,_,_,_,_,_), % try and generate error description | |
| 898 | last_detailed_error(CurID,ErrSpan,_) | |
| 899 | ), | |
| 900 | get_inner_span(ErrSpan,span_predicate(P,LS,State)), | |
| 901 | (State=[], visited_expression(CurID,S), | |
| 902 | state_corresponds_to_initialised_b_machine(S,FullState) | |
| 903 | -> true % span predicates from event trace do not have the current state, add state | |
| 904 | ; FullState=State), | |
| 905 | write_dot_file_for_pred_expr_and_state(P, LS, FullState,FileName). | |
| 906 | ||
| 907 | get_inner_span(pos_context(Span1,_,_),SP) :- !, | |
| 908 | get_inner_span(Span1,SP). | |
| 909 | get_inner_span(SP,SP). | |
| 910 | ||
| 911 | tcltk_current_state_invariant_violated :- | |
| 912 | current_state_id(CurID), | |
| 913 | get_invariant_violated(CurID). | |
| 914 | ||
| 915 | tcltk_state_exists_with_invariant_violated :- | |
| 916 | (invariant_violated(_) -> true). % would be too expensive for XTL mode | |
| 917 | ||
| 918 | % also checks for other formalisms whether something similar to an invariant violation holds | |
| 919 | get_invariant_violated(CurID) :- xtl_mode,!, | |
| 920 | visited_expression(CurID,CurState), | |
| 921 | xtl_invariant_violated(CurState). | |
| 922 | get_invariant_violated(CurID) :- invariant_violated(CurID). | |
| 923 | ||
| 924 | /* --------------------------------------------------------------------- */ | |
| 925 | ||
| 926 | :- use_module(b_trace_checking, [tcltk_save_history_as_trace_file/2]). | |
| 927 | tcltk_save_history_as_trace_file(File) :- | |
| 928 | tcltk_save_history_as_trace_file(prolog,File). | |
| 929 | ||
| 930 | ||
| 931 | /* --------------------------------------------------------------------- */ | |
| 932 | ||
| 933 | :- use_module(translate, [get_bexpression_column_template/4]). | |
| 934 | evaluate_bexpr_over_state(Stream,Expr,ValueTemplate,Columns,ResultColStrings,BState,OpName) :- | |
| 935 | format(Stream,'~w,',[OpName]), | |
| 936 | b_compute_expression_with_prob_ids(Expr,BState,Value), | |
| 937 | copy_term((ValueTemplate,Columns),(Value,ResultCols)), | |
| 938 | my_print_csv_value(ResultCols,Stream), | |
| 939 | maplist(translate:translate_bvalue,ResultCols,ResultColStrings), | |
| 940 | nl(Stream). | |
| 941 | ||
| 942 | % evaluate an expression over the history and save the result to a CSV file | |
| 943 | evaluate_expression_over_history_to_csv_file(Expr,File) :- | |
| 944 | parse_machine_expression(Expr,TypedExpr), | |
| 945 | get_bexpression_column_template(TypedExpr,ValueTemplate,ColHeaders,Columns), | |
| 946 | format('Writing CSV file: ~w~n',[File]), | |
| 947 | open(File,write,Stream), | |
| 948 | format(Stream,'OPERATION,',[]), | |
| 949 | my_print_csv_atoms(ColHeaders,Stream), | |
| 950 | call_cleanup(map_over_history(evaluate_bexpr_over_state(Stream,TypedExpr,ValueTemplate,Columns),_), | |
| 951 | close(Stream)), | |
| 952 | format('Finished writing CSV file: ~w~n',[File]). | |
| 953 | ||
| 954 | ||
| 955 | tcltk_evaluate_expression_over_history(Expr,list([list(['OPERATION','State Id'|ColHeaders])|ColumnLists])) :- | |
| 956 | parse_machine_expression(Expr,TypedExpr), | |
| 957 | get_bexpression_column_template(TypedExpr,ValueTemplate,ColHeaders,Columns), | |
| 958 | map_over_history(evaluate_bexpr_over_state(user_output,TypedExpr,ValueTemplate,Columns), | |
| 959 | ColumnLists). | |
| 960 | ||
| 961 | map_over_history(Pred,ResColumnLists) :- | |
| 962 | history(H), current_state_id(CurID), | |
| 963 | reverse([CurID|H],RH), | |
| 964 | get_action_trace(T), reverse(T,RT), | |
| 965 | maplist(call_pred_on_expanded_state(Pred),RH,[action(root,root)|RT],ColumnLists), | |
| 966 | prune_list(ColumnLists,ResColumnLists). | |
| 967 | % remove unknown elements at front for Tk | |
| 968 | prune_list([unknown|T],Res) :- !, prune_list(T,Res). | |
| 969 | prune_list(R,R). | |
| 970 | ||
| 971 | call_pred_on_expanded_state(_Pred,root,_,ColList) :- !, ColList=unknown. | |
| 972 | call_pred_on_expanded_state(Pred,StateId,action(_,ActionTerm),ResColList) :- print(StateId),nl, | |
| 973 | get_operation_name(ActionTerm,OpName), | |
| 974 | format('Processing state ~w (reached via ~w)~n',[StateId,OpName]), | |
| 975 | visited_expression(StateId,State), | |
| 976 | (state_corresponds_to_initialised_b_machine(State,BState) | |
| 977 | -> call(Pred,ColList,BState,OpName), ResColList = list([OpName,StateId|ColList]) | |
| 978 | ; ResColList = unknown ). | |
| 979 | ||
| 980 | :- use_module(eval_let_store,[extend_state_with_probids_and_lets/2]). | |
| 981 | b_compute_expression_with_prob_ids(Expr,BState,Value) :- | |
| 982 | extend_state_with_probids_and_lets(BState,BState2), | |
| 983 | b_interpreter:b_compute_expression_nowf(Expr,[],BState2,Value,'Tcl/Tk',0). | |
| 984 | ||
| 985 | ||
| 986 | my_print_csv_atoms([A,B|T],Stream) :- !, format(Stream,'"~w",',[A]), | |
| 987 | my_print_csv_atoms([B|T],Stream). | |
| 988 | my_print_csv_atoms([A],Stream) :- format(Stream,'"~w"~n',[A]). | |
| 989 | ||
| 990 | my_print_csv_value([A,B|T],Stream) :- !, | |
| 991 | my_print_csv_value([A],Stream), | |
| 992 | write(Stream,','), | |
| 993 | my_print_csv_value([B|T],Stream). | |
| 994 | my_print_csv_value([V],Stream) :- | |
| 995 | (no_quotes_necessary(V) -> true ; write(Stream,'"')), | |
| 996 | translate:print_bvalue_stream(Stream,V), | |
| 997 | (no_quotes_necessary(V) -> true ; write(Stream,'"')). | |
| 998 | ||
| 999 | no_quotes_necessary(int(_)). | |
| 1000 | no_quotes_necessary(pred_false). | |
| 1001 | no_quotes_necessary(pred_true). | |
| 1002 | ||
| 1003 | ||
| 1004 | /* --------------------------------------------------------------------- */ | |
| 1005 | ||
| 1006 | :- use_module(probltlsrc(ltl),[preprocess_formula/2]). | |
| 1007 | ||
| 1008 | % it is actually more tcltk_animate_until | |
| 1009 | tcltk_animate_until(FormulaAsAtom,StepsExecuted,Result) :- | |
| 1010 | CheckingType = ltl_state_property, % no_loop means we check entire animation trace from CurID for LTL property | |
| 1011 | tcltk_animate_until(FormulaAsAtom,CheckingType,StepsExecuted,Result). | |
| 1012 | tcltk_animate_until(FormulaAsAtom,CheckingType,StepsExecuted,Result) :- | |
| 1013 | current_state_id(CurID), | |
| 1014 | MaxNrOfSteps = 1000, | |
| 1015 | tcltk_animate_until(FormulaAsAtom,CurID,MaxNrOfSteps,CheckingType,StepsExecuted,Result,_,_). | |
| 1016 | tcltk_animate_until(FormulaAsAtom,CurID,MaxNrOfSteps,CheckingType,StepsExecuted,Result,NewStateId,OpIds) :- | |
| 1017 | parse_and_preprocess_formula(FormulaAsAtom,ltl,Ltl2), | |
| 1018 | % TODO: warn if CheckingType=ltl_state_property and we do not have an atomic state property | |
| 1019 | prob2_interface:find_trace_until_ltl(CurID,random,Ltl2,CheckingType,MaxNrOfSteps,Trace,Result), | |
| 1020 | % Result: ltl_found, maximum_nr_of_steps_reached, deadlock | |
| 1021 | length(Trace,StepsExecuted), | |
| 1022 | (last(Trace,op(_,_,_,NewStateId)) -> true ; NewStateId=CurID), | |
| 1023 | debug_format(19,'Found trace of length ~w to ~w~n',[StepsExecuted,Result]), | |
| 1024 | maplist(get_trans_id,Trace,OpIds), | |
| 1025 | execute_id_trace_from_current(OpIds). | |
| 1026 | ||
| 1027 | get_trans_id(op(OpID,_Name,_CurID,_NextID),OpID). | |
| 1028 | ||
| 1029 | ||
| 1030 | ||
| 1031 | tcltk_random_perform :- tcltk_random_perform2(_,fully_random). | |
| 1032 | tcltk_random_perform(Kind) :- tcltk_random_perform2(_,Kind). | |
| 1033 | ||
| 1034 | % Kind can be fully_random, no_self_loops, explore_open | |
| 1035 | % TODO: other options like out_degree, ... | |
| 1036 | tcltk_random_perform2(ActionId,Kind) :- | |
| 1037 | current_options(Opts), | |
| 1038 | current_state_id(CurID), | |
| 1039 | (Kind=explore_open, exclude(is_already_explored,Opts,Options2), Options2 = [_|_] | |
| 1040 | -> true % try and find unexplored successor | |
| 1041 | ; is_heuristic(Kind), | |
| 1042 | maplist(compute_heuristic(Kind),Opts,HOpts), | |
| 1043 | sort(HOpts,SHOpts), | |
| 1044 | keep_min_heuristic(SHOpts,Opts1) | |
| 1045 | -> | |
| 1046 | (exclude(is_already_explored,Opts1,Options2), Options2 = [_|_] | |
| 1047 | -> true % among the nodes with the lowest heuristic value choose open nodes first; to try find new values | |
| 1048 | ; Options2=Opts1) | |
| 1049 | ; Kind=execute_first_enabled, Opts = [First|_] -> Options2 = [First] | |
| 1050 | ; Kind\=fully_random, | |
| 1051 | exclude(is_self_loop(CurID),Opts,Options2), Options2 = [_|_] -> true % try find different node | |
| 1052 | ; Options2=Opts), | |
| 1053 | length(Options2,Len), | |
| 1054 | (Len>0 | |
| 1055 | -> L1 is Len+1, | |
| 1056 | random(1,L1,RanChoice), | |
| 1057 | tcltk_perform_nr_option(RanChoice,Options2,ActionId) | |
| 1058 | ; true | |
| 1059 | ). | |
| 1060 | ||
| 1061 | is_already_explored((_Id,_Action,_,NextId)) :- \+ not_all_transitions_added(NextId). | |
| 1062 | is_self_loop(CurId,(_Id,_Action,_,CurId)). | |
| 1063 | ||
| 1064 | is_heuristic(heuristic). | |
| 1065 | is_heuristic(min_out_degree). | |
| 1066 | :- use_module(probsrc(state_space_exploration_modes),[compute_heuristic_function_for_state_id/2]). | |
| 1067 | :- use_module(probsrc(state_space),[out_degree/2, compute_transitions_if_necessary/1]). | |
| 1068 | compute_heuristic(Kind,(Id,Action,ActTerm,NextId),heurval(HeurVal,Id,Action,ActTerm,NextId)) :- | |
| 1069 | compute_h2(Kind,NextId,HeurVal). | |
| 1070 | compute_h2(heuristic,NextId,HeurVal) :- | |
| 1071 | compute_heuristic_function_for_state_id(NextId,HeurVal). | |
| 1072 | compute_h2(min_out_degree,NextId,HeurVal) :- | |
| 1073 | compute_transitions_if_necessary(NextId), | |
| 1074 | out_degree(NextId,HeurVal). | |
| 1075 | %compute_h2(out_degree,NextId,HeurVal) :- | |
| 1076 | ||
| 1077 | % only keep the maximal value | |
| 1078 | keep_min_heuristic([heurval(HeurVal,Id,Action,ActTerm,NextId)|HT], | |
| 1079 | [(Id,Action,ActTerm,NextId)|T]) :- keep_min2(HT,HeurVal,T). | |
| 1080 | keep_min2([heurval(HeurVal,Id,Action,ActTerm,NextId)|HT],HeurVal, | |
| 1081 | [(Id,Action,ActTerm,NextId)|T]) :- !, keep_min2(HT,HeurVal,T). | |
| 1082 | keep_min2(_,_,[]). | |
| 1083 | ||
| 1084 | ||
| 1085 | tcltk_get_line_col(Nr,list(StartLine),list(StartCol),list(EndLine),list(EndCol)) :- | |
| 1086 | /* just get the location in the source code */ | |
| 1087 | current_options(Options), | |
| 1088 | nth1(Nr,Options,(_Id,_Action,ActionAsTerm,_NewID)), | |
| 1089 | %print(get_source_text(ActionAsTerm)),nl, | |
| 1090 | time_out_call(get_source_text_positions(ActionAsTerm,StartLine,StartCol,EndLine,EndCol), | |
| 1091 | add_error_and_fail(tcltk_get_line_col,'Timeout determining source code position: ',ActionAsTerm)), | |
| 1092 | StartLine \= []. % otherwise fail | |
| 1093 | % print(startlines(StartLine)),nl,print(startcols(StartCol)),nl, | |
| 1094 | % print(endlines(EndLine)),nl, print(endcol(EndCol)),nl. | |
| 1095 | ||
| 1096 | tcltk_is_sync_event(Nr) :- | |
| 1097 | current_options(Options), | |
| 1098 | nth1(Nr,Options,(_Id,_Action,ActionAsTerm,_NewID)), | |
| 1099 | extract_span_from_event(ActionAsTerm,SPAN,_,_), | |
| 1100 | extract_span_info(SPAN,Info), | |
| 1101 | % print(extracted_span_info_for_sync(Info,SPAN)),nl, | |
| 1102 | member(sharing,Info). | |
| 1103 | ||
| 1104 | % get textual description of nth option in current options | |
| 1105 | % is derived from description pragma attached to operations | |
| 1106 | tcltk_get_options_nr_description(Nr,Desc) :- | |
| 1107 | current_state_id(CurID), | |
| 1108 | current_options(Options), | |
| 1109 | nth1(Nr,Options,(_ActionId,_Action,ActionAsTerm,NewID)), | |
| 1110 | tcltk_get_op_desc_or_other_info_for_trans(CurID,ActionAsTerm,NewID,Desc). | |
| 1111 | ||
| 1112 | :- use_module(probsrc(bmachine),[source_code_for_identifier/6]). | |
| 1113 | % get textual description for entry Nr in the Tk history view | |
| 1114 | tcltk_get_history_nr_description(Nr,Desc) :- | |
| 1115 | get_history_trans(Nr, CurID,ActionAsTerm,DestID), | |
| 1116 | tcltk_get_op_desc_or_other_info_for_trans(CurID,ActionAsTerm,DestID,Desc). | |
| 1117 | ||
| 1118 | get_history_trans(Nr, CurID,ActionAsTerm,DestID) :- | |
| 1119 | op_trace_ids(OpTrace), | |
| 1120 | nth0(Nr,OpTrace,TransId), | |
| 1121 | history(StateIds), | |
| 1122 | nth0(Nr,StateIds,CurID), | |
| 1123 | transition(CurID,ActionAsTerm,TransId,DestID). | |
| 1124 | ||
| 1125 | :- use_module(probsrc(bmachine),[source_code_for_identifier/6]). | |
| 1126 | % show source code origin of entry number Nr in the Tk history view | |
| 1127 | tcltk_get_history_nr_origin_str(Nr,Desc) :- | |
| 1128 | get_history_trans(Nr, _CurID,ActionAsTerm,_DestID), | |
| 1129 | get_operation_name(ActionAsTerm,OpID), | |
| 1130 | source_code_for_identifier(OpID,operation,subst,OriginStr,_,_), | |
| 1131 | Desc=OriginStr. %ajoin([OpID,' ', OriginStr],Desc). | |
| 1132 | ||
| 1133 | ||
| 1134 | :- use_module(probsrc(tools_commands),[edit_file/2]). | |
| 1135 | :- use_module(probsrc(error_manager),[extract_file_line_col/6]). | |
| 1136 | % open source code in external editor for origin of entry number Nr in the history view | |
| 1137 | tcltk_edit_history_nr_origin_str(Nr) :- | |
| 1138 | get_history_trans(Nr, _CurID,ActionAsTerm,_DestID), | |
| 1139 | get_operation_name(ActionAsTerm,OpID), | |
| 1140 | source_code_for_identifier(OpID,operation,subst,_OriginStr,OriginTerm,_), | |
| 1141 | extract_file_line_col(OriginTerm,FILE,LINE,_COL,_Erow,_Ecol), | |
| 1142 | edit_file(FILE,LINE). | |
| 1143 | ||
| 1144 | :- use_module(probsrc(state_space_exploration_modes), | |
| 1145 | [compute_heuristic_function_for_state_id/2]). | |
| 1146 | tcltk_get_operation_description_for_trans(CurID,ActionAsTerm,DestID,Desc) :- | |
| 1147 | (b_or_z_mode ; xtl_mode), | |
| 1148 | get_operation_description_for_transition(CurID,ActionAsTerm,DestID,Desc). | |
| 1149 | ||
| 1150 | % this will also look for other info if available | |
| 1151 | tcltk_get_op_desc_or_other_info_for_trans(CurID,ActionAsTerm,DestID,Desc) :- | |
| 1152 | (tcltk_get_operation_description_for_trans(CurID,ActionAsTerm,DestID,Desc) -> true | |
| 1153 | ; compute_heuristic_function_for_state_id(DestID,int(HeuristicVal)), | |
| 1154 | ajoin(['Heuristic=',HeuristicVal],Desc)). % TODO: more infos, like deadlock, GOAL, ... | |
| 1155 | ||
| 1156 | % counter-part to tcltk_get_options, to execute the option/operation number Nr in that list | |
| 1157 | tcltk_perform_nr(Nr) :- | |
| 1158 | current_options(Options), | |
| 1159 | tcltk_perform_nr_option(Nr,Options,_). | |
| 1160 | ||
| 1161 | tcltk_perform_nr_option(Nr,Options,ActionId) :- | |
| 1162 | (nth1(Nr,Options,(ActionId,_Action,ActionAsTerm,NewID)) | |
| 1163 | -> (forward_history([forward(NewID,ActionId)|_FwdHist]) | |
| 1164 | -> tcltk_forward | |
| 1165 | ; tcltk_perform_action_term(ActionAsTerm,NewID), | |
| 1166 | retractall(forward_history(_)) | |
| 1167 | ) | |
| 1168 | ; tcltk_backtrack /* interpret as backtrack */ | |
| 1169 | ). | |
| 1170 | ||
| 1171 | ||
| 1172 | tcltk_can_backtrack :- history([_|_]). | |
| 1173 | tcltk_can_backtrack(Len) :- history(His), length(His,Len),Len>0. | |
| 1174 | tcltk_can_backtrack_to_state_id(StateID) :- history([StateID|_]). | |
| 1175 | ||
| 1176 | tcltk_backtrack :- \+ tcltk_can_backtrack,!, | |
| 1177 | print_message('Cannot backtrack'),fail. | |
| 1178 | tcltk_backtrack :- | |
| 1179 | remove_from_op_trace_ids(LastTraceH), % remove last operation id from op_id trace | |
| 1180 | retract(history(History)), | |
| 1181 | retract(current_state_id(CurID)),!, | |
| 1182 | History= [LastID|EHist], | |
| 1183 | assertz(history(EHist)), | |
| 1184 | %visited_expression(LastID,LastExpr,LastBody), | |
| 1185 | assertz(current_state_id(LastID)), | |
| 1186 | (retract(forward_history(FwdHist)) -> true ; FwdHist=[]), | |
| 1187 | assertz(forward_history([forward(CurID,LastTraceH)|FwdHist])). | |
| 1188 | ||
| 1189 | % used for right-clicks in history | |
| 1190 | tcltk_backtrack(N) :- N =< 0, !. | |
| 1191 | tcltk_backtrack(N) :- % TO DO: more efficient version | |
| 1192 | tcltk_backtrack, N1 is N-1, tcltk_backtrack(N1). | |
| 1193 | ||
| 1194 | :- dynamic saved_forward_history/2. | |
| 1195 | :- volatile saved_forward_history/2. | |
| 1196 | ||
| 1197 | ||
| 1198 | % save certain information to restore when reload is completed: | |
| 1199 | tcltk_prepare_for_reload :- | |
| 1200 | saved_forward_history([_|_],Mode), % tcltk_try_reload not executed; probably reloading failed | |
| 1201 | animation_mode(Mode), | |
| 1202 | current_state_id(root), %user has not performed another trace | |
| 1203 | get_action_trace([]),!, | |
| 1204 | format('Keeping saved forward history~n',[]). % so that user can fix error and re-load again | |
| 1205 | tcltk_prepare_for_reload :- | |
| 1206 | retractall(saved_forward_history(_,_)), | |
| 1207 | get_action_term_trace(TrA),reverse(TrA,Tr), | |
| 1208 | %print(prepare_reloading(Tr)),nl, | |
| 1209 | maplist(gen_unknown_forward,Tr,SavedForwardHistory), | |
| 1210 | animation_mode(Mode), | |
| 1211 | % TO DO: add current forward history as well and restore when doing a reload with fastforward | |
| 1212 | % forward_history(ForwHis), maplist(remove_forward_id,ForwHis,SavedPrevForwHis), | |
| 1213 | assertz(saved_forward_history(SavedForwardHistory,Mode)). | |
| 1214 | ||
| 1215 | %remove_forward_id(forward(_,Step),forward('$UNKNOWN',Step)). | |
| 1216 | gen_unknown_forward(Step,forward('$UNKNOWN',Step)). % the forward ID is unknown | |
| 1217 | ||
| 1218 | % try reloading certain information from previous load of same model | |
| 1219 | tcltk_try_reload :- | |
| 1220 | retract(saved_forward_history(SavedForwardHistory,Mode)), | |
| 1221 | animation_mode(Mode), % we are in the same mode as when saved | |
| 1222 | !, | |
| 1223 | % TO DO: also retractall in other places | |
| 1224 | %print(reloading(SavedForwardHistory)),nl, | |
| 1225 | retractall(forward_history(_)), | |
| 1226 | assertz(forward_history(SavedForwardHistory)). | |
| 1227 | tcltk_try_reload. | |
| 1228 | ||
| 1229 | ||
| 1230 | % go forward while possible | |
| 1231 | tcltk_fast_forward :- tcltk_can_forward,!, tcltk_forward, | |
| 1232 | current_state_id(CurID), | |
| 1233 | compute_state_information_if_necessary(CurID), | |
| 1234 | tcltk_fast_forward. | |
| 1235 | tcltk_fast_forward. | |
| 1236 | ||
| 1237 | tcltk_can_forward :- forward_history([_|_]). | |
| 1238 | tcltk_can_forward(Len) :- forward_history(His), length(His,Len), Len>0. | |
| 1239 | ||
| 1240 | ||
| 1241 | tcltk_forward(N) :- N =< 0, !. | |
| 1242 | tcltk_forward(N) :- % TO DO: more efficient version | |
| 1243 | tcltk_forward, N1 is N-1, tcltk_forward(N1). | |
| 1244 | ||
| 1245 | ||
| 1246 | tcltk_forward :- \+ tcltk_can_forward,!, | |
| 1247 | print_message('Cannot go forward'),fail. | |
| 1248 | tcltk_forward :- | |
| 1249 | retract(forward_history([forward(FwdID,LastTraceH)|FwdHist])), | |
| 1250 | retract(history(EHist)), | |
| 1251 | retract(current_state_id(CurID)),!, | |
| 1252 | go_forward(FwdID,LastTraceH,FwdHist,CurID,EHist). | |
| 1253 | go_forward('$UNKNOWN',ActionAsTerm,FwdHist,CurID,EHist) :- | |
| 1254 | transition(CurID,ActionAsTerm,TransitionID,FwdID),!, | |
| 1255 | %print(found(CurID,ActionAsTerm,TransitionID,FwdID)),nl, | |
| 1256 | go_forward(FwdID,TransitionID,FwdHist,CurID,EHist). | |
| 1257 | % TO DO: try and execute by predicate in case max_reached is true ! | |
| 1258 | go_forward('$UNKNOWN',ActionAsTerm,FwdHist,CurID,EHist) :- | |
| 1259 | is_initialisation_op(ActionAsTerm), | |
| 1260 | % maybe PROPERTIES/INITIALISATION has changed; try and replay with other values | |
| 1261 | transition(CurID,ActionAsTerm2,TransitionID,FwdID), | |
| 1262 | is_initialisation_op(ActionAsTerm2), | |
| 1263 | !, | |
| 1264 | %print(found(CurID,ActionAsTerm,TransitionID,FwdID)),nl, | |
| 1265 | translate_event(ActionAsTerm,Action), | |
| 1266 | format('Could not replay ~w.~nUsing other possible transition instead.~n',[Action]), | |
| 1267 | go_forward(FwdID,TransitionID,FwdHist,CurID,EHist). | |
| 1268 | go_forward('$UNKNOWN',ActionAsTerm,_FwdHist,CurID,EHist) :- !, | |
| 1269 | assertz(forward_history([])), | |
| 1270 | assertz(history(EHist)), | |
| 1271 | assertz(current_state_id(CurID)), | |
| 1272 | translate_event(ActionAsTerm,Action), | |
| 1273 | add_error(tcltk_forward,'Cannot replay step after reload: ',Action). | |
| 1274 | go_forward(FwdID,LastTraceH,FwdHist,CurID,EHist) :- | |
| 1275 | assertz(forward_history(FwdHist)), | |
| 1276 | assertz(history([CurID|EHist])), | |
| 1277 | add_to_op_trace_ids(LastTraceH), | |
| 1278 | assertz(current_state_id(FwdID)), | |
| 1279 | re_execute_transition_if_necessary(CurID,LastTraceH,FwdID). | |
| 1280 | %visited_expression(FwdID,FwdExpr,FwdBody). | |
| 1281 | ||
| 1282 | is_initialisation_op(Op) :- | |
| 1283 | (functor(Op,'$setup_constants',_) ; functor(Op,'$partial_setup_constants',_) | |
| 1284 | ; functor(Op,'$initialise_machine',_)). | |
| 1285 | ||
| 1286 | % re-execute operation with side-effects if necessary and if preference set | |
| 1287 | % TO DO: tie into tcltk_perform so that not only the forward button but also double click | |
| 1288 | % in operations pane works | |
| 1289 | re_execute_transition_if_necessary(FromID,TransitionID,ToID) :- | |
| 1290 | b_or_z_mode, | |
| 1291 | get_preference(re_execute_operations_with_side_effects,true), | |
| 1292 | bmachine_construction:external_procedure_used(_), % TO DO: check if operation itself has side-effects | |
| 1293 | !, | |
| 1294 | (re_execute_transition(FromID,TransitionID,ToID) | |
| 1295 | -> true | |
| 1296 | ; add_error(tcltk_forward,'Could not re-execute operation: ',TransitionID)). | |
| 1297 | re_execute_transition_if_necessary(_,_,_). | |
| 1298 | ||
| 1299 | re_execute_transition(FromID,TransitionID,ToID) :- | |
| 1300 | transition(FromID,ActionTerm,TransitionID,ToID), | |
| 1301 | %%print(trans(ActionTerm)),nl, | |
| 1302 | get_operation_name(ActionTerm,OpName), | |
| 1303 | debug_println(9,re_executing_operation(OpName,FromID,TransitionID,ToID)), | |
| 1304 | visited_expression(FromID,InState), | |
| 1305 | specfile:b_trans(InState,OpName,ActionTerm,_NewState,_TransInfo), | |
| 1306 | debug_println(9,re_executed(OpName)). | |
| 1307 | ||
| 1308 | % a version of tcltk_perform_action_term which can be given only the String (e.g., for trace checking) | |
| 1309 | tcltk_perform_action_string(ActionString,ActionAsTerm,NewID) :- | |
| 1310 | current_state_id(CurID), | |
| 1311 | transition(CurID,ActionAsTerm,_,NewID), | |
| 1312 | translate_event_with_src_and_target_id(ActionAsTerm,CurID,NewID,ActionString), | |
| 1313 | tcltk_goto_state(ActionAsTerm,NewID). | |
| 1314 | % translate_event_with_limit(ActionAsTerm,5000,ActionString). % should use same limit as below; otherwise trace checking will fail; ideally we should check ActionString is prefix | |
| 1315 | %translate_event(ActionAsTerm,ActionString). | |
| 1316 | ||
| 1317 | % perform the Action with term ActionAsTerm leading to new state NewID | |
| 1318 | tcltk_perform_action_term(ActionAsTerm,NewID) :- %print(tcltk_perform_action_term(Action,ActionAsTerm,NewID)),nl, | |
| 1319 | (var(ActionAsTerm) | |
| 1320 | -> add_internal_error('Illegal call: ',tcltk_perform_action_term(ActionAsTerm,NewID)) ; true), | |
| 1321 | tcltk_goto_state(ActionAsTerm,NewID). | |
| 1322 | ||
| 1323 | /* allows one to execute an action in term form, from the current state: */ | |
| 1324 | %tcltk_perform_action(T,Cur) :- print_message(perf(T,Cur)),fail. | |
| 1325 | ||
| 1326 | tcltk_perform_action(ActionAsTerm,NewID) :- | |
| 1327 | current_state_id(CurID), | |
| 1328 | tcltk_perform_action(CurID,ActionAsTerm,NewID). | |
| 1329 | tcltk_perform_action(CurID,ActionAsTerm,NewID) :- | |
| 1330 | tcltk_perform_action(CurID,ActionAsTerm,NewID,_). | |
| 1331 | tcltk_perform_action(CurID,ActionAsTerm,TransitionID,NewStateID) :- | |
| 1332 | transition(CurID,ActionAsTerm,TransitionID,NewStateID), | |
| 1333 | tcltk_goto_state(ActionAsTerm,NewStateID). | |
| 1334 | ||
| 1335 | tcltk_no_constants_or_no_inititalisation_found :- | |
| 1336 | current_state_id(CurID), | |
| 1337 | (CurID=root ; is_concrete_constants_state_id(CurID)), | |
| 1338 | \+ candidate_setup_constants_or_init(CurID,_), % no additional unexplored candidates | |
| 1339 | current_options([]). | |
| 1340 | ||
| 1341 | ||
| 1342 | ||
| 1343 | /* ------------ */ | |
| 1344 | /* tcltk_open/1 */ | |
| 1345 | /* ------------ */ | |
| 1346 | ||
| 1347 | ||
| 1348 | %prolog_check_load_errors :- | |
| 1349 | % (tcltk_find_untyped_consts(ErrRes) | |
| 1350 | % -> add_error(prolog_open,'These constants were not given a proper type:', ErrRes) | |
| 1351 | % ; true), | |
| 1352 | % (tcltk_find_untyped_vars(ErrRes) | |
| 1353 | % -> add_error(prolog_open,'These variables were not given a proper type:', ErrRes) | |
| 1354 | % ; true). | |
| 1355 | ||
| 1356 | tcltk_open_b_file_for_minor_mode(File,Minor) :- tcltk_open_b_file(File), | |
| 1357 | set_animation_minor_mode(Minor). | |
| 1358 | ||
| 1359 | tcltk_open_b_file(File) :- | |
| 1360 | tcltk_clear_machine, | |
| 1361 | set_animation_mode(b), | |
| 1362 | print_message(loading_b_file(File)),flush_output, | |
| 1363 | set_currently_opening_file(File), | |
| 1364 | % to do: b_load_machine_probfile | |
| 1365 | (b_load_aux(File) | |
| 1366 | -> print_message(loaded), | |
| 1367 | set_currently_opened_b_file(File) | |
| 1368 | ; tcltk_set_failed_to_open_file(File), | |
| 1369 | fail | |
| 1370 | ). | |
| 1371 | ||
| 1372 | tcltk_set_failed_to_open_file(File) :- | |
| 1373 | set_failed_to_open_file(File), | |
| 1374 | copy_current_errors_to_state(root,loading_context(File)). | |
| 1375 | ||
| 1376 | :- use_module(probsrc(bmachine), [b_load_machine_from_file/1,b_load_machine_probfile/1]). | |
| 1377 | :- use_module(tools,[get_filename_extension/2]). | |
| 1378 | b_load_aux(File) :- get_filename_extension(File,'prob'),!, | |
| 1379 | b_load_machine_probfile(File). | |
| 1380 | b_load_aux(File) :- | |
| 1381 | b_load_machine_from_file(File). | |
| 1382 | ||
| 1383 | :- use_module(xtl_interface,[open_xtl_file/1]). | |
| 1384 | tcltk_open_xtl_file(File) :- % TODO: redundant wrt load_xtl_spec_from_prolog_file | |
| 1385 | tcltk_clear_machine, | |
| 1386 | set_animation_mode(xtl), | |
| 1387 | set_currently_opening_file(File), | |
| 1388 | (open_xtl_file(File) | |
| 1389 | -> set_currently_opened_file(File) | |
| 1390 | ; tcltk_set_failed_to_open_file(File), fail). | |
| 1391 | ||
| 1392 | ||
| 1393 | tcltk_open_cspm_file(File) :- | |
| 1394 | tcltk_clear_machine, | |
| 1395 | set_animation_mode(cspm), | |
| 1396 | set_currently_opening_file(File), | |
| 1397 | (xtl_interface:open_cspm_file(File) | |
| 1398 | -> set_currently_opened_file(File) | |
| 1399 | ; tcltk_set_failed_to_open_file(File), fail). | |
| 1400 | ||
| 1401 | :- use_module(xtl_interface). | |
| 1402 | %tcltk_open_promela_file(File) :- | |
| 1403 | % tcltk_clear_machine, | |
| 1404 | % set_animation_mode(promela), set_currently_opening_file(File), | |
| 1405 | % xtl_interface:open_promela_file(File), set_currently_opened_file(File). | |
| 1406 | ||
| 1407 | % disabled because Java parser seems broken | |
| 1408 | %tcltk_open_smv_file(File) :- | |
| 1409 | % tcltk_clear_machine, | |
| 1410 | % set_animation_mode(smv), set_currently_opening_file(File), | |
| 1411 | % xtl_interface:open_smv_file(File), set_currently_opened_file(File). | |
| 1412 | ||
| 1413 | :- use_module(specfile,[type_check_csp_and_b/0]). | |
| 1414 | :- use_module(library(file_systems),[file_exists/1,delete_file/1]). | |
| 1415 | ||
| 1416 | tcltk_add_csp_file(File) :- | |
| 1417 | \+ file_exists(File),!, | |
| 1418 | add_error(csp_guide,'CSP guide file does not exist:',File). | |
| 1419 | tcltk_add_csp_file(File) :- | |
| 1420 | unset_animation_minor_modes(L), % we could be in z or tla or eventb mode | |
| 1421 | set_animation_mode(csp_and_b), | |
| 1422 | reset_animation_minor_modes(L), | |
| 1423 | xtl_interface:open_cspm_file(File), | |
| 1424 | notify_change_of_animation_mode, | |
| 1425 | debug_format(19,'Added csp-guide file ~w~n',[File]), | |
| 1426 | type_check_csp_and_b. | |
| 1427 | ||
| 1428 | notify_change_of_animation_mode :- | |
| 1429 | announce_event(change_of_animation_mode). | |
| 1430 | % clear_applicable_flag. % no done via event handling | |
| 1431 | ||
| 1432 | ||
| 1433 | tcltk_open_z_file(File) :- | |
| 1434 | tcltk_clear_machine, | |
| 1435 | tcltk_open_z_file2(File). | |
| 1436 | tcltk_open_z_file2(File) :- | |
| 1437 | set_currently_opening_file(File), | |
| 1438 | open_proz_file(File,BMachine), | |
| 1439 | set_animation_mode(b), set_animation_minor_mode(z), | |
| 1440 | b_set_typed_machine(BMachine,File), | |
| 1441 | !, | |
| 1442 | set_currently_opened_b_file(File). | |
| 1443 | tcltk_open_z_file2(File) :- tcltk_set_failed_to_open_file(File),fail. | |
| 1444 | ||
| 1445 | :- use_module(parsercall,[call_fuzz_parser/2]). | |
| 1446 | tcltk_open_z_tex_file(TexFile) :- | |
| 1447 | tcltk_clear_machine, | |
| 1448 | call_fuzz_parser(TexFile,FuzzFile), | |
| 1449 | tcltk_open_z_file2(FuzzFile). | |
| 1450 | ||
| 1451 | ||
| 1452 | :- use_module(eclipse_interface,[load_eventb_file/1]). | |
| 1453 | tcltk_load_packaged_eventb_file(File) :- | |
| 1454 | tcltk_clear_machine, | |
| 1455 | load_eventb_file(File). | |
| 1456 | ||
| 1457 | :- use_module(eclipse_interface,[load_cnf_file/2]). | |
| 1458 | tcltk_load_cnf_file(File) :- | |
| 1459 | tcltk_clear_machine, | |
| 1460 | load_cnf_file(File,[]). | |
| 1461 | ||
| 1462 | :- use_module(parsercall,[call_alloy2pl_parser/2]). | |
| 1463 | :- use_module(probsrc('alloy2b/alloy2b')). | |
| 1464 | tcltk_open_alloy_file(AlloyFile) :- | |
| 1465 | tcltk_clear_machine, | |
| 1466 | start_ms_timer(T1), | |
| 1467 | formatsilent('Parsing Alloy file: ~w~n',[AlloyFile]), | |
| 1468 | set_currently_opening_file(AlloyFile), | |
| 1469 | call_alloy2pl_parser(AlloyFile,PrologFile), | |
| 1470 | (silent_mode(off) -> stop_ms_walltimer_with_msg(T1,'parsing and type checking: ') ; true), | |
| 1471 | %printsilent(generated_prolog_ast(PrologFile)),nls, | |
| 1472 | start_ms_timer(T2), | |
| 1473 | ( load_alloy_ast_prolog_file(PrologFile) | |
| 1474 | -> true | |
| 1475 | ; delete_file(PrologFile), % delete parsed Prolog file if model couldn't be loaded | |
| 1476 | fail % since it's potentially empty due to the failure | |
| 1477 | ), | |
| 1478 | !, | |
| 1479 | (silent_mode(off) -> stop_ms_walltimer_with_msg(T2,'loading and translation to B: ') ; true), | |
| 1480 | set_currently_opened_b_file(AlloyFile). | |
| 1481 | tcltk_open_alloy_file(AlloyFile) :- tcltk_set_failed_to_open_file(AlloyFile),fail. | |
| 1482 | ||
| 1483 | ||
| 1484 | tcltk_open_alloy_prolog_ast_file(AlloyPrologFile) :- | |
| 1485 | tcltk_clear_machine, | |
| 1486 | start_ms_timer(T2), | |
| 1487 | load_alloy_ast_prolog_file(AlloyPrologFile), | |
| 1488 | !, | |
| 1489 | (silent_mode(off) -> stop_ms_walltimer_with_msg(T2,'loading B translation of Alloy: ') ; true), | |
| 1490 | set_currently_opened_b_file(AlloyPrologFile). | |
| 1491 | ||
| 1492 | %% tcltk_load_alloy_cmd_in_current_translation(+CmdName). | |
| 1493 | tcltk_load_alloy_cmd_in_current_translation(CmdName) :- | |
| 1494 | alloy2b:load_command_in_current_translation(CmdName). | |
| 1495 | ||
| 1496 | %% tcltk_get_alloy_cmd_names(-CmdNames). | |
| 1497 | tcltk_get_alloy_cmd_names(CmdNames) :- | |
| 1498 | alloy2b:get_command_names(CmdNames). | |
| 1499 | ||
| 1500 | %% tcltk_verify_alloy_cmd(+CmdName, +SolverName, -CmdIsValid, -IsCheckCmd). | |
| 1501 | tcltk_verify_alloy_cmd(CmdName, SolverName, CmdIsValid, IsCheckCmd) :- | |
| 1502 | verify_alloy_command(CmdName, SolverName, CmdIsValid, IsCheckCmd, Res), | |
| 1503 | ( Res = solution(Bindings) | |
| 1504 | -> bindings_to_state(Bindings, State), | |
| 1505 | tcltk_add_cbc_state(State, CmdName) | |
| 1506 | ; true | |
| 1507 | ). | |
| 1508 | ||
| 1509 | bindings_to_state([], []). | |
| 1510 | bindings_to_state([Binding|T], [Bind|NT]) :- | |
| 1511 | (Binding = binding(Id,Val,_); Binding = bind(Id,Val)), | |
| 1512 | Bind = bind(Id,Val), | |
| 1513 | bindings_to_state(T, NT). | |
| 1514 | ||
| 1515 | /* --------------------------------------------------------------------- */ | |
| 1516 | ||
| 1517 | tcltk_exists_an_open_node :- | |
| 1518 | not_all_transitions_added(_) ; not_interesting(_). | |
| 1519 | tcltk_goto_an_open_node :- | |
| 1520 | (not_all_transitions_added(ID) ; not_interesting(ID)),!, | |
| 1521 | tcltk_goto_state(find_open_node,ID). | |
| 1522 | tcltk_goto_max_reached_node :- | |
| 1523 | (max_reached_for_node(ID) ; time_out_for_node(ID)),!, | |
| 1524 | tcltk_execute_trace_to_node(ID). | |
| 1525 | tcltk_goto_timeout_node :- | |
| 1526 | time_out_for_node(ID),!, | |
| 1527 | tcltk_execute_trace_to_node(ID). | |
| 1528 | % tcltk_goto_state(find_max_reached_node,ID). | |
| 1529 | ||
| 1530 | tcltk_goto_an_invariant_violation :- | |
| 1531 | invariant_violated(ID),!, | |
| 1532 | tcltk_goto_state(find_inv_violation,ID). | |
| 1533 | ||
| 1534 | ||
| 1535 | tcltk_goto_node_with_id(ToID) :- | |
| 1536 | current_state_id(ToID),!. | |
| 1537 | tcltk_goto_node_with_id(ID) :- | |
| 1538 | visited_expression_id(ID), | |
| 1539 | tcltk_execute_trace_to_node(ID). | |
| 1540 | ||
| 1541 | tcltk_try_goto_node_with_id(ID) :- | |
| 1542 | (tcltk_goto_node_with_id(ID) -> true | |
| 1543 | ; add_internal_error('Call failed:',tcltk_goto_node_with_id(ID))). | |
| 1544 | ||
| 1545 | /* --------------------------------------------------------------------- */ | |
| 1546 | ||
| 1547 | % TO DO: clean up and move into model_checker module | |
| 1548 | ||
| 1549 | tcltk_state_space_only_has_root_node :- transition(root,_,ID), | |
| 1550 | \+ not_all_transitions_added(ID),!,fail. | |
| 1551 | tcltk_state_space_only_has_root_node. | |
| 1552 | ||
| 1553 | tcltk_search_among_existing_nodes(TclTkRes,FindDeadlocks,FindInvViolations, | |
| 1554 | FindGoal,FindAssViolations,FindStateErrors) :- | |
| 1555 | search_among_existing_nodes(Res,FindDeadlocks,FindInvViolations, | |
| 1556 | FindGoal,FindAssViolations,FindStateErrors), | |
| 1557 | translate_error_for_tclk(Res,TclTkRes). | |
| 1558 | ||
| 1559 | % if tcltk_state_space_only_has_root_node is true: then we should call search_among_existing_nodes before doing open_search to ensure that we uncover state_errors in the root node | |
| 1560 | % TODO: process mc_continue_after_error preference | |
| 1561 | search_among_existing_nodes(invariant_violation,_FindDeadlocks,FindInvViolations, | |
| 1562 | _FindGoal,_FindAssViolations,_FindStateErrors) :- | |
| 1563 | (get_state_space_stats(_,_,PrN), PrN>100 | |
| 1564 | -> print_message('Search Among Processed Nodes'), print_message(number_of_nodes(PrN)) ; true), | |
| 1565 | FindInvViolations=1, | |
| 1566 | (invariant_violated(ResID) -> true | |
| 1567 | ; find_invariant_violation_among_not_checked_nodes(ResID)), | |
| 1568 | tcltk_execute_trace_to_node(ResID). | |
| 1569 | search_among_existing_nodes(Error,_FindDeadlocks,FindInvViolations, | |
| 1570 | _FindGoal,_FindAssViolations,_FindStateErrors) :- | |
| 1571 | FindInvViolations=1, | |
| 1572 | find_xtl_csp_invariant_violation_among_all_existing_nodes(ResID,Error), % could be xtl_error | |
| 1573 | tcltk_execute_trace_to_node(ResID). | |
| 1574 | search_among_existing_nodes(DEADLOCK,FindDeadlocks,_,_,_,_) :- | |
| 1575 | FindDeadlocks=1, | |
| 1576 | visited_expression_id(ResID), | |
| 1577 | transitions_computed_for_node(ResID), | |
| 1578 | is_deadlocked(ResID), | |
| 1579 | (time_out_for_node(ResID) | |
| 1580 | -> DEADLOCK = possible_deadlock_timeout | |
| 1581 | ; get_preference(store_only_one_incoming_transition,true) -> DEADLOCK = possible_deadlock | |
| 1582 | ; DEADLOCK = deadlock), | |
| 1583 | print_message(deadlock_among_existing_nodes(ResID)), | |
| 1584 | tcltk_execute_trace_to_node(ResID). | |
| 1585 | search_among_existing_nodes(goal_found,_,_,FindGoal,_,_) :- | |
| 1586 | FindGoal=1, | |
| 1587 | %visited_expression(ResID,_CurState), | |
| 1588 | %\+(not_all_transitions_added(ResID)), % if commented out: will also look at open nodes | |
| 1589 | node_satisfies_goal(ResID), | |
| 1590 | tcltk_execute_trace_to_node(ResID). | |
| 1591 | search_among_existing_nodes(assertion_violation,_,_,_,FindAssViolations,_) :- | |
| 1592 | FindAssViolations=1, | |
| 1593 | b_machine_has_assertions, | |
| 1594 | visited_expression(ResID,CurState), | |
| 1595 | transitions_computed_for_node(ResID), | |
| 1596 | state_violates_assertions(ResID,CurState), | |
| 1597 | tcltk_execute_trace_to_node(ResID). | |
| 1598 | search_among_existing_nodes(ERR,_,_,_,_,FindStateErrors) :- FindStateErrors=1, | |
| 1599 | state_space:state_error(ResID,_,Error), Error \== invariant_violated, | |
| 1600 | (Error = abort_error(ERR,_,_,_) -> true ; ERR = state_error(Error)), | |
| 1601 | tcltk_execute_trace_to_node(ResID). | |
| 1602 | search_among_existing_nodes(all,_,_,_,_,_). | |
| 1603 | ||
| 1604 | ||
| 1605 | compute_all_transitions_if_necessary :- | |
| 1606 | current_state_id(CurID), | |
| 1607 | compute_all_transitions_if_necessary(CurID,false). | |
| 1608 | :- public compute_all_transitions_if_necessary/1. | |
| 1609 | compute_all_transitions_if_necessary(CurID) :- | |
| 1610 | compute_all_transitions_if_necessary(CurID,false). | |
| 1611 | ||
| 1612 | compute_all_transitions_if_necessary(CurID,CheckInvariant) :- | |
| 1613 | (retract_open_node(CurID) % will assert not_invariant_checked | |
| 1614 | -> set_context_state(CurID), | |
| 1615 | % first check invariant, relevant if we want to use specialized_inv proof information | |
| 1616 | visited_expression(CurID,State), | |
| 1617 | % TO DO: this does not expand concrete_constants: the expansion may be done twice below: | |
| 1618 | % once for compute_invariant (corresponds_to_b...) and once for compute_all_transitions (prepare_state_for_specfile_trans) | |
| 1619 | prepare_state_for_specfile_trans(State,CurID,PreparedState), | |
| 1620 | (CheckInvariant==true | |
| 1621 | -> compute_invariant_if_necessary_and_requested(CurID,PreparedState) ; true), | |
| 1622 | compute_all_transitions(CurID,PreparedState), | |
| 1623 | clear_context_state | |
| 1624 | ; true). | |
| 1625 | %compute_all_transitions_if_necessary(CurID,CurState) :- | |
| 1626 | % ((not_all_transitions_added(CurID);not_interesting(CurID)) | |
| 1627 | % -> compute_all_transitions(CurID,CurState) ; true). | |
| 1628 | ||
| 1629 | ||
| 1630 | compute_invariant_if_necessary_and_requested(ID,State) :- | |
| 1631 | enter_new_error_scope(ErrScID,compute_invariant_if_necessary_and_requested), % here we setup a new error scope; see comment for force_check_invariantKO below | |
| 1632 | compute_invariant_if_necessary(ID,State), | |
| 1633 | exit_error_scope(ErrScID,_ErrOcc,compute_invariant_if_necessary_and_requested). % should we do something with error occured result ? | |
| 1634 | ||
| 1635 | compute_invariant_if_necessary(ID,State) :- | |
| 1636 | animation_mode(MODE),compute_invariant_if_necessary(ID,State,MODE). | |
| 1637 | compute_invariant_if_necessary(ID,State,MODE) :- | |
| 1638 | ( check_invariantKO(MODE,ID,State) -> true ; true). | |
| 1639 | ||
| 1640 | check_invariantKO(ID,State) :- | |
| 1641 | animation_mode(MODE),check_invariantKO(MODE,ID,State). | |
| 1642 | check_invariantKO(b,ID,State) :- | |
| 1643 | check_invariantKO2(ID,State). | |
| 1644 | check_invariantKO(csp_and_b,ID,State) :- | |
| 1645 | check_invariantKO2(ID,State). | |
| 1646 | % for XTL we do not use not_invariant_checked/1 facts; one should call xtl_invariant_violated/1 | |
| 1647 | ||
| 1648 | % check invariant for B state | |
| 1649 | check_invariantKO2(ID,_) :- invariant_violated(ID),!. | |
| 1650 | check_invariantKO2(ID,CurState) :- | |
| 1651 | set_invariant_checked(ID), % only succeeds if we haven't checked invariant for ID yet | |
| 1652 | % print(check_inv(ID)),nl, | |
| 1653 | state_corresponds_to_initialised_b_machine(CurState), | |
| 1654 | ( preferences:preference(do_invariant_checking,false) -> assertz(not_invariant_checked(ID)) | |
| 1655 | ; force_check_invariantKO(ID,CurState)). | |
| 1656 | ||
| 1657 | ||
| 1658 | force_check_invariantKO(ID,CurBState) :- | |
| 1659 | % Note: this checks the invariant without setting up a new error scope | |
| 1660 | % (Reason: in the model checker it would be relatively expensive to set up an error scope for each state | |
| 1661 | % the model checker stops anyway when the first error is found and then exits its error scope) | |
| 1662 | catch_clpfd_overflow_call_for_state(ID, 'checking invariants', | |
| 1663 | b_state_violates_invariant(ID,CurBState),true) -> | |
| 1664 | %(b_state_violates_invariant(ID,CurBState) -> | |
| 1665 | set_invariant_violated(ID). | |
| 1666 | % TO DO ?: call state_satisfies_negation_of_invariant if double_evaluation_when_analysing is true ? | |
| 1667 | ||
| 1668 | % try and find an invariant violation among those nodes that have not yet been checked | |
| 1669 | find_invariant_violation_among_not_checked_nodes(ID) :- | |
| 1670 | retract(not_invariant_checked(ID)), %print(checking_invariant(ID)),nl, | |
| 1671 | visited_expression(ID,State), | |
| 1672 | state_corresponds_to_initialised_b_machine(State), | |
| 1673 | prepare_state_for_specfile_trans(State,ID,CurBState), | |
| 1674 | force_check_invariantKO(ID,CurBState). | |
| 1675 | ||
| 1676 | find_xtl_csp_invariant_violation_among_all_existing_nodes(ID,Error) :- | |
| 1677 | animation_mode(MODE), | |
| 1678 | (MODE=xtl ; MODE=csp), % invariant violations not stored, hence we need to re-check every node | |
| 1679 | visited_expression(ID,State), | |
| 1680 | find_invariant_error(MODE,ID,State,Error). % csp_error or xtl_error | |
| 1681 | ||
| 1682 | :- use_module(probporsrc(ample_sets),[compute_ample_set2/3]). | |
| 1683 | % computing ample sets (model_checker.pl) | |
| 1684 | compute_ample_set(CurID,CurState,POROptions) :- | |
| 1685 | catch_clpfd_overflow_call_for_state(CurID,'computing ample sets for POR', | |
| 1686 | compute_ample_set2(CurID,CurState,POROptions),clear_context_state). | |
| 1687 | ||
| 1688 | ||
| 1689 | %compute_all_transitions(CurID,CurState) :- get_preference(use_clpfd_solver,false),!, | |
| 1690 | % compute_all_transitions2(CurID,CurState). % in principle this overflow cannot/should not happen with CLPFD FALSE | |
| 1691 | % but no performance benefit can be measured by removing the catch | |
| 1692 | compute_all_transitions(CurID,CurState) :- | |
| 1693 | catch_clpfd_overflow_call_for_state(CurID,'computing all enabled transitions', | |
| 1694 | compute_all_transitions2(CurID,CurState),clear_context_state). | |
| 1695 | ||
| 1696 | ||
| 1697 | %catch_clpfd_overflow_call_for_state(_CurID, Call,_ExtraCleanUpCode) :- | |
| 1698 | % preferences:preference(use_clpfd_solver,false),!, % Overflow should not occur | |
| 1699 | % call(Call). | |
| 1700 | :- use_module(clpfd_interface,[catch_clpfd_overflow_call2/2]). | |
| 1701 | catch_clpfd_overflow_call_for_state(CurID, Context, Call,ExtraCleanUpCode) :- | |
| 1702 | catch_clpfd_overflow_call2(Call, | |
| 1703 | ( store_state_error(CurID,clpfd_overflow_error(Context),_), | |
| 1704 | call(ExtraCleanUpCode)) ). | |
| 1705 | ||
| 1706 | ||
| 1707 | ||
| 1708 | ||
| 1709 | :- use_module(probsrc(succeed_max),[reset_max_reached/0,max_reached/0, max_reached/1]). | |
| 1710 | compute_all_transitions2(CurID,CurState) :- /* compute all outgoing transitions for a given node */ | |
| 1711 | % set_context_state(CurID), % error_context is set for each operation below anyway. | |
| 1712 | reset_max_reached, | |
| 1713 | prepare_state_for_specfile_trans(CurState,CurID,PreparedCurState), % will perform unpacking of constants just once, for example | |
| 1714 | ((time_out_preference_disabled % e.g., when using probcli -disable_time_out | |
| 1715 | ; use_no_timeout(CurID)) | |
| 1716 | -> add_transitions_fail_loop(CurID,PreparedCurState) | |
| 1717 | ; preferences:preference(time_out,CurTO), | |
| 1718 | add_transitions__with_timeout_fail_loop(CurID,PreparedCurState,CurTO) | |
| 1719 | ), | |
| 1720 | add_partial_transitions(CurID,PreparedCurState), % also copies unsat component infos | |
| 1721 | (max_reached -> assert_max_reached_for_node(CurID),MaxReached=true ; MaxReached=false), | |
| 1722 | % TO DO: use max_reached(OpID) | |
| 1723 | (CurID==root -> save_constants(MaxReached) ; add_new_transitions_to_cache(CurID)) | |
| 1724 | . %,clear_context_state. | |
| 1725 | ||
| 1726 | :- use_module(error_manager,[get_virtual_time_out_from_exception/2]). % used by time_out_with_enum_warning_for_findall | |
| 1727 | % loop to compute successor states without a time_out | |
| 1728 | add_transitions_fail_loop(CurID,CurState) :- | |
| 1729 | catch( | |
| 1730 | add_transitions_fail_loop2(CurID,CurState,TimeOutRes), | |
| 1731 | Exc, | |
| 1732 | get_virtual_time_out_from_exception(Exc,TimeOutRes)), | |
| 1733 | (nonvar(TimeOutRes), | |
| 1734 | (TimeOutRes=operation_time_out(Op,TimeOutRes2) | |
| 1735 | -> assert_time_out_for_node(CurID,Op,TimeOutRes2) | |
| 1736 | ; assert_time_out_for_node(CurID,'unspecified_operation',TimeOutRes)) | |
| 1737 | ; true). | |
| 1738 | ||
| 1739 | add_transitions_fail_loop2(CurID,CurState,_) :- | |
| 1740 | possible_trans_name_for_successors(CurState,ActionName), | |
| 1741 | % we could check pge info here (e.g., store one Predecessor ID and look if ActionName can be enabled after) | |
| 1742 | set_error_context(operation(ActionName,CurID)), | |
| 1743 | add_transition(CurID,CurState,ActionName,_NewId), % TO DO: transmit animation_mode value? | |
| 1744 | fail. | |
| 1745 | add_transitions_fail_loop2(_,_,OpTimeOutRes) :- | |
| 1746 | (enumeration_warning_occured_in_error_scope | |
| 1747 | -> (virtual_time_out_occured_in_error_scope(TimeOutRes) | |
| 1748 | -> % i.e., critical enumeration warning occurred | |
| 1749 | (get_error_context(operation(ActionName,_)) | |
| 1750 | -> OpTimeOutRes = operation_time_out(ActionName,TimeOutRes) | |
| 1751 | ; OpTimeOutRes = operation_time_out('unspecified_operation',TimeOutRes)) | |
| 1752 | ; true), | |
| 1753 | clear_enumeration_warnings | |
| 1754 | ; true % no warnings: sunshine case | |
| 1755 | ), | |
| 1756 | clear_error_context. | |
| 1757 | ||
| 1758 | possible_trans_name_for_successors(CurState,ActionName) :- | |
| 1759 | specfile_possible_trans_name_for_successors(CurState,ActionName), | |
| 1760 | (preference(store_only_one_incoming_transition,true), % SAFETY_MODEL_CHECK | |
| 1761 | nonvar(ActionName), | |
| 1762 | b_or_z_mode, | |
| 1763 | b_operation_cannot_modify_state(ActionName) % we have a skip operation | |
| 1764 | -> operation_not_yet_covered(ActionName) | |
| 1765 | % if operation covered: all we could is create a self-loop, which would not be added to the state space anyway | |
| 1766 | ; true). | |
| 1767 | ||
| 1768 | ||
| 1769 | :- use_module(library(timeout),[time_out/3]). | |
| 1770 | my_timeout_test(1000000) :- write('.'), !, my_timeout_test(0). | |
| 1771 | my_timeout_test(X) :- X1 is X+1, my_timeout_test(X1). | |
| 1772 | :- public my_timeout_test/0. | |
| 1773 | my_timeout_test :- time_out(my_timeout_test(0),500,TO), nl, | |
| 1774 | print(time_out_result(TO)),nl, TO==time_out. | |
| 1775 | :- assert_must_succeed(tcltk_interface:my_timeout_test). | |
| 1776 | ||
| 1777 | add_transitions__with_timeout_fail_loop(CurID,CurState,CurTO) :- | |
| 1778 | enter_new_error_scope(Level,add_transitions__with_timeout_fail_loop), | |
| 1779 | call_cleanup(add_transitions__with_timeout_fail_loop2(Level,CurID,CurState,CurTO), | |
| 1780 | exit_error_scope(Level,_,add_transitions__with_timeout_fail_loop)). | |
| 1781 | ||
| 1782 | % old profiler | |
| 1783 | :- use_module(runtime_profiler,[profile_failure_driven_loop/2]). | |
| 1784 | ||
| 1785 | % the loop to compute all successors of state CurID with a time-out | |
| 1786 | add_transitions__with_timeout_fail_loop2(Level,CurID,CurState,CurTO) :- % statistics(runtime,_), | |
| 1787 | % TO DO: prepare computing the state: expanding const and vars, unpacking, ... | |
| 1788 | possible_trans_name_for_successors(CurState,ActionName), | |
| 1789 | profile_failure_driven_loop(ActionName,CurID), | |
| 1790 | % Note: we enumerate possible transition names so that we can catch the time-out per name ! | |
| 1791 | % statistics(runtime,[T1,DeltaT]), print(delta_time(ActionName,DeltaT)),nl, %% | |
| 1792 | % first enumerate possible Operations/... to obtain timeout per operation/... | |
| 1793 | % TO DO: divide CurTO by number of transitions ??? | |
| 1794 | % We could also decide to have one time-out per state, only if that one is triggered move to | |
| 1795 | % finer-grained timeouts | |
| 1796 | % For probcli ../prob_examples/public_examples/B/Benchmarks/Cruise_finite1.mch --model-check, there are 35360 calls to timeout/3 (one per state the model checker reached and per transition group), with -disable-timeout none | |
| 1797 | % In SICS 4.3.5 the runtime increased from 1.480 to 2.270 seconds = 0.022 ms per timeout call | |
| 1798 | % In SICS 4.4.1 the runtime increased from 1.494 to 3.033 seconds. = 0.044 ms per timeout call. | |
| 1799 | %% statistics(runtime,[T1,_]), print(try(ActionName,T1)),nl,%% | |
| 1800 | set_error_context(operation(ActionName,CurID)), | |
| 1801 | (nonvar(ActionName),translate_operation_name(ActionName,A2), | |
| 1802 | get_specific_time_out_for_operation(A2,RealTimeOut) -> true ; RealTimeOut = CurTO), | |
| 1803 | time_out_with_enum_warning_for_findall_in_current_error_scope(Level, | |
| 1804 | (add_transition(CurID,CurState,ActionName,_NewId),fail), % fail inside meta-call; | |
| 1805 | % so that time_out is for entire add_transition loop; not just for each single solution | |
| 1806 | RealTimeOut,TimeOutRes), | |
| 1807 | %% statistics(runtime,[T2,_]), TDiff is T2-T1, print(added_transition(CurID,ActionName,TDiff,TimeOutRes)),nl, %% | |
| 1808 | %% add_transition(CurID,CurState,ActionName,_NewId) , | |
| 1809 | ((TimeOutRes==time_out ; | |
| 1810 | nonvar(TimeOutRes),TimeOutRes=virtual_time_out(_), \+ max_reached(ActionName)) | |
| 1811 | % virtual time outs not relevant if we have already stopped earlier anyway; | |
| 1812 | % TO DO: does not seem to work for INITIALISATION | |
| 1813 | -> (TimeOutRes=virtual_time_out(_) -> true | |
| 1814 | ; print_message('TIME OUT: '),print_message(CurID), | |
| 1815 | print_message(RealTimeOut),print_message(ActionName) | |
| 1816 | ), | |
| 1817 | (var(ActionName) | |
| 1818 | -> assert_time_out_for_node(CurID,'unspecified_operation',TimeOutRes) | |
| 1819 | ; assert_time_out_for_node(CurID,ActionName,TimeOutRes) % TO DO: assert info per ActionSkeleton ? | |
| 1820 | ) | |
| 1821 | ; true | |
| 1822 | ),fail. | |
| 1823 | add_transitions__with_timeout_fail_loop2(_,_,_,_) :- clear_error_context. | |
| 1824 | % statistics(runtime,[_,DeltaT]), print(delta_time(end,DeltaT)),nl. | |
| 1825 | ||
| 1826 | % compute and add transition to next states | |
| 1827 | add_transition(CurID,CurState,ActionName,NewId) :- | |
| 1828 | /* ActionName maybe pre-instantiated */ | |
| 1829 | extract_infos_from_prepared_state(CurState,PrecomputedInfos), | |
| 1830 | specfile_trans(CurState,ActionName,Act,NewExpression,TransInfo,Residue), | |
| 1831 | %% print_bt_message(specfile_trans(CurState,ActionName,Act,NewExpression,TransInfo,Residue)), %% | |
| 1832 | add_trans_id_with_infos(CurID,PrecomputedInfos,Act,NewExpression,Residue,NewId,TransInfo,_). | |
| 1833 | ||
| 1834 | :- use_module(kernel_tools,[add_call_residue_error/3]). | |
| 1835 | % after being computed, add a new transition in the state space; adding the destination state if required | |
| 1836 | add_trans_id_with_infos(CurID,PrecomputedInfos,Act,NewExpression,Residue,NewID,TransInfo,TransId) :- | |
| 1837 | (Residue=[] -> true | |
| 1838 | ; ajoin(['Prolog residue while computing transition ',Act,' in state ',CurID,':'],Msg), | |
| 1839 | add_call_residue_error(add_trans_id,Msg,Residue) | |
| 1840 | ), | |
| 1841 | add_new_transition_transid_with_infos(CurID,PrecomputedInfos,Act,NewID,NewExpression,TransInfo,TransId). | |
| 1842 | ||
| 1843 | ||
| 1844 | ||
| 1845 | add_trans_id(CurID,Act,NewExpression,NewID,TransId) :- | |
| 1846 | add_trans_id_with_infos(CurID,[],Act,NewExpression,[],NewID,[],TransId). | |
| 1847 | ||
| 1848 | add_trans_id_infos(CurID,Act,NewExpression,NewID,TransId,TransInfos) :- | |
| 1849 | add_trans_id_with_infos(CurID,[],Act,NewExpression,[],NewID,TransInfos,TransId). | |
| 1850 | ||
| 1851 | add_partial_transitions(root,CurState) :- | |
| 1852 | % for the moment root is the only state where partial transitions are computed | |
| 1853 | % note: some regular setup_constants transitions can cover partial_properties and are also partial transitions | |
| 1854 | % (but which find values for all constants) | |
| 1855 | \+ any_transition(root,_,_), | |
| 1856 | % No transition was found, we try and extract deterministic values found for constants | |
| 1857 | % and will add PARTIAL_SETUP_CONSTANTS if all constants valued or if preference allows it | |
| 1858 | partial_trans(CurState,Act,NewExpression,Residue), | |
| 1859 | add_trans_id_with_infos(root,[],Act,NewExpression,Residue,_NewID,[],_),fail. | |
| 1860 | add_partial_transitions(_CurID,_). | |
| 1861 | ||
| 1862 | /* --------------------------------------------------------------------- */ | |
| 1863 | ||
| 1864 | /* A bit like AO* algorithm: expands open nodes (i.e., states whose transitions | |
| 1865 | have not yet been computed */ | |
| 1866 | ||
| 1867 | :- use_module(model_checker). | |
| 1868 | ||
| 1869 | tcltk_model_check(Nr,TclTkRes,FindDeadlocks,FindInvViolations,FindGoal,FindAssViolations, | |
| 1870 | FindStateErrors,StopFullCoverage,PartialOrderReduction,TIMELIMIT,TotalTime) :- | |
| 1871 | statistics(walltime,[CurTime,_]), /* get current time in ms */ | |
| 1872 | LimitTime is CurTime+TIMELIMIT, | |
| 1873 | %debug_println(10,start_tcltk_model_check(Nr,TIMELIMIT)), | |
| 1874 | InspectExistingNodes = 0, | |
| 1875 | (do_model_check(Nr,_A,LimitTime,Res,FindDeadlocks,FindInvViolations,FindGoal, | |
| 1876 | FindAssViolations,FindStateErrors,StopFullCoverage, | |
| 1877 | PartialOrderReduction,InspectExistingNodes) | |
| 1878 | -> translate_error_for_tclk(Res,TclTkRes) | |
| 1879 | ; add_internal_error('Call failed: ',do_model_check(Nr,_A,LimitTime,Res,FindDeadlocks,FindInvViolations,FindGoal, | |
| 1880 | FindAssViolations,FindStateErrors,StopFullCoverage, | |
| 1881 | PartialOrderReduction,InspectExistingNodes)), | |
| 1882 | TclTkRes=error), | |
| 1883 | statistics(walltime,[CurTime2,_]), | |
| 1884 | TotalTime is CurTime2-CurTime, | |
| 1885 | debug_println(10,tcltk_model_check(Nr,TotalTime,Res)). | |
| 1886 | ||
| 1887 | translate_error_for_tclk([timeout,Nr],Res) :- !, Res=[timeout,Nr]. | |
| 1888 | translate_error_for_tclk(state_error(S),String) :- !, translate_state_err_for_tcltk(S,String). | |
| 1889 | translate_error_for_tclk(S,R) :- atomic(S),!,R=S. | |
| 1890 | translate_error_for_tclk(S,R) :- nonvar(S), add_error(translate_error_for_tclk,'Unknown Model Check result: ',S), R=unknown. | |
| 1891 | ||
| 1892 | translate_state_err_for_tcltk(abort_error(TYPE,_,_,_),ERR) :- !, ERR = TYPE. | |
| 1893 | translate_state_err_for_tcltk(eventerror(Event,Error,_),ERR) :- !, | |
| 1894 | functor(Error,F,_), | |
| 1895 | ajoin(['event_error:',Event,':',F],ERR). | |
| 1896 | translate_state_err_for_tcltk(Error,ERR) :- | |
| 1897 | functor(Error, StateError, _), atom_concat('state_error:',StateError,ERR). | |
| 1898 | ||
| 1899 | ||
| 1900 | ||
| 1901 | do_model_check(_Nr,NodesAnalysed,_LimitTime,Res,FindDeadlocks,FindInvViolations,FindGoal, | |
| 1902 | FindAssViolations,FindStateErrors,_StopFullCoverage, | |
| 1903 | _PartialOrderReduction,ForceInspectExistingNodes) :- | |
| 1904 | (tcltk_state_space_only_has_root_node -> true % Then also look at the root node | |
| 1905 | ; ForceInspectExistingNodes == 1), | |
| 1906 | search_among_existing_nodes(Res,FindDeadlocks,FindInvViolations,FindGoal, | |
| 1907 | FindAssViolations,FindStateErrors), | |
| 1908 | Res \=all, NodesAnalysed=0. | |
| 1909 | do_model_check(LimitNr,NodesAnalysed,LimitTime,Res,FindDeadlocks,FindInvViolations,FindGoal, | |
| 1910 | FindAssViolations,FindStateErrors,StopFullCoverage,PartialOrderReduction,_) :- | |
| 1911 | update_ass(FindAssViolations,FindAssViolations2), | |
| 1912 | open_search(LimitNr,NodesAnalysed,LimitTime,Res,FindDeadlocks,FindInvViolations,FindGoal, | |
| 1913 | FindAssViolations2,FindStateErrors,StopFullCoverage,PartialOrderReduction). | |
| 1914 | ||
| 1915 | update_ass(1,FindAssViol) :- \+ b_machine_has_assertions,!, % no need to check assertions | |
| 1916 | FindAssViol=0. | |
| 1917 | update_ass(X,X). | |
| 1918 | ||
| 1919 | /* --------------------------------------------------- */ | |
| 1920 | ||
| 1921 | /* constraint-based checking of refinements */ | |
| 1922 | :- use_module(symbolic_model_checker(cbc_refinement_checks), [cbc_refinement_check/2]). | |
| 1923 | tcltk_cbc_refinement_check(list(List),ErrorOccured) :- | |
| 1924 | cbc_refinement_check(List,ErrorOccured). | |
| 1925 | ||
| 1926 | /* constraint-based/model search for invariant violations */ | |
| 1927 | ||
| 1928 | :- dynamic cbc_inv_error_found/2. | |
| 1929 | ||
| 1930 | tcltk_constraint_based_check(L) :- tcltk_constraint_based_check(L,_). | |
| 1931 | tcltk_constraint_based_check(list(List),ErrorsOrTimeoutWereFound) :- | |
| 1932 | retractall(cbc_inv_error_found(_,_)), | |
| 1933 | findall(Res, (tcltk_constraint_based_check_with_timeout(OpName,ErrorDesc), | |
| 1934 | (ErrorDesc=ok -> true ; assertz(cbc_inv_error_found(OpName,ErrorDesc))), | |
| 1935 | string_concatenate(' == ',ErrorDesc,Res1), | |
| 1936 | string_concatenate(OpName,Res1,Res)), List), | |
| 1937 | %%print(list(List)),nl, %% | |
| 1938 | (cbc_inv_error_found(_,_) -> | |
| 1939 | (cbc_inv_error_found(_,X),X\=time_out | |
| 1940 | -> ErrorsOrTimeoutWereFound=true ; ErrorsOrTimeoutWereFound=time_out | |
| 1941 | ) | |
| 1942 | ; ErrorsOrTimeoutWereFound = false). | |
| 1943 | ||
| 1944 | % can also be called with uninstantiated OpName | |
| 1945 | tcltk_constraint_based_check_with_timeout(OpName,ErrorDesc) :- | |
| 1946 | preferences:get_computed_preference(debug_time_out,DebugTimeOut), | |
| 1947 | valid_operation_or_init(OpName,IOpName), | |
| 1948 | (time_out_with_enum_warning_one_solution(tcltk_constraint_based_check_op(IOpName,ErrorDesc),DebugTimeOut,TimeOutRes) | |
| 1949 | -> (is_time_out_result(TimeOutRes) | |
| 1950 | -> print_message('TIME OUT: '), print_message(OpName), print_message(DebugTimeOut), | |
| 1951 | ErrorDesc = timeout | |
| 1952 | ; true | |
| 1953 | )). | |
| 1954 | valid_operation_or_init(OpName,R) :- OpName=='@INITIALISATION',!,R='$initialise_machine'. | |
| 1955 | valid_operation_or_init(OpName,OpName) :- b_get_machine_operation(OpName,_,_,_). | |
| 1956 | valid_operation_or_init('INITIALISATION','$initialise_machine'). % used e.g. in test 1821: -cbc INITIALISATION | |
| 1957 | ||
| 1958 | tcltk_constraint_based_check_op(OpName,ErrorDesc) :- | |
| 1959 | tcltk_constraint_based_check_op(OpName,invariant,ErrorDesc). | |
| 1960 | ||
| 1961 | tcltk_constraint_based_check_op(TclOpName,InvOrAssertion,ErrorDesc) :- | |
| 1962 | adapt_tcl_operation_name(TclOpName,OpName), | |
| 1963 | tcltk_constraint_based_check_op2(OpName,InvOrAssertion,ErrorDesc). | |
| 1964 | ||
| 1965 | % code below because names with $ cause problems in Tcl with eval | |
| 1966 | adapt_tcl_operation_name(X,R) :- var(X),!,R=X. | |
| 1967 | adapt_tcl_operation_name('@PROPERTIES','$setup_constants') :- !. | |
| 1968 | adapt_tcl_operation_name('@INITIALISATION','$initialise_machine') :- !. | |
| 1969 | adapt_tcl_operation_name(X,X). | |
| 1970 | ||
| 1971 | % a version that allows either invariant or assertions check after an Operation OpName | |
| 1972 | tcltk_constraint_based_check_op2(OpName,InvOrAssertion,ErrorDesc) :- | |
| 1973 | call_cbc_command(state_model_check(OpName,InvOrAssertion,State,Operation,NewState)),!, | |
| 1974 | tcltk_add_cbc_state(State,'$JUMP'(constraint_based_check),PriorID), % will also set history | |
| 1975 | translate_event(Operation,Action), | |
| 1976 | tcltk_add_new_transition_transid(PriorID,Operation,NewID,NewState,[],TransId2), | |
| 1977 | set_current_state_id(NewID), | |
| 1978 | add_to_op_trace_ids(TransId2), | |
| 1979 | add_id_to_history(PriorID), | |
| 1980 | ajoin([InvOrAssertion,'_violated_after(',Action,')'],ErrorDesc). | |
| 1981 | tcltk_constraint_based_check_op2(_,_,'ok'). | |
| 1982 | ||
| 1983 | ||
| 1984 | % try to find constants, parameters that make a given trace feasible | |
| 1985 | tcltk_cbc_find_trace(TraceToBeFound,Res) :- | |
| 1986 | tcltk_cbc_find_trace(TraceToBeFound,'',first_solution,Res). | |
| 1987 | ||
| 1988 | %:- public tcltk_cbc_find_invariant_violation/2. | |
| 1989 | %tcltk_cbc_find_invariant_violation(TraceToBeFound,Res) :- | |
| 1990 | % tcltk_cbc_find_trace(TraceToBeFound,'#not_invariant',first_solution,Res). | |
| 1991 | % could also call tcltk_constraint_based_check_op('$initialise_machine',invariant,Res) | |
| 1992 | ||
| 1993 | tcltk_cbc_find_trace(TraceToBeFound,TargetPredString,FindAll,Res) :- | |
| 1994 | b_parse_optional_machine_predicate(TargetPredString,TargetPred), | |
| 1995 | formatsilent('Looking for solution for trace ~w~n',[TraceToBeFound]), | |
| 1996 | split_atom(TraceToBeFound,[',',';',' '],TraceAsList), | |
| 1997 | (maplist(check_valid_operation,TraceAsList) | |
| 1998 | -> start_ms_timer(Timer), | |
| 1999 | tcltk_cbc_find_trace_aux(Timer,TraceAsList,TargetPred,FindAll,Res) | |
| 2000 | ; Res = error). | |
| 2001 | tcltk_cbc_find_trace_aux(Timer,TraceAsList,TargetPred,FindAll,Res) :- | |
| 2002 | preferences:get_computed_preference(debug_time_out,DebugTimeOut), | |
| 2003 | reset_nr_cbc_sols, | |
| 2004 | time_out_with_enum_warning_one_solution( | |
| 2005 | cbc_path_solver:create_testcase_path_nondet(init,TraceAsList,TargetPred,Transitions),DebugTimeOut,TimeOutRes), | |
| 2006 | stop_ms_timer(Timer), | |
| 2007 | (is_time_out_result(TimeOutRes) | |
| 2008 | -> !, | |
| 2009 | print_message('*** TIME OUT: '), print_message(DebugTimeOut), Res = time_out | |
| 2010 | ; FindAll = findall -> inc_nr_cbc_sols, | |
| 2011 | print('% *** FOUND PATH: '), maplist(print_trans,Transitions),nl, | |
| 2012 | fail % backtrack to find further solutions | |
| 2013 | ; !,Res = ok, | |
| 2014 | print('% *** FOUND PATH: '), maplist(print_trans,Transitions),nl, | |
| 2015 | maplist(extract_trans_id,Transitions,TransIds), | |
| 2016 | set_trace_by_transition_ids(TransIds) | |
| 2017 | ). | |
| 2018 | tcltk_cbc_find_trace_aux(Timer,_TraceToBeFound,_TargetPred,findall,R) :- !, stop_ms_timer(Timer), | |
| 2019 | R=nr_cbc_sols(Res), | |
| 2020 | nr_cbc_sols(Res), | |
| 2021 | print_message('*** ALL SOLUTIONS FOUND '). | |
| 2022 | tcltk_cbc_find_trace_aux(Timer,_TraceToBeFound,_TargetPred,_FindAll,no_solution_found) :- | |
| 2023 | stop_ms_timer(Timer), | |
| 2024 | print_message('*** NO SOLUTION FOUND'),nl. | |
| 2025 | ||
| 2026 | :- dynamic nr_cbc_sols/1. | |
| 2027 | nr_cbc_sols(0). | |
| 2028 | reset_nr_cbc_sols :- retractall(nr_cbc_sols(_)), assertz(nr_cbc_sols(0)). | |
| 2029 | inc_nr_cbc_sols :- | |
| 2030 | retract(nr_cbc_sols(N)), N1 is N+1, assertz(nr_cbc_sols(N1)). | |
| 2031 | extract_trans_id( (TransId,_,_,_), TransId). | |
| 2032 | print_trans( (_,Event,_,_)) :- translate_event(Event,S), print(S), print(' '). | |
| 2033 | ||
| 2034 | :- use_module(probsrc(tools_matching), [get_possible_top_level_event_matches_msg/2]). | |
| 2035 | check_valid_operation(Op) :- | |
| 2036 | (get_possible_language_specific_top_level_event(Op,_,_) -> true | |
| 2037 | ; (get_possible_top_level_event_matches_msg(Op,FMsg) | |
| 2038 | -> ajoin(['Unknown operation/event (did you mean ',FMsg,' ?):'],Msg) | |
| 2039 | ; Msg='Unknown operation/event:' | |
| 2040 | ), | |
| 2041 | add_error(cbc_find_sequence,Msg,Op), | |
| 2042 | fail | |
| 2043 | ). | |
| 2044 | ||
| 2045 | tk_get_possible_language_specific_top_level_event(OpName,list(ResultNames),list(ParameterNames)) :- | |
| 2046 | get_possible_language_specific_top_level_event(OpName,ResultNames,ParameterNames). | |
| 2047 | ||
| 2048 | ||
| 2049 | % ------------ | |
| 2050 | ||
| 2051 | :- use_module(bsyntaxtree). | |
| 2052 | tcltk_constraint_find_valid_state_with_pred(ParameterBindList,RestPreCond,UseConstantsFromStateID) :- | |
| 2053 | parse_tclk_parameter_values_and_pred('$initialise_machine',ParameterBindList,RestPreCond,CustomPredicate), | |
| 2054 | UseInvariant=true, | |
| 2055 | call_cbc_command( | |
| 2056 | b_state_model_check:b_set_up_valid_state_with_pred(State,CustomPredicate, | |
| 2057 | UseInvariant,UseConstantsFromStateID)), | |
| 2058 | tcltk_add_cbc_state(State,find_valid_state). | |
| 2059 | tcltk_constraint_find_valid_state :- | |
| 2060 | call_cbc_command(b_set_up_valid_state(State)), | |
| 2061 | tcltk_add_cbc_state(State,find_valid_state). | |
| 2062 | ||
| 2063 | :- use_module(extrasrc(optimizing_solver),[b_set_up_maximally_valid_state/2]). | |
| 2064 | tcltk_constraint_find_maximal_valid_state :- | |
| 2065 | current_state_id(ID), | |
| 2066 | call_cbc_command(b_set_up_maximally_valid_state(ID,State)), | |
| 2067 | tcltk_add_cbc_state(State,find_maximal_valid_state). | |
| 2068 | ||
| 2069 | ||
| 2070 | tcltk_constraint_find_dynamic_assertion_violation :- | |
| 2071 | call_cbc_command(b_find_dynamic_assertion_violation(State)), | |
| 2072 | tcltk_add_cbc_state(State,cbc_dynamic_assertions_check). | |
| 2073 | ||
| 2074 | :- use_module(clpfd_interface,[catch_clpfd_overflow_call1/1]). | |
| 2075 | :- use_module(error_manager,[call_in_fresh_error_scope_for_one_solution/1]). | |
| 2076 | % catch CLPFD overflows and catch other errors | |
| 2077 | call_cbc_command(Command) :- | |
| 2078 | call_in_fresh_error_scope_for_one_solution( | |
| 2079 | (catch_clpfd_overflow_call1(Command) -> true | |
| 2080 | ; translate_events_in_current_scope_to_warnings(cbc,'Warning: '),fail | |
| 2081 | % Maybe we should raise error when Command fails and enumeration warnings are there ? | |
| 2082 | )). | |
| 2083 | ||
| 2084 | ||
| 2085 | tcltk_constraint_find_deadlock_state(Res) :- | |
| 2086 | check_we_are_in_b_mode(cbc_deadlock_freedom_check), | |
| 2087 | create_texpr(truth,pred,[],True), | |
| 2088 | call_cbc_command(cbc_deadlock_freedom_check(State,True,0)), | |
| 2089 | (State == time_out -> Res = time_out | |
| 2090 | ; tcltk_add_cbc_state(State,cbc_deadlock), Res=deadlock). | |
| 2091 | ||
| 2092 | % if Filter=1 we remove guards which are inconsitent with goal | |
| 2093 | tcltk_constraint_find_deadlock_state_with_goal(Filter,Res) :- | |
| 2094 | check_we_are_in_b_mode(cbc_deadlock_freedom_check), | |
| 2095 | (b_get_machine_goal(Goal) -> true ; create_texpr(truth,pred,[],Goal)), | |
| 2096 | call_cbc_command(cbc_deadlock_freedom_check(State,Goal,Filter)), | |
| 2097 | (State == time_out -> Res = time_out | |
| 2098 | ; tcltk_add_cbc_state(State,cbc_deadlock), Res=deadlock). | |
| 2099 | ||
| 2100 | check_we_are_in_b_mode(_) :- b_or_z_mode,!. | |
| 2101 | check_we_are_in_b_mode(Cmd) :- add_error(check_we_are_in_b_mode,'This command can only be performed in B,Z or TLA+ mode: ',Cmd),fail. | |
| 2102 | ||
| 2103 | tcltk_constraint_find_deadlock_state_with_goal(true,_Filter,Res) :- | |
| 2104 | !,tcltk_constraint_find_deadlock_state(Res). | |
| 2105 | tcltk_constraint_find_deadlock_state_with_goal(GoalPred,Filter,Res) :- | |
| 2106 | bmachine:b_set_machine_goal(GoalPred), | |
| 2107 | tcltk_constraint_find_deadlock_state_with_goal(Filter,Res). | |
| 2108 | ||
| 2109 | :- use_module(cbcsrc(enabling_analysis),[check_if_feasible_operation/5]). | |
| 2110 | tcltk_check_if_feasible_operation(OpName,UseInvariant,TimeOutFactor,Result) :- % UseInvariant currently always 1 from Tcl | |
| 2111 | check_if_feasible_operation(OpName,UseInvariant,TimeOutFactor,Result,ResultState), | |
| 2112 | tcltk_add_cbc_state(ResultState,feasibility_check(OpName)). | |
| 2113 | ||
| 2114 | % add a state found by constraint-based verification or other method that tries to jump to a state without all intermediate steps | |
| 2115 | % it will add a separate concrete_constants state if necessary | |
| 2116 | tcltk_add_cbc_state(State,OpName) :- | |
| 2117 | tcltk_add_cbc_state(State,'$JUMP'(OpName),_ToID). | |
| 2118 | ||
| 2119 | tcltk_add_cbc_state('$UNKNOWN_STATE',_,To) :- !,To=none. | |
| 2120 | tcltk_add_cbc_state(State,OpNameTerm,NewID) :- | |
| 2121 | seperate_state_into_const_and_vars(State,Constants,Variables), | |
| 2122 | !, | |
| 2123 | % store the constants separately: important for memory consumption when continuing animation/model checking | |
| 2124 | (Variables=[] -> Op='$initialise_machine' ; Op = OpNameTerm), | |
| 2125 | % if Variables are [] we simply create an initialisation transition | |
| 2126 | (Constants = [] % no need to create SETUP_CONSTANTS transition | |
| 2127 | -> (Variables = [] % probably prior state for INITIALISATION cbc check | |
| 2128 | -> NewID=root, set_cbc_state(root,[],[]) | |
| 2129 | ; FullState = Variables, | |
| 2130 | tcltk_add_new_transition_transid(root,Op,NewID,FullState,[],TransId2), | |
| 2131 | set_cbc_state(NewID,[TransId2],[root]) | |
| 2132 | ) | |
| 2133 | ; tcltk_add_new_transition_transid(root,'$setup_constants',CstID,concrete_constants(Constants),[],TransId1), | |
| 2134 | FullState = const_and_vars(CstID,Variables), | |
| 2135 | tcltk_add_new_transition_transid(CstID,Op,NewID,FullState,[],TransId2), | |
| 2136 | set_cbc_state(NewID,[TransId1,TransId2],[CstID,root]) | |
| 2137 | ). | |
| 2138 | tcltk_add_cbc_state(State,OpNameTerm,NewID) :- | |
| 2139 | tcltk_add_new_transition_transid(root,OpNameTerm,NewID,State,[],TransId), | |
| 2140 | set_cbc_state(NewID,[TransId],[root]). | |
| 2141 | ||
| 2142 | ||
| 2143 | set_cbc_state(NewID,TransIds,His) :- | |
| 2144 | set_current_state_id(NewID), | |
| 2145 | reset_op_trace_ids, | |
| 2146 | maplist(add_to_op_trace_ids,TransIds), | |
| 2147 | retractall(history(_)), | |
| 2148 | retractall(forward_history(_)), | |
| 2149 | assertz(history(His)). %, print(State),nl. | |
| 2150 | ||
| 2151 | is_constant_binding(SortedCsts,bind(ID,_)) :- | |
| 2152 | ord_member(ID,SortedCsts). | |
| 2153 | ||
| 2154 | :- use_module(bsyntaxtree, [get_texpr_ids/2]). | |
| 2155 | seperate_state_into_const_and_vars(concrete_constants(C),Constants,Variables) :- !, | |
| 2156 | Constants=C, Variables=[]. | |
| 2157 | seperate_state_into_const_and_vars(State,Constants,Variables) :- | |
| 2158 | b_get_machine_constants(TCs), get_texpr_ids(TCs,Cs), | |
| 2159 | sort(Cs,SortedCsts), | |
| 2160 | include(is_constant_binding(SortedCsts),State,Constants), | |
| 2161 | Constants \= [], | |
| 2162 | exclude(is_constant_binding(SortedCsts),State,Variables). | |
| 2163 | ||
| 2164 | ||
| 2165 | ||
| 2166 | tcltk_constraint_find_static_assertion_violation(TclResult) :- | |
| 2167 | cbc_constraint_find_static_assertion_violation(Result,[]), | |
| 2168 | functor(Result,TclResult,_). | |
| 2169 | cbc_constraint_find_static_assertion_violation(Result,Options) :- | |
| 2170 | call_cbc_command(cbc_static_assertions_check(State,Options)), | |
| 2171 | ( State = counterexample_found(CE) -> | |
| 2172 | Result = counterexample_found, | |
| 2173 | tcltk_add_cbc_state(CE,static_assertion_check) | |
| 2174 | ; | |
| 2175 | Result = State). | |
| 2176 | ||
| 2177 | /* --------------------------------------------------- */ | |
| 2178 | ||
| 2179 | ||
| 2180 | :- use_module(error_manager,[extract_all_line_col/5]). | |
| 2181 | :- use_module(probcspsrc(haskell_csp),[extract_span_from_event/4,extract_span_info/2]). | |
| 2182 | ||
| 2183 | get_source_text_positions(Event,Line,Col,EndLine,EndCol) :- | |
| 2184 | extract_span_from_action(Event,SPAN), | |
| 2185 | extract_all_line_col(SPAN,Line,Col,EndLine,EndCol). | |
| 2186 | ||
| 2187 | extract_span_from_action(Event,Span) :- csp_mode, | |
| 2188 | extract_span_from_event(Event,Span,_,_). | |
| 2189 | extract_span_from_action(Event,Pos) :- b_or_z_mode, | |
| 2190 | get_operation_name(Event,ID), | |
| 2191 | % TODO: prob_source_profiling_on SOURCE_PROFILING_INFO, add_source_location_hits | |
| 2192 | b_get_machine_operation(ID,_Res,_TParas,_Body,_OType,Pos). | |
| 2193 | ||
| 2194 | ||
| 2195 | /* -------------------------------------------------------------------- */ | |
| 2196 | ||
| 2197 | get_current_option_eventtrace(OptionNum,TraceInfo) :- | |
| 2198 | % the option number starts with 0 (coming from a TK listbox) | |
| 2199 | current_options(ActionsAndIDs), | |
| 2200 | nth0(OptionNum,ActionsAndIDs,(Id,_,_,_)), | |
| 2201 | transition_info(Id,TraceInfo), | |
| 2202 | transition_info_can_be_shown(TraceInfo),!. | |
| 2203 | ||
| 2204 | transition_info_can_be_shown(eventtrace(_)). | |
| 2205 | transition_info_can_be_shown(path(_)). | |
| 2206 | ||
| 2207 | ||
| 2208 | tcltk_has_eventtrace(OptionNum) :- | |
| 2209 | get_current_option_eventtrace(OptionNum,_Trace). | |
| 2210 | ||
| 2211 | tcltk_show_eventtrace(OptionNum,Desc) :- | |
| 2212 | get_current_option_eventtrace(OptionNum,Trace), | |
| 2213 | explain_transition_info(Trace,Desc). | |
| 2214 | ||
| 2215 | ||
| 2216 | ||
| 2217 | /* --------------------------------------------------- */ | |
| 2218 | ||
| 2219 | :- use_module(prob2_interface,[execute_model/5]). | |
| 2220 | ||
| 2221 | tcltk_execute_model(MaxNrSteps,ExecutedSteps,Result) :- | |
| 2222 | current_state_id(CurID), | |
| 2223 | execute_model(CurID,MaxNrSteps,_TransitionInfo,ExecutedSteps,Result). | |
| 2224 | ||
| 2225 | ||
| 2226 | tcltk_find_shortest_trace_to_current_node(list(StringList)) :- | |
| 2227 | find_trace_to_current_node(OpL), | |
| 2228 | translate_events(OpL,StringList). | |
| 2229 | ||
| 2230 | ||
| 2231 | tcltk_execute_trace_to_current_node :- | |
| 2232 | current_state_id(CurID), | |
| 2233 | tcltk_execute_trace_to_node(CurID). | |
| 2234 | ||
| 2235 | tcltk_execute_trace_to_node(ToID) :- /* can be useful for TestCase Generation */ | |
| 2236 | set_target_id(ToID), | |
| 2237 | tcltk_execute_trace_from_to_found_predicate(root,_,_). | |
| 2238 | ||
| 2239 | % execcute longest loop-free trace (no repeated state) | |
| 2240 | tcltk_execute_longest_trace_from(From) :- | |
| 2241 | set_longest_trace_target, | |
| 2242 | tcltk_execute_trace_from_to_found_predicate(From,_,_). | |
| 2243 | ||
| 2244 | % OpL is list of operation ids, IDList is list of state ids | |
| 2245 | tcltk_execute_trace_from_to_found_predicate(From,OpL,IDList) :- | |
| 2246 | debug_println(19,finding_trace_from_to(From)), flush_output(user), | |
| 2247 | find_shortest_path_from_to_found_predicate(From,OpL,IDList,ToID), !, | |
| 2248 | (current_state_id(From) -> true ; state_space_reset), | |
| 2249 | debug_println(9,executing_trace(From,OpL,ToID)), flush_output(user), | |
| 2250 | execute_id_trace_from_current(ToID,OpL,IDList). | |
| 2251 | ||
| 2252 | ||
| 2253 | find_trace_to_current_node(Trace) :- | |
| 2254 | current_state_id(CurID), | |
| 2255 | find_shortest_path_from_to(root,CurID,L,_), | |
| 2256 | extract_term_trace_from_transition_ids(L,Trace). | |
| 2257 | ||
| 2258 | :- use_module(state_space_dijkstra). | |
| 2259 | ||
| 2260 | find_shortest_trace_to_node(FromID,ToID,OpIDListe,StateIDList) :- | |
| 2261 | find_shortest_path_from_to(FromID,ToID,OpIDListe,StateIDList). | |
| 2262 | ||
| 2263 | ||
| 2264 | /* --------------------------------------------------- */ | |
| 2265 | ||
| 2266 | ||
| 2267 | ||
| 2268 | tcltk_goto_a_non_deterministic_node(Msg) :- /* same transition leads to different resulting state */ | |
| 2269 | visited_expression_id(ID), | |
| 2270 | external_functions:non_det_transition(ID,_OpName,TID1,TID2), | |
| 2271 | tcltk_execute_trace_to_node(ID), | |
| 2272 | transition(ID,Op1,TID1,ID1), | |
| 2273 | transition(ID,_Op2,TID2,ID2), | |
| 2274 | translate_event_with_src_and_target_id(Op1,ID,ID1,OpStr), | |
| 2275 | ajoin(['Operation leads to at least two different states (ids ', ID1,', ',ID2, | |
| 2276 | ') for same arguments: ', OpStr], Msg). | |
| 2277 | ||
| 2278 | tcltk_goto_a_non_deterministic_output_node(Msg) :- /* same transition leads to different outputs */ | |
| 2279 | visited_expression_id(ID), | |
| 2280 | external_functions:non_det_output_transition(ID,_OpName,TID1,TID2), | |
| 2281 | tcltk_execute_trace_to_node(ID), | |
| 2282 | transition(ID,Op1,TID1,ID1), | |
| 2283 | transition(ID,Op2,TID2,ID2), | |
| 2284 | translate_event_with_src_and_target_id(Op1,ID,ID1,OpStr1), | |
| 2285 | translate_event_with_src_and_target_id(Op2,ID,ID2,OpStr2), | |
| 2286 | ajoin(['Operation has at least two different results for same arguments: ', OpStr1, | |
| 2287 | '\n and ',OpStr2], Msg). | |
| 2288 | ||
| 2289 | dif_ID(ID1,ID2) :- (number(ID1),number(ID2) -> ID2>ID1 ; ID1 \= ID2). | |
| 2290 | ||
| 2291 | tcltk_goto_a_branching_node :- /* two different events/operations enabled */ | |
| 2292 | transition(ID,X,ID2), get_operation_name(X,NX), | |
| 2293 | transition(ID,Y,ID3), dif_ID(ID2,ID3), get_operation_name(Y,NY), NX\=NY, | |
| 2294 | print_message(found_branching_op(ID,NX,NY)), | |
| 2295 | %tcltk_goto_state(find_branching_node,ID), | |
| 2296 | tcltk_execute_trace_to_node(ID). | |
| 2297 | ||
| 2298 | tcltk_goto_a_non_resetable_node :- | |
| 2299 | find_resetable_nodes, | |
| 2300 | visited_expression_id(ID), | |
| 2301 | \+(resetable_node(ID)), | |
| 2302 | \+(not_all_transitions_added(ID)), !, | |
| 2303 | %tcltk_goto_state(find_non_resetable_node,ID). | |
| 2304 | tcltk_execute_trace_to_node(ID). | |
| 2305 | ||
| 2306 | :- use_module(bmachine,[b_get_machine_operation_for_animation/4]). | |
| 2307 | operation_name_covered(OpName) :- operation_name_covered(OpName,_). | |
| 2308 | operation_name_covered(OpName,Template) :- | |
| 2309 | b_get_machine_operation_for_animation(OpName,Results,Par,_), | |
| 2310 | \+ operation_not_yet_covered(OpName), | |
| 2311 | length(Par,Arity), | |
| 2312 | functor(Op,OpName,Arity), | |
| 2313 | (Results\=[] -> Template = '-->'(Op,_) ; Template = Op). | |
| 2314 | ||
| 2315 | tcltk_goto_event_list_property_violation(Property,EventSelection,list(OperationList)) :- | |
| 2316 | % first translate Tk EventSelection Number list into Events | |
| 2317 | sap:get_selected_events(EventSelection,_AllEvents,OperationList), | |
| 2318 | include(operation_name_covered,OperationList,_,EnabledOpList), % only keep operations that can be enabled anyway | |
| 2319 | maplist(operation_name_covered,EnabledOpList,TemplateList), % replace by template | |
| 2320 | print(find_property_violation_for_template(Property,TemplateList)),nl, | |
| 2321 | visited_expression(ID,S), ID \= root, S\= concrete_constants(_), | |
| 2322 | \+(not_all_transitions_added(ID)), | |
| 2323 | \+( check_event_list_property(Property,ID,TemplateList) ), | |
| 2324 | print(found_event_list_property_violation(Property,ID)),nl, | |
| 2325 | tcltk_execute_trace_to_node(ID). | |
| 2326 | ||
| 2327 | check_event_list_property(relative_deadlock_freedom,ID,TemplateList) :- | |
| 2328 | relative_deadlock_freedom(ID,TemplateList). | |
| 2329 | check_event_list_property(valid_controller,ID,TemplateList) :- | |
| 2330 | is_valid_controller_state(ID,TemplateList). | |
| 2331 | check_event_list_property(det_controller,ID,TemplateList) :- | |
| 2332 | is_det_controller_state(ID,TemplateList). | |
| 2333 | ||
| 2334 | relative_deadlock_freedom(ID,TemplateList) :- member(Template,TemplateList), | |
| 2335 | transition(ID,Template,_). | |
| 2336 | is_valid_controller_state(ID,TemplateList) :- % check that exactly one event from TemplateList is enabled | |
| 2337 | append(_,[LiveEvent|RestTemplate],TemplateList), | |
| 2338 | transition(ID,LiveEvent,_),!, % we found one enabled event | |
| 2339 | \+ relative_deadlock_freedom(ID,RestTemplate). % all other events from list must be disabled | |
| 2340 | is_det_controller_state(ID,TemplateList) :- % check that *at most* one event from TemplateList is enabled | |
| 2341 | append(_,[LiveEvent|RestTemplate],TemplateList), | |
| 2342 | transition(ID,LiveEvent,_),!, % we found one enabled event from list | |
| 2343 | \+ relative_deadlock_freedom(ID,RestTemplate). % all other events from list must be disabled | |
| 2344 | is_det_controller_state(_,_) :- true. % no event enabled is also ok | |
| 2345 | ||
| 2346 | ||
| 2347 | tcltk_goto_state_enabling_operation(TclOpName,FromCurrent) :- | |
| 2348 | adapt_tcl_operation_name(TclOpName,OpName), | |
| 2349 | operation_name_covered(OpName,Template), % does cater for Event-B any vars | |
| 2350 | set_found_predicate(ID, transition(ID,Template,_)), | |
| 2351 | print_message('Computing trace to node'), | |
| 2352 | (FromCurrent=1 | |
| 2353 | -> current_state_id(FromID) % inefficient: better to do one dijkstra from FromID ! | |
| 2354 | ; FromID = root | |
| 2355 | ), | |
| 2356 | tcltk_execute_trace_from_to_found_predicate(FromID,_,_). | |
| 2357 | % tcltk_goto_state(find_enabled(OpName),ID). | |
| 2358 | ||
| 2359 | ||
| 2360 | :- use_module(tools_lists,[count_occurences/2]). | |
| 2361 | % quickly compute which operations have already been covered and which ones not | |
| 2362 | tcltk_operations_covered_info(list([list(['Operation','Covered'])|OpCov]),list(Occurences),Precise) :- | |
| 2363 | findall(list([OpName,Cov]), | |
| 2364 | (specfile:get_possible_event(OpName), | |
| 2365 | (operation_name_not_yet_covered(OpName) | |
| 2366 | -> not_yet_covered_info(Precise,OpName,Cov) | |
| 2367 | ; Cov = 'yes')),OpCov), | |
| 2368 | (maplist(get_cov,OpCov,Cov2), | |
| 2369 | count_occurences(Cov2,Occ2), | |
| 2370 | maplist(construct_list,Occ2,Occurences) -> true ; Occurences=[]). | |
| 2371 | ||
| 2372 | get_cov(list([_,Cov|_]),Cov). | |
| 2373 | construct_list(Kind-Nr,list([Kind,Nr])). | |
| 2374 | ||
| 2375 | :- use_module(cbcsrc(enabling_analysis),[feasible_operation/2]). | |
| 2376 | not_yet_covered_info(precise,OpName,Cov) :- | |
| 2377 | feasible_operation(OpName,Res),!, Res=Cov. | |
| 2378 | not_yet_covered_info(precise,_,R) :- !, R='unknown'. | |
| 2379 | not_yet_covered_info(_,_,'uncovered'). | |
| 2380 | ||
| 2381 | :- dynamic resetable_node/1. | |
| 2382 | ||
| 2383 | resetable_node(a). | |
| 2384 | ||
| 2385 | :- public find_resetable_nodes/0. | |
| 2386 | :- dynamic find_flag/2. | |
| 2387 | find_resetable_nodes :- | |
| 2388 | retractall(find_flag(_,_)), | |
| 2389 | retractall(resetable_node(_)), | |
| 2390 | any_transition(root,_,ID), /* add nodes reachable from root */ | |
| 2391 | assertz(find_flag(ID,0)), | |
| 2392 | fail. | |
| 2393 | find_resetable_nodes :- | |
| 2394 | visited_expression(CID,concrete_constants(_C)), | |
| 2395 | any_transition(CID,_,ID), /* add nodes reachable after a setup_constants */ | |
| 2396 | assertz(find_flag(ID,0)), | |
| 2397 | fail. | |
| 2398 | find_resetable_nodes :- find_resetable_nodes_loop, | |
| 2399 | print_message('Not resetable:'), | |
| 2400 | visited_expression_id(ID), | |
| 2401 | \+(resetable_node(ID)), | |
| 2402 | print_message(ID), | |
| 2403 | fail. | |
| 2404 | find_resetable_nodes :- | |
| 2405 | print_message('Done'). | |
| 2406 | ||
| 2407 | ||
| 2408 | find_resetable_nodes_loop :- | |
| 2409 | retract(find_flag(ID,N)), !, find_resetable_nodes_loop(ID,N). | |
| 2410 | find_resetable_nodes_loop. | |
| 2411 | ||
| 2412 | find_resetable_nodes_loop(ID,N) :- N1 is N+1, | |
| 2413 | assertz(resetable_node(ID)), | |
| 2414 | any_transition(NewID,_,ID), | |
| 2415 | \+(resetable_node(NewID)), | |
| 2416 | \+(find_flag(NewID,_)), | |
| 2417 | assertz(find_flag(NewID,N1)), | |
| 2418 | fail. | |
| 2419 | find_resetable_nodes_loop(_,_) :- find_resetable_nodes_loop. | |
| 2420 | ||
| 2421 | ||
| 2422 | :- use_module(specfile, [get_current_state_for_b_formula/2]). | |
| 2423 | ||
| 2424 | tcltk_show_expression_as_dot(VorE,File) :- | |
| 2425 | parse_machine_expression(VorE,TypedExpr), | |
| 2426 | tcltk_show_typed_expression_as_dot_graph(TypedExpr,File). | |
| 2427 | tcltk_show_expression_as_dot(_VorE,File) :- | |
| 2428 | add_error(tcltk_show_expression_as_dot,'Computing Value Dot Representation Failed for: ',File), | |
| 2429 | fail. | |
| 2430 | ||
| 2431 | :- use_module(dotsrc(state_as_dot_graph),[print_cstate_graph/2]). | |
| 2432 | :- use_module(dotsrc(state_custom_dot_graph),[tcltk_generate_state_custom_dot_graph_for_expr/2, is_valid_custom_dot_graph_record/1]). | |
| 2433 | ||
| 2434 | tcltk_show_typed_expression_as_dot_graph(TypedExpr,File) :- | |
| 2435 | is_valid_custom_dot_graph_record(TypedExpr), | |
| 2436 | !, % use the more powerful custom_dot_graph mechanism | |
| 2437 | tcltk_generate_state_custom_dot_graph_for_expr(TypedExpr,File). | |
| 2438 | tcltk_show_typed_expression_as_dot_graph(TypedExpr,File) :- | |
| 2439 | get_current_state_for_b_formula(TypedExpr,BState), | |
| 2440 | extend_state_with_probids_and_lets(BState,BState1), | |
| 2441 | decompose_expression_for_dot(TypedExpr,ExprList,[]), % decompose pairs so that user can provide multiple values/graphs | |
| 2442 | compute_for_dot(ExprList,BState1,GraphState), % compute value for each sub-component | |
| 2443 | format('Writing value to DOT file: ~w~n',[File]), | |
| 2444 | print_cstate_graph(GraphState,File), | |
| 2445 | format('Finished writing value to DOT file: ~w~n',[File]). | |
| 2446 | ||
| 2447 | ||
| 2448 | :- use_module(eval_let_store,[extend_typing_scope_for_stored_lets/2]). | |
| 2449 | :- use_module(bmachine, [b_parse_machine_expression_from_codes_with_prob_ids/2, type_with_errors/4]). | |
| 2450 | parse_machine_expression(RawAST,TypedExpr) :- compound(RawAST),!, % allow to pass raw AST as well | |
| 2451 | extend_typing_scope_for_stored_lets([prob_ids(visible),variables,external_library(safe_available_libraries)],Scope), | |
| 2452 | type_with_errors(RawAST,Scope,Type,TypedExpr), | |
| 2453 | % TODO: get_stored_let_typing_scope and add values to state returned by get_current_state_for_b_formula | |
| 2454 | ((Type=pred ; Type=subst) | |
| 2455 | -> add_error(parse_machine_expression,'Expected expression formula but obtained: ',Type),fail | |
| 2456 | ; true ). | |
| 2457 | parse_machine_expression(VorE,TypedExpr) :- | |
| 2458 | atom_codes(VorE,VorECodes), | |
| 2459 | b_parse_machine_expression_from_codes_with_prob_ids(VorECodes,TypedExpr). | |
| 2460 | ||
| 2461 | compute_for_dot([],_,[]). | |
| 2462 | compute_for_dot([String,TypedExpr|Tail],BState,[bind(Str,Value)|TS]) :- | |
| 2463 | % allow user to specify labels for graphs ("lbl1", e1, "lbl2", e2, ...) | |
| 2464 | get_texpr_expr(String,string(Str)),!, | |
| 2465 | translate:translate_bexpression_with_limit(TypedExpr,100,EStr), | |
| 2466 | format('Computing value for expression: ~w~n',[EStr]), | |
| 2467 | b_compute_expression_with_prob_ids(TypedExpr,BState,Value), | |
| 2468 | compute_for_dot(Tail,BState,TS). | |
| 2469 | compute_for_dot([TypedExpr|Tail],BState,[bind(Str,Value)|TS]) :- | |
| 2470 | translate:translate_bexpression_with_limit(TypedExpr,100,Str), | |
| 2471 | format('Computing value for expression: ~w~n',[Str]), | |
| 2472 | b_compute_expression_with_prob_ids(TypedExpr,BState,Value), | |
| 2473 | compute_for_dot(Tail,BState,TS). | |
| 2474 | ||
| 2475 | :- use_module(bsyntaxtree, [replace_ids_by_exprs/4]). | |
| 2476 | ||
| 2477 | % decompose_expression_for_dot ensures that | |
| 2478 | % ("label1",graph1,"lbl2",graph2) or rec(label:graph) is decomposed and we can associate labels with multiple graphs | |
| 2479 | decompose_expression_for_dot(b(couple(A,B),_,_)) --> !, | |
| 2480 | decompose_expression_for_dot(A), decompose_expression_for_dot(B). | |
| 2481 | decompose_expression_for_dot(b(rec(Fields),_,_)) --> !,decompose_fields_for_dot(Fields). | |
| 2482 | decompose_expression_for_dot(b(let_expression(Ids,Exprs,Body),couple(_,_),_)) --> !, | |
| 2483 | % this can happen when OPTIMIZE_AST is set to FALSE and the Jupyter kernel adds LETs; lift string out of let | |
| 2484 | % :dot expr_as_graph ("h",h,"hh",(h;h)) | |
| 2485 | {replace_ids_by_exprs(Body,Ids,Exprs,Body2)}, | |
| 2486 | decompose_expression_for_dot(Body2). | |
| 2487 | decompose_expression_for_dot(X) --> [X]. | |
| 2488 | ||
| 2489 | ||
| 2490 | decompose_fields_for_dot([]) --> []. | |
| 2491 | decompose_fields_for_dot([field(Name,Val)|T]) --> [b(string(Name),string,[]),Val], decompose_fields_for_dot(T). | |
| 2492 | ||
| 2493 | /* ------------------------------------------------------------------ */ | |
| 2494 | ||
| 2495 | % aka Execute by Predicate | |
| 2496 | tcltk_add_user_executed_operation(TclOpName,CustomPredicate) :- | |
| 2497 | tcltk_add_user_executed_operation(TclOpName,[],CustomPredicate). | |
| 2498 | ||
| 2499 | tcltk_add_user_executed_operation(TclOpName,ParameterBindList,RestPreCond) :- | |
| 2500 | adapt_tcl_operation_name(TclOpName,OpName), | |
| 2501 | parse_tclk_parameter_values_and_pred(OpName,ParameterBindList,RestPreCond,CustomPredicate), | |
| 2502 | current_state_id(CurID), | |
| 2503 | get_computed_preference(debug_time_out,DTO), | |
| 2504 | time_out_with_enum_warning_one_solution(b_trans_one_solution_with_pred(OpName,CustomPredicate,CurID,_,_,_), | |
| 2505 | DTO,TimeOutRes), | |
| 2506 | (is_time_out_result(TimeOutRes) | |
| 2507 | -> add_warning(execute_by_predicate,'Timeout occured trying to execute operation with predicate: ',TclOpName),fail | |
| 2508 | ; true). | |
| 2509 | ||
| 2510 | parse_tclk_parameter_values_and_pred(OpName,ParameterBindList,RestPreCond,CustomPredicate) :- | |
| 2511 | GenParseErrors=true, | |
| 2512 | parse_tclk_parameter_values_and_pred(OpName,ParameterBindList,RestPreCond,CustomPredicate,GenParseErrors). | |
| 2513 | parse_tclk_parameter_values_and_pred(OpName,ParameterBindList,RestPreCond,CustomPredicate,GenParseErrors) :- | |
| 2514 | ExtraScope=[], | |
| 2515 | b_parse_machine_operation_pre_post_predicate(RestPreCond,ExtraScope,RestTypedPred,OpName,GenParseErrors), | |
| 2516 | (ParameterBindList=[] -> CustomPredicate = RestTypedPred | |
| 2517 | ; get_animation_operation_parameters(OpName,Parameters), | |
| 2518 | % print(tcltk_add_user_executed_operation(OpName,ParameterBindList,Parameters)),nl, | |
| 2519 | parse_parameter_values(ParameterBindList,OpName,Parameters,List), | |
| 2520 | conjunct_predicates([RestTypedPred|List],CustomPredicate) | |
| 2521 | ). | |
| 2522 | ||
| 2523 | :- use_module(bmachine,[b_get_machine_operation_for_animation/7]). | |
| 2524 | get_animation_operation_parameters('$setup_constants',Parameters) :- !, | |
| 2525 | b_get_machine_operation_typed_parameters('$setup_constants',Parameters). | |
| 2526 | get_animation_operation_parameters(OpName,FullParameters) :- xtl_mode,!, | |
| 2527 | xtl_transition_parameters(OpName,ParaNames), | |
| 2528 | maplist(make_string_id,ParaNames,FullParameters). | |
| 2529 | get_animation_operation_parameters(OpName,FullParameters) :- | |
| 2530 | TopLevel=true, % otherwise ANY parameters not added when show_eventb_any_arguments is true | |
| 2531 | b_get_machine_operation_for_animation(OpName,_Results,Parameters,_Body,_OType,TopLevel,_OpPos), | |
| 2532 | b_get_operation_non_det_modifies(OpName,NonDetVars), % also allow setting non-deterministically assigned vars | |
| 2533 | b_get_machine_variables(Vars), | |
| 2534 | include(non_det_modified(NonDetVars),Vars,ParaVars), | |
| 2535 | append(ParaVars,Parameters,FullParameters). | |
| 2536 | ||
| 2537 | make_string_id(ID,b(identifier(ID),string,[])). | |
| 2538 | non_det_modified(NonDetVars,TID) :- get_texpr_id(TID,ID), ord_member(ID,NonDetVars). | |
| 2539 | ||
| 2540 | % parse a list of variable names and expressions and turn into equal predicates | |
| 2541 | % Motivation: this can also deal with Z-style identifiers like in?, ... which cannot be parsed | |
| 2542 | :- use_module(btypechecker, [unify_types_strict/2, coerce_type/4]). | |
| 2543 | :- use_module(extrasrc(before_after_predicates),[prime_dollar0_bexpr_for_ids/3]). | |
| 2544 | :- use_module(probsrc(b_read_write_info), [b_get_read_write/3]). | |
| 2545 | ||
| 2546 | parse_parameter_values([],_,_,Res) :- !,Res=[]. | |
| 2547 | parse_parameter_values(['='(ParameterID,ExpressionStr)|T],OpName,Parameters,[Pred|PT]) :- | |
| 2548 | atom_codes(ExpressionStr,Codes), | |
| 2549 | format('Parsing for parameter ~w : ~w~n',[ParameterID,ExpressionStr]), | |
| 2550 | !, | |
| 2551 | b_parse_machine_expression_from_codes_with_prob_ids(Codes,TypedExpr), | |
| 2552 | get_texpr_type(TypedExpr,Type), | |
| 2553 | TID = b(identifier(ParameterID),ExpectedType,[]), | |
| 2554 | % if we reference a modified variable in the expression, we replace id by id$0 : | |
| 2555 | (b_or_z_mode -> b_get_read_write(OpName,_,Written) ; Written=[]), | |
| 2556 | prime_dollar0_bexpr_for_ids(TypedExpr,Written,PrimedTypedExpr0), | |
| 2557 | (xtl_mode | |
| 2558 | -> (Type=string -> PrimedTypedExpr1=PrimedTypedExpr0 | |
| 2559 | ; coerce_type(Type,string,PrimedTypedExpr0,PrimedTypedExpr1)), | |
| 2560 | PrimedTypedExpr=b(external_function_call('STRING_TO_TERM',[PrimedTypedExpr1]),string,[]), | |
| 2561 | Type2=string | |
| 2562 | ; PrimedTypedExpr=PrimedTypedExpr0, Type2=Type), | |
| 2563 | (member(b(identifier(ParameterID),ExpectedType,_),Parameters) | |
| 2564 | -> (unify_types_strict(Type2,ExpectedType) | |
| 2565 | -> safe_create_texpr(equal(TID,PrimedTypedExpr),pred,Pred), | |
| 2566 | parse_parameter_values(T,OpName,Parameters,PT) | |
| 2567 | ; coerce_type(Type2,ExpectedType,PrimedTypedExpr,NewTypedExpr) | |
| 2568 | -> safe_create_texpr(equal(TID,NewTypedExpr),pred,Pred), | |
| 2569 | add_message(parse_parameter_values,'Coercion of provided parameter value: ',NewTypedExpr), | |
| 2570 | parse_parameter_values(T,OpName,Parameters,PT) | |
| 2571 | ; | |
| 2572 | pretty_type(Type2,String1), pretty_type(ExpectedType,String2), | |
| 2573 | ajoin(['Value for parameter ',ParameterID,' has unexpected type ',String1,', expected: '],Msg), | |
| 2574 | add_error(parse_parameter_values,Msg,String2), | |
| 2575 | fail | |
| 2576 | ) | |
| 2577 | ; add_error(parse_parameter_values,'Unknown operation parameter: ',ParameterID), | |
| 2578 | fail). | |
| 2579 | parse_parameter_values(PB,OpName,P,_) :- | |
| 2580 | add_internal_error('Illegal parameter binding: ',parse_parameter_values(PB,OpName,P,_)),fail. | |
| 2581 | ||
| 2582 | ||
| 2583 | % just as above but with typed predicate | |
| 2584 | tcltk_add_user_executed_operation_typed(OpName,Operation,TypedCustomPredicate,NewID) :- | |
| 2585 | current_state_id(CurID), | |
| 2586 | tcltk_add_user_executed_operation_typed(OpName,CurID,Operation,TypedCustomPredicate,_,NewID). | |
| 2587 | tcltk_add_user_executed_operation_typed(OpName,CurID,Operation,TypedCustomPredicate,TransID,NewID) :- | |
| 2588 | b_trans_one_solution_with_pred(OpName,TypedCustomPredicate,CurID,Operation,TransID,NewID). | |
| 2589 | ||
| 2590 | % allows the user to arbitrarily change variable values | |
| 2591 | % Attention: this can of course violate the invariant | |
| 2592 | tcltk_add_user_modify_variable_transition(VarID,ValueStr) :- | |
| 2593 | current_state_id(CurID), | |
| 2594 | tcltk_add_user_modify_variable_transition(CurID,VarID,ValueStr,_). | |
| 2595 | tcltk_add_user_modify_variable_transition(CurID,VarID,ValueStr,NewID) :- | |
| 2596 | get_id_type(VarID,Kind,Type),!, | |
| 2597 | format('Trying to update ~w ~w to new value: ~w~n',[Kind,VarID,ValueStr]), | |
| 2598 | eval_string_in_cur_state(ValueStr,ValTyped,Value), | |
| 2599 | get_texpr_type(ValTyped,ValType), | |
| 2600 | check_types(Kind,VarID,Type,ValType), | |
| 2601 | visited_expression(CurID,CurState), | |
| 2602 | update_variable(CurState,VarID,Value,NewState), | |
| 2603 | Residue=[], TransInfo=[], | |
| 2604 | Operation = '$modify'(string(VarID),string(ValueStr)), | |
| 2605 | add_trans_id_with_infos(CurID,[],Operation,NewState,Residue,NewID,TransInfo,_), | |
| 2606 | tcltk_goto_state(Operation,NewID). | |
| 2607 | ||
| 2608 | check_types(_,_,Type,ValType) :- | |
| 2609 | unify_types_strict(Type,ValType),!. | |
| 2610 | check_types(Kind,VarID,Type,ValType) :- | |
| 2611 | pretty_type(ValType,VTS), pretty_type(Type,TS), | |
| 2612 | ajoin(['Unexpected type of value (', VTS, ' instead of ',TS,') for ',Kind,' :'],Msg), | |
| 2613 | add_error(check_types,Msg,VarID), | |
| 2614 | fail. | |
| 2615 | ||
| 2616 | :- use_module(bmachine,[b_is_variable/2, b_is_constant/2]). | |
| 2617 | get_id_type(ID,variable,Type) :- b_is_variable(ID,Type). | |
| 2618 | get_id_type(ID,constant,Type) :- b_is_constant(ID,Type). | |
| 2619 | % update variable value or constant value in concrete_constants state | |
| 2620 | update_variable([],VarID,_,[]) :- add_error(update_variable,'Identifier does not exist in state:',VarID),fail. | |
| 2621 | update_variable([bind(VarID,_)|T],VarID,NewVal,Res) :- !, Res = [bind(VarID,NewVal)|T]. | |
| 2622 | update_variable([H|T],VarID,NewVal,[H|UT]) :- !, update_variable(T,VarID,NewVal,UT). | |
| 2623 | update_variable(const_and_vars(ConstID,Old),VarID,NewVal,const_and_vars(ConstID,New)) :- !, | |
| 2624 | update_variable(Old,VarID,NewVal,New). | |
| 2625 | update_variable(concrete_constants(Old),VarID,NewVal,concrete_constants(New)) :- !, | |
| 2626 | update_variable(Old,VarID,NewVal,New). % here we allow updating constants | |
| 2627 | ||
| 2628 | % execute operation by predicate finding just one solution | |
| 2629 | b_trans_one_solution_with_pred(OpName,TypedCustomPredicate,CurID,Operation,TransId,NewID) :- | |
| 2630 | catch( | |
| 2631 | ( | |
| 2632 | call_cleanup(b_trans_one_solution_with_pred2(OpName,TypedCustomPredicate,CurID,Operation,TransId,NewID), | |
| 2633 | bmachine:reset_temp_predicate) | |
| 2634 | ), | |
| 2635 | enumeration_warning(Cause,_,_,_,_), | |
| 2636 | ( | |
| 2637 | add_warning(b_trans_one_solution_with_pred, | |
| 2638 | 'Enumeration warning prevented finding solution for operation: ',Cause), | |
| 2639 | fail | |
| 2640 | ) | |
| 2641 | ). | |
| 2642 | ||
| 2643 | % find one solution from current state using OpName and respecting temp_predicate | |
| 2644 | % Note: the predicate is evaluated in post-state, use $0 to access values in current state | |
| 2645 | b_trans_one_solution_with_pred2(OpName,TypedCustomPredicate,CurID,Operation,TransId,NewID) :- | |
| 2646 | (b_or_z_mode -> b_top_level_operation(OpName) ; true), | |
| 2647 | !, | |
| 2648 | visited_expression(CurID,InState), | |
| 2649 | set_error_context(operation(OpName,CurID)), | |
| 2650 | set_context_state(CurID,b_trans_one_solution_with_pred), | |
| 2651 | debug_format(19,'Executing ~w in state ~w by predicate~n',[OpName,CurID]), | |
| 2652 | call_cleanup(execute_operation_by_predicate_in_state(InState,OpName,TypedCustomPredicate,Operation,NewState,TransInfo), | |
| 2653 | (clear_context_state,clear_error_context)), | |
| 2654 | !, | |
| 2655 | debug_format(19,'Executed by predicate: ~w~n',[OpName]), | |
| 2656 | add_trans_id_infos(CurID,Operation,NewState,NewID,TransId,TransInfo), | |
| 2657 | tcltk_goto_state(Operation,NewID). | |
| 2658 | b_trans_one_solution_with_pred2(OpName,TypedCustomPredicate,CurID,Operation,TransId,NewID) :- | |
| 2659 | assert_temp_predicate_with_prob_def_set_elements(TypedCustomPredicate), | |
| 2660 | visited_expression(CurID,InState), | |
| 2661 | set_error_context(operation(OpName,CurID)), | |
| 2662 | set_context_state(CurID,b_trans_one_solution_with_pred), | |
| 2663 | temporary_set_preference(maxNrOfEnablingsPerOperation,1,Max), | |
| 2664 | temporary_set_preference(maxNrOfInitialisations,1,MaxI), | |
| 2665 | start_ms_timer(Timer), | |
| 2666 | call_cleanup((specfile:b_trans(InState,OpName,Operation,NewState,TransInfo) -> true), | |
| 2667 | (stop_ms_timer(Timer), | |
| 2668 | reset_temporary_preference(maxNrOfEnablingsPerOperation,Max), | |
| 2669 | reset_temporary_preference(maxNrOfInitialisations,MaxI), | |
| 2670 | clear_context_state,clear_error_context) | |
| 2671 | ), | |
| 2672 | debug_println(9,found_solution(NewState)),nl, | |
| 2673 | % now add a transition to the state space: | |
| 2674 | Residue=[], | |
| 2675 | add_trans_id_with_infos(CurID,[],Operation,NewState,Residue,NewID,TransInfo,TransId), | |
| 2676 | tcltk_goto_state(Operation,NewID). | |
| 2677 | ||
| 2678 | :- use_module(b_global_sets,[inline_prob_deferred_set_elements_into_bexpr/2]). | |
| 2679 | assert_temp_predicate_with_prob_def_set_elements(CustomPredicate) :- | |
| 2680 | inline_prob_deferred_set_elements_into_bexpr(CustomPredicate,CompiledPred), | |
| 2681 | bmachine:assert_temp_typed_predicate(CompiledPred). | |
| 2682 | ||
| 2683 | ||
| 2684 | % allow user to execute any statement | |
| 2685 | % TO DO: catch operation_calls and route them differently | |
| 2686 | % translate operation_call arguments into predicate and call tcltk_add_user_executed_operation_typed(OpName,Operation,TypedCustomPredicate,NewID) | |
| 2687 | tcltk_add_user_executed_statement(Statement,Updates,NewID) :- | |
| 2688 | current_expression(CurID,InState), | |
| 2689 | state_corresponds_to_initialised_b_machine(InState,BState), | |
| 2690 | set_context_state(CurID,tcltk_add_user_executed_statement), | |
| 2691 | %start_ms_timer(Timer), | |
| 2692 | call_cleanup((tcltk_interface:b_full_execute_top_level_statement_with_probids(Statement,BState,Updates,NewState)->true), | |
| 2693 | clear_context_state), | |
| 2694 | % TO DO: do we need to catch enumeration warnings ? | |
| 2695 | %stop_ms_timer(Timer), | |
| 2696 | Residue=[], TransInfo = [], | |
| 2697 | debug_println(4,executed(Updates,NewState)), | |
| 2698 | compute_all_transitions_if_necessary(CurID), % first ensure we have already computed outgoing transitions as usual, so that we can detect if a new state is added | |
| 2699 | (get_id_of_node_and_add_if_required(NewState,NewID,Exists,CurID,'$unknown_operation',[]), | |
| 2700 | Exists=exists, | |
| 2701 | transition(CurID,Action,TransId,NewID) | |
| 2702 | -> debug_println(4,transition_exists_already(Action,TransId)) | |
| 2703 | ; translate:translate_substitution(Statement,OpLabel), | |
| 2704 | add_trans_id_with_infos(CurID,[],'$USER'(OpLabel),NewState,Residue,NewID,TransInfo,_), | |
| 2705 | format('Added new user-initiated transition to ~w via: ~w~n',[NewID,OpLabel]) | |
| 2706 | ), | |
| 2707 | tcltk_goto_state(OpLabel,NewID). | |
| 2708 | ||
| 2709 | :- use_module(eval_let_store,[extend_state_with_probids_and_lets/2]). | |
| 2710 | :- use_module(kernel_waitflags,[init_wait_flags_with_call_stack/2, ground_wait_flags/1]). | |
| 2711 | %% allows one to execute any statement (not just operations). | |
| 2712 | b_full_execute_top_level_statement_with_probids(Body,InState,Updates,NewState) :- | |
| 2713 | extend_state_with_probids_and_lets(InState,InState1), | |
| 2714 | init_wait_flags_with_call_stack(WF,[prob_command_context(user_executed_statement,unknown)]), | |
| 2715 | b_execute_top_level_statement(Body,[],InState1,Updates,WF,_Path1,output_not_required), | |
| 2716 | ground_wait_flags(WF), | |
| 2717 | store:store_updates_and_normalise(Updates,InState,NewState). | |
| 2718 | ||
| 2719 | % -------------------------------------------------------------------------------------- | |
| 2720 | ||
| 2721 | ||
| 2722 | :- use_module(bmachine). | |
| 2723 | :- use_module(specfile). | |
| 2724 | :- use_module(tools). | |
| 2725 | :- use_module(library(lists)). | |
| 2726 | :- use_module(store). | |
| 2727 | :- use_module(self_check). | |
| 2728 | :- use_module(b_global_sets). | |
| 2729 | :- use_module(translate). | |
| 2730 | ||
| 2731 | ||
| 2732 | /* --------------------------------------------------------- */ | |
| 2733 | /* --------------------------------------------------------- */ | |
| 2734 | ||
| 2735 | ||
| 2736 | /* ----------------------------------*/ | |
| 2737 | /* b_analyse_conjunction */ | |
| 2738 | /* ----------------------------------*/ | |
| 2739 | ||
| 2740 | ||
| 2741 | /* provide list of possible options for analysis */ | |
| 2742 | tcltk_analyse_option(invariant,'INVARIANT') :- b_or_z_mode. | |
| 2743 | tcltk_analyse_option(properties,S) :- b_or_z_mode, | |
| 2744 | get_specification_description(properties,S). | |
| 2745 | tcltk_analyse_option(assertions,S) :- (b_or_z_mode ; csp_mode), | |
| 2746 | get_specification_description(assertions,S). | |
| 2747 | tcltk_analyse_option(deadlock,'DEADLOCKED') :- b_or_z_mode. | |
| 2748 | ||
| 2749 | ||
| 2750 | :- use_module(predicate_evaluator). | |
| 2751 | /* perform the various analysis */ | |
| 2752 | tcltk_analyse(Mode,Type,ListWithResults,Total,False,Unknown) :- | |
| 2753 | (Mode == unicode | |
| 2754 | -> set_unicode_mode, | |
| 2755 | call_cleanup(tcltk_analyse2(Type,ListWithResults,Summary),unset_unicode_mode) | |
| 2756 | ; tcltk_analyse2(Type,ListWithResults,Summary)), | |
| 2757 | (member(total/Total,Summary) -> true ; Total=0), | |
| 2758 | (member(false/False,Summary) -> true ; False=0), | |
| 2759 | (member(unknown/Unknown,Summary) -> true ; Unknown=0). | |
| 2760 | tcltk_analyse2(invariant,L,Summary) :- !,tcltk_analyse_invariant(L,Summary). | |
| 2761 | tcltk_analyse2(properties,L,Summary) :- !,tcltk_analyse_properties(L,Summary). | |
| 2762 | tcltk_analyse2(assertions,L,Summary) :- !,tcltk_analyse_assertions(L,Summary). | |
| 2763 | tcltk_analyse2(deadlock,L,Summary) :- !,tcltk_analyse_deadlock(L,Summary). | |
| 2764 | tcltk_analyse2(X,L,Summary) :- add_error(tcltk_analyse, 'Unknown type of formula: ', X), | |
| 2765 | L=[], Summary=[]. | |
| 2766 | ||
| 2767 | ||
| 2768 | /* --------------------------------- */ | |
| 2769 | ||
| 2770 | tcltk_show_current_state(TransBState) :- | |
| 2771 | current_b_expression(B), | |
| 2772 | translate_bstate(B,TransBState). | |
| 2773 | ||
| 2774 | ||
| 2775 | tcltk_show_typing_of_variables_and_constants(list(List)) :- | |
| 2776 | b_get_machine_variables(TypedVarList), | |
| 2777 | convert_typed_varlist(TypedVarList,VarList,Types), | |
| 2778 | generate_typing_list(VarList,Types,VList,VarCard), | |
| 2779 | length(VarList,NrVars), | |
| 2780 | format_to_codes(' VARIABLES [nr=~w,card=~w]',[NrVars,VarCard],Codes1),atom_codes(VARAtom,Codes1), | |
| 2781 | ||
| 2782 | b_get_machine_all_constants(TypedCstList), | |
| 2783 | convert_typed_varlist(TypedCstList,CVarList,CTypes), | |
| 2784 | find_non_det_constants, | |
| 2785 | generate_typing_list(CVarList,CTypes,CList,CCard), | |
| 2786 | ( CList = [] | |
| 2787 | -> List = [VARAtom|VList] | |
| 2788 | ; length(CVarList,NrCsts), | |
| 2789 | format_to_codes(' CONSTANTS [nr=~w,card=~w]',[NrCsts,CCard],Codes2),atom_codes(CstAtom,Codes2), | |
| 2790 | append([CstAtom|CList],[VARAtom|VList],List) | |
| 2791 | ),!. | |
| 2792 | tcltk_show_typing_of_variables_and_constants(list(['TYPE ERROR in MACHINE'])). | |
| 2793 | ||
| 2794 | ||
| 2795 | %%% Used to get the constant values for the currently loaded B machine in form of a B predicate. | |
| 2796 | %%% In case that the constants in the model has not been set up then all possible constants' | |
| 2797 | %%% evaluations will be provided in form of a predicate in Disjunctive Normal Form. | |
| 2798 | %%% Predicate used for setting up constants when model checking with TLC. (TLA) | |
| 2799 | ||
| 2800 | tcltk_get_constants_predicate(Pred) :- | |
| 2801 | tcltk_get_constants_predicate(root,Pred,_PredComplete). | |
| 2802 | tcltk_get_constants_predicate(CurID,Pred,PredComplete) :- | |
| 2803 | (CurID=root | |
| 2804 | -> get_constants_as_disjoint_predicate(Pred), | |
| 2805 | (max_reached_or_timeout_for_node(root) -> PredComplete = incomplete ; PredComplete = complete) | |
| 2806 | ; PredComplete=complete, | |
| 2807 | prob2_interface:get_state(CurID,EState), | |
| 2808 | filter_constants_bindings(EState,X), % this will only get current constants values | |
| 2809 | translate_bstate_to_pred(X,Pred) | |
| 2810 | ). | |
| 2811 | ||
| 2812 | get_constants_as_disjoint_predicate(Pred) :- | |
| 2813 | findall(R,get_set_up_constants_solution(R),PredList), | |
| 2814 | add_or_between_constant_predicates(PredList,Pred). | |
| 2815 | ||
| 2816 | %get_a_part_of_the_found_solutions(L,N,Part,PredComplete) :- | |
| 2817 | % length(L,Length), | |
| 2818 | % (N>=Length | |
| 2819 | % -> Part=L, PredComplete=complete | |
| 2820 | % ; sublist(L,Part,_B,N,_A), PredComplete=incomplete | |
| 2821 | % ). | |
| 2822 | ||
| 2823 | translate_bstate_to_pred(State,P) :- | |
| 2824 | temporary_set_preference(expand_avl_upto,-1,CHNG2), | |
| 2825 | translate: translate_bstate(State,P), | |
| 2826 | reset_temporary_preference(expand_avl_upto,CHNG2). | |
| 2827 | ||
| 2828 | get_set_up_constants_solution(R) :- | |
| 2829 | compute_transitions_if_necessary(root), | |
| 2830 | %\+ max_reached_or_timeout_for_node(root),!, % then lookup constants rather than computing them | |
| 2831 | transition(root,_,Dst), | |
| 2832 | visited_expression(Dst,concrete_constants(X)), | |
| 2833 | translate_bstate_to_pred(X,R). | |
| 2834 | %get_set_up_constants_solution(R) :- | |
| 2835 | % b_interpreter: b_set_up_concrete_constants(X,_), | |
| 2836 | % translate:translate_bstate(X,R). | |
| 2837 | ||
| 2838 | add_or_between_constant_predicates([],'1=1'). | |
| 2839 | add_or_between_constant_predicates(L,Res) :- | |
| 2840 | tools: ajoin_with_sep(L,' or ',Res). | |
| 2841 | ||
| 2842 | filter_constants_bindings(EState,R) :- | |
| 2843 | b_get_machine_all_constants(C), | |
| 2844 | convert_typed_varlist(C,CVarList,_CTypes), | |
| 2845 | filter_constants_bindings1(EState,CVarList,R). | |
| 2846 | ||
| 2847 | filter_constants_bindings1([],_,[]). | |
| 2848 | filter_constants_bindings1([bind(Ident,Val)|T],CVarList,Res) :- | |
| 2849 | (member(Ident,CVarList) -> Res = [bind(Ident,Val)|Rest]; Res = Rest), | |
| 2850 | filter_constants_bindings1(T,CVarList,Rest). | |
| 2851 | ||
| 2852 | convert_typed_varlist([],[],[]). | |
| 2853 | convert_typed_varlist([b(identifier(ID),Type,_)|T],[ID|IT],[Type|TT]) :- | |
| 2854 | %print(ID), print(' : '), print(Type),nl, | |
| 2855 | % db : set(couple(global(Name),global(Code))) a : set(integer) boolean | |
| 2856 | convert_typed_varlist(T,IT,TT). | |
| 2857 | %-------------------------------------- | |
| 2858 | ||
| 2859 | ||
| 2860 | :- use_module(symsrc(symmetry_marker),[type_allows_for_precise_marker/1]). | |
| 2861 | :- use_module(bmachine,[b_is_unused_constant/1]). | |
| 2862 | :- use_module(library(codesio),[format_to_codes/3]). | |
| 2863 | :- use_module(kernel_card_arithmetic,[safe_mul/3]). | |
| 2864 | generate_typing_list([],[],[],1). | |
| 2865 | generate_typing_list([Var|VT],[BasicType|TT],[Translation|Rest],TotCard) :- | |
| 2866 | pretty_type(BasicType,PrettyType), | |
| 2867 | (kernel_objects:max_cardinality(BasicType,Card) -> true ; Card='??'), | |
| 2868 | (b_get_constant_represented_inside_global_set(Var,BasicType) | |
| 2869 | -> Imp='(treated as enumerated) ' | |
| 2870 | ; (preference(symmetry_mode,hash), | |
| 2871 | \+type_allows_for_precise_marker(BasicType)) | |
| 2872 | -> Imp = '(IMPRECISE for HASH) ' | |
| 2873 | ; Imp = '' | |
| 2874 | ), | |
| 2875 | (non_det_constant(Var) | |
| 2876 | -> MulSol ='[multiple solutions in SETUP_CONSTANTS]' | |
| 2877 | ; MulSol=''), | |
| 2878 | (b_is_unused_constant(Var) -> Unused=' (unused)' ; Unused=''), | |
| 2879 | % translate:translate_bexpression(b(member(identifier(Var),BasicType),pred,[]),Translation), | |
| 2880 | format_to_codes('~w:~w [card=~w]~w~w~w',[Var,PrettyType,Card,MulSol,Imp,Unused],Codes), | |
| 2881 | atom_codes(Translation,Codes), | |
| 2882 | generate_typing_list(VT,TT,Rest,RestCard), | |
| 2883 | safe_mul(RestCard,Card,TotCard). | |
| 2884 | ||
| 2885 | :- use_module(symsrc(symmetry_marker),[hash_model_checking_imprecise/2]). | |
| 2886 | :- use_module(translate,[pretty_type/2]). | |
| 2887 | ||
| 2888 | tcltk_hash_model_checking_imprecise :- | |
| 2889 | get_preference(symmetry_mode,hash), | |
| 2890 | hash_model_checking_imprecise(ID,BasicType),!, | |
| 2891 | print(' * Note: Hashing may be imprecise for: '), | |
| 2892 | print(ID), print(' : '),translate:pretty_type(BasicType,S),print(S), print(' !'),nl. | |
| 2893 | ||
| 2894 | ||
| 2895 | /* find constants which are assigned multiple values */ | |
| 2896 | :- dynamic non_det_constant/1. | |
| 2897 | find_non_det_constants :- | |
| 2898 | retractall(non_det_constant(_)), | |
| 2899 | findall(Csts,visited_expression(_,concrete_constants(Csts),_),CL), | |
| 2900 | (CL=[Valuation1|O],O=[_|_] -> find_non_det_constants1(Valuation1,O) | |
| 2901 | ; true /* 0 or 1 valuation only */ | |
| 2902 | ). | |
| 2903 | ||
| 2904 | find_non_det_constants1([],_). | |
| 2905 | find_non_det_constants1([bind(C,Value)|T],Other) :- check_cst(Other, C, Value, PeeledOther), | |
| 2906 | find_non_det_constants1(T,PeeledOther). | |
| 2907 | ||
| 2908 | check_cst([],_,_,[]). | |
| 2909 | check_cst([ [bind(C,OtherVal)|T1] | TT], C, Value, [ T1 | PTT]) :- | |
| 2910 | (Value=OtherVal -> check_cst(TT,C,Value,PTT) | |
| 2911 | ; assertz(non_det_constant(C)), peel2(TT,PTT)). | |
| 2912 | peel2([],[]). | |
| 2913 | peel2([ [_|T1] | TT], [ T1 | PTT]) :- peel2(TT,PTT). | |
| 2914 | ||
| 2915 | ||
| 2916 | /* --------------------------------- */ | |
| 2917 | ||
| 2918 | ||
| 2919 | /* --------------------------------- */ | |
| 2920 | ||
| 2921 | %% | |
| 2922 | % Visualize Invariant... | |
| 2923 | % | |
| 2924 | % Siehe bvisual.pl | |
| 2925 | ||
| 2926 | :- use_module(dotsrc(bvisual),[get_tree_from_expr/4, write_dot_graph_to_file/2]). | |
| 2927 | ||
| 2928 | ||
| 2929 | generate_dot_from_invariant(FileName):- | |
| 2930 | bmachine:b_get_invariant_from_machine(BExpr), | |
| 2931 | write_dot_file_for_pred_expr(BExpr,FileName). | |
| 2932 | ||
| 2933 | ||
| 2934 | :- use_module(b_operation_guards,[get_quantified_operation_enabling_condition/5]). | |
| 2935 | generate_dot_from_operation(TclOpName,FileName) :- | |
| 2936 | adapt_tcl_operation_name(TclOpName,OpName), | |
| 2937 | Simplify=false, | |
| 2938 | get_quantified_operation_enabling_condition(OpName, BExpr, _BecomesSuchVars, _Precise, Simplify), | |
| 2939 | write_dot_file_for_pred_expr(BExpr,FileName). | |
| 2940 | %generate_tree_from_boolean_expression(BExpr, Tree,BecomesSuchVars), | |
| 2941 | %write_dot_graph_to_file(Tree,FileName). | |
| 2942 | ||
| 2943 | % a version with additional parameters and additional pre condition / guard predicate | |
| 2944 | generate_dot_from_operation_with_params(TclOpName,ParameterBindList,RestPreCond, FileName) :- | |
| 2945 | adapt_tcl_operation_name(TclOpName,OpName), | |
| 2946 | Simplify=false, | |
| 2947 | get_quantified_operation_enabling_condition(OpName, BExpr, BecomesSuchVars,_Precise,Simplify), | |
| 2948 | parse_tclk_parameter_values_and_pred(OpName,ParameterBindList,RestPreCond,CustomPredicate), | |
| 2949 | insert_custom_predicate_into_guard(BExpr,CustomPredicate,FullPred), | |
| 2950 | %translate:nested_print_bexpr(FullPred),nl, | |
| 2951 | % TODO: probably allow all variables to be primed in CustomPredicate: | |
| 2952 | b_ast_cleanup:annotate_becomes_such_vars(BecomesSuchVars,CustomPredicate,BSV2), | |
| 2953 | write_dot_file_for_pred_expr(FullPred,FileName,BSV2). | |
| 2954 | ||
| 2955 | insert_custom_predicate_into_guard(b(exists(Para,Body),pred,Info),Pred,Res) :- !, | |
| 2956 | Res = b(exists(Para,BodyRes),pred,Info), % TODO: update wd infos | |
| 2957 | insert_custom_predicate_into_guard(Body,Pred,BodyRes). | |
| 2958 | insert_custom_predicate_into_guard(Guard,CustomPred,FullPred) :- | |
| 2959 | % put CustomPred first so that bvisual prioritises solutions coming from user values/predicate | |
| 2960 | % TODO: we could try and force equalities in CustomPred before calling bvisual | |
| 2961 | conjunct_predicates([CustomPred,Guard],FullPred). | |
| 2962 | ||
| 2963 | :- use_module(bmachine, [ | |
| 2964 | b_get_properties_from_machine/1, | |
| 2965 | b_get_machine_constants/1, | |
| 2966 | b_machine_has_constants_or_properties/0 ]). | |
| 2967 | :- use_module(bsyntaxtree,[create_or_merge_exists/3]). | |
| 2968 | get_properties(BExpr,CreateExists):- | |
| 2969 | b_get_properties_from_machine(Condition), | |
| 2970 | ( (CreateExists=true,b_machine_has_constants_or_properties) -> | |
| 2971 | b_get_machine_constants(IDs), | |
| 2972 | create_or_merge_exists(IDs, Condition, BExpr) | |
| 2973 | ; | |
| 2974 | BExpr = Condition | |
| 2975 | ). | |
| 2976 | ||
| 2977 | generate_dot_from_properties(FileName) :- | |
| 2978 | (current_state_corresponds_to_fully_setup_b_machine -> CreateExists=false; CreateExists=true), | |
| 2979 | get_properties(BExpr,CreateExists), | |
| 2980 | write_dot_file_for_pred_expr(BExpr,FileName). | |
| 2981 | ||
| 2982 | :- use_module(bsyntaxtree,[conjunct_predicates/2]). | |
| 2983 | ||
| 2984 | generate_dot_from_assertions(FileName) :- | |
| 2985 | (current_state_corresponds_to_setup_constants_b_machine, | |
| 2986 | bmachine:b_get_dynamic_assertions_from_machine(BExpr), BExpr \=[] | |
| 2987 | -> true | |
| 2988 | ; bmachine:b_get_static_assertions_from_machine(BExpr) | |
| 2989 | ), | |
| 2990 | conjunct_predicates(BExpr,BE), | |
| 2991 | write_dot_file_for_pred_expr(BE,FileName). | |
| 2992 | ||
| 2993 | generate_dot_from_goal(FileName) :- | |
| 2994 | b_get_machine_goal(BExpr),!, | |
| 2995 | write_dot_file_for_pred_expr(BExpr,FileName,all_primed_vars). | |
| 2996 | generate_dot_from_goal(FileName) :- | |
| 2997 | write_dot_file_for_pred_expr_and_state(b(string('No GOAL DEFINITION available'),string,[]),[],[],FileName). | |
| 2998 | ||
| 2999 | generate_dot_from_deadlock_po(FileName) :- | |
| 3000 | b_state_model_check:get_unsorted_all_guards_false_pred(BExpr), | |
| 3001 | %print('% CHECKING: '),translate_bexpression(BExpr,PT), print(PT),nl, | |
| 3002 | write_dot_file_for_pred_expr(BExpr,FileName). % we do not check it is a predicate anymore | |
| 3003 | ||
| 3004 | ||
| 3005 | generate_dot_from_formula(Pred,FileName) :- | |
| 3006 | debug_format(19,'Parsing formula ~w~n',[Pred]), | |
| 3007 | parse_machine_formula(Pred,TypedExpr), | |
| 3008 | debug_format(19,'Writing dot formula ~w~n',[Pred]), | |
| 3009 | write_dot_file_for_pred_expr(TypedExpr,FileName,all_primed_vars). | |
| 3010 | ||
| 3011 | ||
| 3012 | :- use_module(bmachine, [b_parse_machine_formula/3, type_with_errors/4, get_primed_machine_variables/1]). | |
| 3013 | parse_machine_formula(RawAST,TypedPred) :- compound(RawAST),!, % allow to pass raw AST as well | |
| 3014 | get_primed_machine_variables(PV), | |
| 3015 | type_with_errors(RawAST,[prob_ids(visible),identifier(PV),variables],_Type,TypedPred). | |
| 3016 | parse_machine_formula(PredStr,TypedExpr) :- | |
| 3017 | get_primed_machine_variables(PV), | |
| 3018 | b_parse_machine_formula(PredStr,[prob_ids(visible),identifier(PV),variables],TypedExpr). | |
| 3019 | ||
| 3020 | ||
| 3021 | write_dot_file_for_pred_expr(BExpr,FileName) :- | |
| 3022 | write_dot_file_for_pred_expr(BExpr,FileName,[]). | |
| 3023 | write_dot_file_for_pred_expr(BExpr,FileName,BecomesSuchVars) :- | |
| 3024 | generate_tree_in_cur_state(BExpr, Tree,BecomesSuchVars), | |
| 3025 | printsilent('% Writing to: '), printsilent(FileName),nls, | |
| 3026 | write_dot_graph_to_file(Tree,FileName). | |
| 3027 | write_dot_file_for_pred_expr_and_state(BExpr, LocalState, State,FileName) :- | |
| 3028 | get_tree_from_expr(Tree, BExpr, LocalState, State), | |
| 3029 | printsilent('% Writing to: '), printsilent(FileName),nls, | |
| 3030 | write_dot_graph_to_file(Tree,FileName). | |
| 3031 | ||
| 3032 | :- use_module(probsrc(state_space),[get_current_predecessor_state_id/1]). | |
| 3033 | :- use_module(probsrc(specfile),[extract_variables_from_state_as_primed/2]). | |
| 3034 | ||
| 3035 | generate_tree_in_cur_state(BExpr,Tree,all_primed_vars) :- | |
| 3036 | (get_current_predecessor_state_id(PredID), | |
| 3037 | visited_expression(PredID,SrcState), | |
| 3038 | extract_variables_from_state_as_primed(SrcState,PrimedVarBindings) | |
| 3039 | -> true | |
| 3040 | ; PrimedVarBindings=[] | |
| 3041 | ), | |
| 3042 | get_current_state_for_b_formula(BExpr,CurState0), | |
| 3043 | extend_state_with_probids_and_lets(CurState0,CurState1), | |
| 3044 | append(PrimedVarBindings,CurState1,CurState), | |
| 3045 | get_tree_from_expr(Tree, BExpr, [], CurState). | |
| 3046 | generate_tree_in_cur_state(BExpr,Tree,BecomesSuchVars) :- | |
| 3047 | get_current_state_for_b_formula(BExpr,CurState0), | |
| 3048 | extend_state_with_probids_and_lets(CurState0,CurState1), | |
| 3049 | % print(cur(CurState1)),nl, | |
| 3050 | insert_before_substitution_variables(BecomesSuchVars,[],CurState1,CurState1,CurState), | |
| 3051 | !, | |
| 3052 | get_tree_from_expr(Tree, BExpr, [], CurState). | |
| 3053 | ||
| 3054 | % generate a dot tree representation for a value; mostly useful for symbolic values | |
| 3055 | write_dot_file_for_value_as_tree(Value,FileName) :- | |
| 3056 | transform_value_to_expr(Value,BExpr), | |
| 3057 | temporary_set_preference(formula_tree_minimal_timeout,5,Prev1), | |
| 3058 | temporary_set_preference(formula_tree_maximal_timeout,30,Prev2), | |
| 3059 | call_cleanup(generate_tree_in_cur_state(BExpr, Tree,[]), | |
| 3060 | (reset_temporary_preference(formula_tree_minimal_timeout,Prev1), | |
| 3061 | reset_temporary_preference(formula_tree_maximal_timeout,Prev2))), | |
| 3062 | printsilent('% Writing to: '), printsilent(FileName),nls, | |
| 3063 | write_dot_graph_to_file(Tree,FileName). | |
| 3064 | ||
| 3065 | :- use_module(probsrc(bsyntaxtree),[create_typed_ids/3]). | |
| 3066 | :- use_module(library(lists),[maplist/4]). | |
| 3067 | transform_value_to_expr(closure(P,T,B),E) :- | |
| 3068 | create_typed_ids(P,T,Parameters),!, | |
| 3069 | E=b(comprehension_set(Parameters,B),set(any),[]). % TO DO: we could create typing | |
| 3070 | transform_value_to_expr(Val,b(value(Val),any,[])). | |
| 3071 | ||
| 3072 | :- use_module(tools,[maplist5/5]). | |
| 3073 | tcltk_bv_get_tops(Tops) :- | |
| 3074 | bv_get_top_level(Tops). | |
| 3075 | tcltk_bv_get_structure(Id,Label,list(Subs)) :- | |
| 3076 | bv_expand_formula(Id,Label,Subs). | |
| 3077 | tcltk_bv_is_leaf(Id,Label) :- | |
| 3078 | bv_expand_formula(Id,Label,[]). | |
| 3079 | tcltk_bv_get_values(Ids,list(RTexts),list(Tags)) :- | |
| 3080 | current_state_id(StateId), | |
| 3081 | bv_get_values(Ids,StateId,Values), | |
| 3082 | maplist5(tcltk_interface:retrieve_tag_adapted_text_for_id,Ids,Values,Tags,RTexts). | |
| 3083 | tcltk_bv_get_value(Id,RText,Tag) :- | |
| 3084 | tcltk_bv_get_values([Id],list([RText]),list([Tag])). | |
| 3085 | tcltk_bv_show_formula_as_dot_tree(Id,File) :- | |
| 3086 | bv_get_stored_formula_expr(Id,TExpr), | |
| 3087 | write_dot_file_for_pred_expr(TExpr,File). | |
| 3088 | tcltk_bv_get_pp_formula_string(Id,PPFormula) :- | |
| 3089 | bv_get_stored_formula_expr(Id,TExpr), | |
| 3090 | translate:translate_bexpression(TExpr,PPFormula). | |
| 3091 | ||
| 3092 | tcltk_bv_show_formula_as_dot_graph(Id,File) :- | |
| 3093 | bv_get_stored_formula_expr(Id,TExpr), | |
| 3094 | get_texpr_type(TExpr,Type), | |
| 3095 | Type \= pred, Type \= subst, | |
| 3096 | % tcltk_show_typed_expression_as_dot_graph decomposes expressions and shows value as graph: could be useful for pre-configured DEFINITIONS | |
| 3097 | tcltk_show_typed_expression_as_dot_graph(TExpr,File). | |
| 3098 | ||
| 3099 | tcltk_bv_show_value_as_dot_tree(Id,File) :- % useful for symbolic values | |
| 3100 | current_state_id(StateId), | |
| 3101 | bv_get_btvalue(Id,StateId,_E,Value), | |
| 3102 | write_dot_file_for_value_as_tree(Value,File). | |
| 3103 | ||
| 3104 | % a variation of tcltk_bv_show_value_as_dot_tree without dependence on bvisual2 | |
| 3105 | tcltk_show_identifier_value_as_dot_tree(RawId,File) :- % this also works if bvisual2 is not set up and entry active | |
| 3106 | get_identifier(RawId,Id), | |
| 3107 | current_expression(_ID,CurState), | |
| 3108 | expand_const_and_vars_to_full_store(CurState,EState), | |
| 3109 | (EState=[] -> add_error(tcltk_show_identifier_value_as_dot_tree,'Initialise machine first, cannot retrieve value for identifier:',Id) | |
| 3110 | ; lookup_value_for_existing_id(Id,EState,Value) | |
| 3111 | -> write_dot_file_for_value_as_tree(Value,File) | |
| 3112 | ; add_error(tcltk_show_identifier_value_as_dot_tree,'Cannot retrieve value for identifier:',Id)). | |
| 3113 | ||
| 3114 | get_identifier(AtomicID,Res) :- atom(AtomicID), valid_id(AtomicID), !,Res=AtomicID. | |
| 3115 | get_identifier(identifier(_,ID),Res) :- valid_id(ID),!, Res=ID. % raw ID from prob2_interface | |
| 3116 | get_identifier(RawFormula,_) :- | |
| 3117 | add_error(tcltk_show_identifier_value_as_dot_tree,'Please provide valid identifier of constant or variable:',RawFormula), | |
| 3118 | fail. | |
| 3119 | valid_id(ID) :- b_is_variable(ID). | |
| 3120 | valid_id(ID) :- b_is_constant(ID). | |
| 3121 | ||
| 3122 | retrieve_tag_adapted_text_for_id(Id,Value,Tag,RText) :- | |
| 3123 | retrieve_tag_text_for_id(Id,Value,Tag,Text), | |
| 3124 | (Text = '[]' -> RText = '[ ]' ; RText=Text). % for some reason the empty sequence translation [] gets transformed into '' by the tcltk library | |
| 3125 | ||
| 3126 | retrieve_tag_text_for_id(Id,Value,FullTag,Text) :- | |
| 3127 | retrieve_tag_text(Value,Tag,Text), | |
| 3128 | (bv_is_explanation_node(Id) -> convert_explain_tag(Tag,FullTag) ; FullTag=Tag). | |
| 3129 | retrieve_tag_text(i, inac, ''). | |
| 3130 | retrieve_tag_text(e(Text), error, Text). | |
| 3131 | retrieve_tag_text(v(Text), value, Text). | |
| 3132 | retrieve_tag_text(p(true), ptrue, true). | |
| 3133 | retrieve_tag_text(p(false),pfalse, false). | |
| 3134 | retrieve_tag_text(bv_info(Text), inac, Text). | |
| 3135 | ||
| 3136 | ||
| 3137 | tcltk_bv_get_unlimited_value(Id,Text,Tag) :- | |
| 3138 | current_state_id(StateId), | |
| 3139 | bv_get_value_unlimited(Id,StateId,Value), | |
| 3140 | retrieve_tag_text_for_id(Id,Value,Tag,Text1), | |
| 3141 | atom_codes(Text1,Text). % TODO: In the end, the result was converted from codes to atom and back | |
| 3142 | ||
| 3143 | % a version which returns just the value as an atom: | |
| 3144 | tcltk_bv_get_unlimited_value_atom(Id,AtomText) :- | |
| 3145 | current_state_id(StateId), | |
| 3146 | bv_get_value_unlimited(Id,StateId,Value), | |
| 3147 | retrieve_tag_text_for_id(Id,Value,_Tag,AtomText). | |
| 3148 | ||
| 3149 | convert_explain_tag(ptrue,explaintrue). | |
| 3150 | convert_explain_tag(pfalse,explainfalse). | |
| 3151 | convert_explain_tag(X,X). | |
| 3152 | ||
| 3153 | % ----------------------------------------- | |
| 3154 | ||
| 3155 | % STILL TO DO: refactor eval from here and probcli into separate module | |
| 3156 | ||
| 3157 | :- dynamic eval_elapsed_time/1. | |
| 3158 | tcltk_time_call(Call) :- | |
| 3159 | cputime(T1),Call,cputime(T2),ElapsedTime is T2-T1, | |
| 3160 | retractall(eval_elapsed_time(_)),assertz(eval_elapsed_time(ElapsedTime)). | |
| 3161 | ||
| 3162 | :- use_module(eval_strings). | |
| 3163 | ||
| 3164 | ||
| 3165 | tcltk_eval(String,StringResult,EnumWarning,Solution) :- | |
| 3166 | get_computed_preference(debug_time_out,DTO), | |
| 3167 | %print(debug_time_out(DTO)),nl, | |
| 3168 | time_out_with_enum_warning_one_solution(eval_string(String,StringResult,EnumWarning,LocalState),DTO,TimeOutRes), | |
| 3169 | (LocalState=[] -> Solution='' ; translate_bstate(LocalState,Solution)), | |
| 3170 | (is_time_out_result(TimeOutRes) -> | |
| 3171 | StringResult = '**** TIME-OUT ****', print(StringResult), print(' ('),print(DTO), print('ms)'),nl, | |
| 3172 | EnumWarning = no | |
| 3173 | ; print_last_info). | |
| 3174 | ||
| 3175 | :- public tcltk_eval_string_in_cur_state/2. | |
| 3176 | tcltk_eval_string_in_cur_state(String,TclValue) :- | |
| 3177 | eval_string_in_cur_state(String,_,Value), | |
| 3178 | convert_value_to_tcl(Value,TclValue). | |
| 3179 | convert_value_to_tcl(int(X),R) :- !, R=X. | |
| 3180 | convert_value_to_tcl(pred_true,R) :- !, R=1. | |
| 3181 | convert_value_to_tcl(pred_false,R) :- !, R=0. | |
| 3182 | convert_value_to_tcl(string(X),R) :- !, R=X. | |
| 3183 | % TO DO: add sets,... | |
| 3184 | convert_value_to_tcl(R,R) :- print(cannot_convert_to_tcl(R,R)),nl. | |
| 3185 | ||
| 3186 | eval_string_in_cur_state(String,Typed,Value) :- | |
| 3187 | %format('Parsing : "~w"~n',[String]), | |
| 3188 | bmachine:parse_expression_raw_or_atom_with_prob_ids(String,Typed), | |
| 3189 | current_state_id(CurID), prob2_interface:get_state(CurID,EState), | |
| 3190 | %print(evaluating_in_state(CurID)),nl, | |
| 3191 | b_compute_expression_with_prob_ids(Typed,EState,Value). | |
| 3192 | ||
| 3193 | % code to translate an expression into a list of lists that can be displayed as a table in Tk | |
| 3194 | % TO DO: make more robust and add more fancy translations | |
| 3195 | :- use_module(extrasrc(table_tools),[expand_and_translate_to_table_for_expr/5]). | |
| 3196 | tcltk_eval_as_table(String,Res) :- | |
| 3197 | eval_string_in_cur_state(String,Typed,Value), | |
| 3198 | Res = list([list(Header)|Table]), | |
| 3199 | expand_and_translate_to_table_for_expr(Typed,Value,Header,Table,['no-row-numbers']). | |
| 3200 | ||
| 3201 | :- use_module(user_interrupts,[interruptable_call/1]). | |
| 3202 | interruptable_tcltk_eval(String,StringResult,EnumWarning,Solution) :- | |
| 3203 | if(interruptable_call(tcltk_eval(String,StringResult,EnumWarning,Solution)),true, | |
| 3204 | (StringResult = 'Error or User-Interrupt', EnumWarning=unknown, Solution='')). | |
| 3205 | ||
| 3206 | % ----------------------------------------- | |
| 3207 | ||
| 3208 | % Options can be a singleton list with: prefix, exact, suffix, fuzzy | |
| 3209 | tcltk_find_value_as_table(String,Options,list([Header|Matches])) :- | |
| 3210 | eval_string_in_cur_state(String,Typed,GoalValue), | |
| 3211 | Header = list(['ID','Kind','MatchPath']), | |
| 3212 | get_texpr_type(Typed,Type), | |
| 3213 | findall(list([ID,Kind,MatchMsg]), | |
| 3214 | (find_value_in_cur_state(GoalValue,Type,Options,match(Kind,ID,PathObj)), | |
| 3215 | translate_bvalue_with_limit(PathObj,1000,PathS), | |
| 3216 | atom_codes(PathS,MatchMsgC), | |
| 3217 | format('* match inside ~w ~w @ path: ~w~n',[Kind,ID,PathS]), | |
| 3218 | atom_codes(MatchMsg,MatchMsgC)),Matches). | |
| 3219 | ||
| 3220 | % find a given value somewhere in a constant or variable value | |
| 3221 | ||
| 3222 | find_value_in_cur_state(GoalValue,Type,Options,match(Kind,ID,PathObj)) :- | |
| 3223 | translate:translate_bvalue(GoalValue,VS), | |
| 3224 | get_current_state_for_b_formula(requires_variables,State), % produce full state | |
| 3225 | member(bind(ID,Value),State), | |
| 3226 | ( bmachine:b_is_variable(ID,IDType), Kind=variable | |
| 3227 | ; bmachine:b_is_constant(ID,IDType), Kind=constant), | |
| 3228 | debug_format(19,'Searching id ~w for ~w~n',[ID,VS]), | |
| 3229 | % TODO check if Type occurs in type of ID | |
| 3230 | find_value(Value,IDType,GoalValue,Type,Options,PathObj). | |
| 3231 | ||
| 3232 | ||
| 3233 | :- use_module(probsrc(kernel_freetypes),[registered_freetype/2]). | |
| 3234 | :- use_module(bsyntaxtree,[is_set_type/2]). | |
| 3235 | :- use_module(kernel_strings,[to_b_string/2]). | |
| 3236 | find_value(Val,Type,GoalVal,Type,Options,Path) :- !, % target and goal type match; to do: unify_types | |
| 3237 | (kernel_objects:equal_object(Val,GoalVal) -> Path = term('$MATCH') | |
| 3238 | ; fuzzy_find_value(Val,Type,GoalVal,Type,Options,Path)). | |
| 3239 | find_value((A,B),couple(TA,TB),GoalVal,Type,Options,Path) :- !, | |
| 3240 | ( find_value(A,TA,GoalVal,Type,Options,PA), | |
| 3241 | Path=','(PA,B) | |
| 3242 | ; find_value(B,TB,GoalVal,Type,Options,PB), | |
| 3243 | Path=','(A,PB)). | |
| 3244 | find_value(rec(Fields),record(FieldTypes),GoalVal,Type,Options,rec([field(Field,Path)])) :- !, | |
| 3245 | member(field(Field,Val),Fields), | |
| 3246 | member(field(Field,TVal),FieldTypes), | |
| 3247 | find_value(Val,TVal,GoalVal,Type,Options,Path). | |
| 3248 | find_value(avl_set(AVL),AType,GoalVal,Type,Options,[Path]) :- !, | |
| 3249 | is_set_type(AType,TA), | |
| 3250 | custom_explicit_sets:avl_member_opt(Value,AVL), % TODO: provide a more proper interface predicate | |
| 3251 | find_value(Value,TA,GoalVal,Type,Options,Path). | |
| 3252 | find_value([H|T],set(TA),GoalVal,Type,Options,[Path]) :- !, | |
| 3253 | member(Value,[H|T]), | |
| 3254 | find_value(Value,TA,GoalVal,Type,Options,Path). | |
| 3255 | find_value(freeval(ID,Case,Val),freetype(ID),GoalVal,Type,Options,freeval(Case,Path)) :- !, | |
| 3256 | (registered_freetype(ID,Cases), | |
| 3257 | member(case(Case,TVal),Cases) -> true | |
| 3258 | ; add_error(find_value,'Illegal freeval:',freeval(ID,Case,Val)),fail | |
| 3259 | ), | |
| 3260 | find_value(Val,TVal,GoalVal,Type,Options,Path). | |
| 3261 | find_value(Val,TypeVal,GoalVal,Type,Options,Path) :- | |
| 3262 | fuzzy_find_value(Val,TypeVal,GoalVal,Type,Options,Path). | |
| 3263 | ||
| 3264 | fuzzy_find_value(Val,_Type,string(GoalAtom),string,[Option|_],term('$FUZZYMATCH'(TargetAtom))) :- | |
| 3265 | GoalAtom \= '', | |
| 3266 | simple_value_to_match(Val), | |
| 3267 | to_b_string(Val,string(TargetAtom)), | |
| 3268 | find_match_string(Option,TargetAtom,GoalAtom). | |
| 3269 | ||
| 3270 | simple_value_to_match(fd(_,_)). | |
| 3271 | simple_value_to_match(string(_)). | |
| 3272 | simple_value_to_match(int(_)). | |
| 3273 | simple_value_to_match(term(_)). | |
| 3274 | simple_value_to_match(freeval(_,_Case,Val)) :- ground(Val), Val=term(_). | |
| 3275 | ||
| 3276 | :- use_module(tools_matching,[fuzzy_match_codes_lower_case/2]). | |
| 3277 | ||
| 3278 | % check whether TargetAtom matches GoalAtom given match option | |
| 3279 | find_match_string(exact,GoalAtom,GoalAtom). | |
| 3280 | find_match_string(prefix,TargetAtom,GoalAtom) :- | |
| 3281 | atom_concat(GoalAtom,_,TargetAtom). % use sub_atom ? | |
| 3282 | find_match_string(suffix,TargetAtom,GoalAtom) :- | |
| 3283 | atom_concat(_,GoalAtom,TargetAtom). | |
| 3284 | find_match_string(infix,TargetAtom,GoalAtom) :- | |
| 3285 | sub_atom(TargetAtom,_Before,Length,_After,GoalAtom), Length>0. | |
| 3286 | find_match_string(fuzzy,TargetAtom,GoalAtom) :- | |
| 3287 | atom_codes(TargetAtom,TC), | |
| 3288 | atom_codes(GoalAtom,GC), | |
| 3289 | fuzzy_match_codes_lower_case(TC,GC). | |
| 3290 | % TODO: regex | |
| 3291 | ||
| 3292 | ||
| 3293 | :- use_module(prob2_interface, [get_possible_completions/3]). | |
| 3294 | % ID can be col$, svg$, ... (TODO: maybe pass category names directly ? svg_colors_only, ...) | |
| 3295 | tcltk_get_possible_completions(ID,list(Completions)) :- | |
| 3296 | get_possible_completions(ID,[],L), | |
| 3297 | findall(C,member(completion(C,_Category),L),CL), | |
| 3298 | sort(CL,Completions). | |
| 3299 | ||
| 3300 | % ----------------------------------------- | |
| 3301 | % B Simplifier | |
| 3302 | :- use_module(probporsrc(b_simplifier),[tcltk_simplify_b_predicate/2]). | |
| 3303 | tcltk_simplify_predicate(String,StringResult) :- | |
| 3304 | tcltk_simplify_b_predicate(String,StringResult). | |
| 3305 | ||
| 3306 | ||
| 3307 | % ----------------------------------------- | |
| 3308 | % CBC Check | |
| 3309 | ||
| 3310 | get_cbc_data_base_id_checks(IDs) :- | |
| 3311 | findall(ID,b_state_model_check: cbc_check(ID,_Text,_Call,_Res,_Ok),IDs). | |
| 3312 | get_cbc_data_base_text_checks(Strings) :- | |
| 3313 | findall(Text1,(b_state_model_check: cbc_check(_ID,Text,_Call,_Res,_Ok),tools: string_concatenate(Text,';',Text1)),Strings). | |
| 3314 | ||
| 3315 | ||
| 3316 | % ----------------------------------------- | |
| 3317 | ||
| 3318 | % CSP Refinement Search | |
| 3319 | ||
| 3320 | %:- dynamic tcltk_cspm_mode/0. | |
| 3321 | %set_tcltk_cspm_mode :- assertz(tcltk_cspm_mode). | |
| 3322 | %unset_tcltk_cspm_mode :- retractall(tcltk_cspm_mode). | |
| 3323 | ||
| 3324 | ||
| 3325 | %get_new_csp_process_id(E,File,ID) :- | |
| 3326 | % ( parse_single_csp_expression_file(E,File,Proc) -> | |
| 3327 | % haskell_csp: check_compiled_term(Proc), add_csp_process_id1(Proc,ID,haskell_csp:animatable_process) | |
| 3328 | % ; add_error(parse_single_csp_expression_file,'Invalid process expression: ',E),fail | |
| 3329 | % ). | |
| 3330 | ||
| 3331 | %parse_and_analyze_process_expression(ProcExp,File,Proc) :- | |
| 3332 | % ( parse_single_csp_expression_file(ProcExp,File,Proc) -> true | |
| 3333 | % ; add_error(parse_single_csp_expression_file,'Invalid process expression: ',ProcExp),fail | |
| 3334 | % ). | |
| 3335 | ||
| 3336 | get_csp_process_id(Process,ID) :- get_start_transition_term(Process,Trans), | |
| 3337 | transition(root,Trans,ID). | |
| 3338 | ||
| 3339 | :- use_module(probcspsrc(haskell_csp),[animatable_process_without_arguments/1,animatable_process_cli/1]). | |
| 3340 | add_csp_process_id(Process,NewID) :- | |
| 3341 | add_csp_process_id1(Process,NewID,animatable_process_cli). | |
| 3342 | ||
| 3343 | add_csp_process_id1(Process,NewID,Pred) :- | |
| 3344 | (call(Pred,Process) | |
| 3345 | -> get_start_transition_term(Process,Trans), | |
| 3346 | (transition(root,Trans,_,DestID) -> NewID=DestID % process already set up | |
| 3347 | ; xtl_interface:get_start_expr(Process,NewState), | |
| 3348 | add_trans_id(root,Trans,NewState,NewID,_) | |
| 3349 | ) | |
| 3350 | ; add_error_fail(add_csp_process_id,'Not an animatable CSP Process: ',Process)). | |
| 3351 | ||
| 3352 | get_start_transition_term('MAIN',R) :- !, R= start_cspm_MAIN. | |
| 3353 | get_start_transition_term(agent_call(_Src,'MAIN',[]),R) :- !, R= start_cspm_MAIN. | |
| 3354 | get_start_transition_term(P,start_cspm(P)). | |
| 3355 | ||
| 3356 | add_csp_general_process_id(val_of(Process,_),ID) :- !, | |
| 3357 | ( animatable_process_without_arguments(Process) % in case the called processes is one without arguments, then we don't have to parse the expression | |
| 3358 | -> add_csp_process_id(Process,ID) | |
| 3359 | % code below not covered; loaded_main_file only defined for probcli entry point ! | |
| 3360 | %; animation_mode(cspm), | |
| 3361 | % loaded_main_file(CSPFile), | |
| 3362 | % parse_and_analyze_process_expression(Process,CSPFile,Proc), | |
| 3363 | % (transition(root,start_cspm(Proc),_TransID,ID) -> true | |
| 3364 | % ; otherwise -> add_trans_id(root,start_cspm(Proc),Proc,ID,_) | |
| 3365 | % ) | |
| 3366 | ). | |
| 3367 | add_csp_general_process_id(GenProcExpr,ID) :- | |
| 3368 | % stripping out the source-loc info | |
| 3369 | haskell_csp_analyzer: clear_span(GenProcExpr,GenProcExpr1), | |
| 3370 | get_start_transition_term(GenProcExpr1,Trans), | |
| 3371 | (transition(root,Trans,_TransID,ID) | |
| 3372 | -> true | |
| 3373 | ; add_trans_id(root,Trans,GenProcExpr1,ID,_) | |
| 3374 | ). | |
| 3375 | ||
| 3376 | :- public tcltk_csp_in_situ_refinement/4. | |
| 3377 | tcltk_csp_in_situ_refinement(ImplProcess,AbsProcess,ResTrace,Style) :- | |
| 3378 | format('Checking ~w ~w ~w~n',[AbsProcess,Style,ImplProcess]), | |
| 3379 | tcltk_csp_in_situ_refinement(ImplProcess,AbsProcess,ResTrace,Style,10000000). | |
| 3380 | csp_ref_style('[T=',trace). % Trace Refinement | |
| 3381 | csp_ref_style('T',trace). % Trace Refinement | |
| 3382 | csp_ref_style('[SF=',singleton_failures). % Singleton Failures Refinement | |
| 3383 | csp_ref_style('[F=',failures). % Failures Refinement | |
| 3384 | csp_ref_style('[R=',refusals). % Refusals Refinement | |
| 3385 | csp_ref_style('[RD=',refusals_div). % Refusals-Divergence Refinement | |
| 3386 | csp_ref_style('F',failures). % Failures Refinement | |
| 3387 | csp_ref_style('[FD=',X) :- csp_ref_style('FailureDivergence',X). | |
| 3388 | csp_ref_style('FD',X) :- csp_ref_style('FailureDivergence',X). | |
| 3389 | csp_ref_style('Trace',trace). | |
| 3390 | csp_ref_style('Failure',failures). | |
| 3391 | csp_ref_style('FailureDivergence',failure_divergences). | |
| 3392 | csp_ref_style('RefusalTesting',refusals). | |
| 3393 | csp_ref_style('RefusalTestingDiv',refusals_div). | |
| 3394 | csp_ref_style('RevivalTesting',revival) :- add_error(unsupported_refinement_operator,'[V= refinement not yet supported.'). | |
| 3395 | csp_ref_style('RevivalTestingDiv',revival_div) :- add_error(unsupported_refinement_operator,'[VD= refinement not yet supported.'). | |
| 3396 | ||
| 3397 | translate_csp_ref_style(Style,RefStyle) :- (csp_ref_style(Style,RefStyle) -> true ; | |
| 3398 | add_error_fail(csp,'Unknown refinement style: ',Style)). | |
| 3399 | ||
| 3400 | :- use_module(extrasrc(refinement_checker),[in_situ_ref_search/5]). | |
| 3401 | ||
| 3402 | % tcltk_csp_in_situ_refinement('P','Q',R,0,1000). tcltk_csp_in_situ_refinement('Q','P',R,1000). | |
| 3403 | tcltk_csp_in_situ_refinement(ImplProcess,AbsProcess,ResTrace,Style,MaxNrOfNewNodes) :- | |
| 3404 | add_csp_process_id(ImplProcess,ImplNodeID), | |
| 3405 | add_csp_process_id(AbsProcess,SpecNodeID), | |
| 3406 | translate_csp_ref_style(Style,RefStyle), | |
| 3407 | in_situ_ref_search(ImplNodeID,SpecNodeID,ResTrace,RefStyle,MaxNrOfNewNodes). | |
| 3408 | ||
| 3409 | :- use_module(probcspsrc(haskell_csp),[get_csp_assertions/1,translate_csp_assertion/2]). | |
| 3410 | ||
| 3411 | tcltk_check_csp_assertions(List,Summary) :- get_csp_assertions(Assertions), | |
| 3412 | treat_csp_ass(Assertions,List,0,0,0,Summary). % TO DO: display _List | |
| 3413 | ||
| 3414 | treat_csp_ass([],[],T,F,U,[total/Tot, true/T, false/F, unknown/U]) :- Tot is T+F+U. | |
| 3415 | treat_csp_ass([Assertion|T],['='(PP,Ok)|TPP],True,False,U,Summary) :- !, | |
| 3416 | (checkAssertion(Assertion,PP,_,Ok,_) | |
| 3417 | -> ( Ok=true -> T1 is True+1, F1=False, U1=U | |
| 3418 | ; Ok=false -> T1=True, F1 is False+1, U1=U | |
| 3419 | ; T1=True, F1=False, U1 is U+1) | |
| 3420 | ; U1 is U+1, T1=True, PP = '??', | |
| 3421 | F1=False,Ok=unknown | |
| 3422 | ), | |
| 3423 | treat_csp_ass(T,TPP,T1,F1,U1,Summary). | |
| 3424 | treat_csp_ass([H|T],TP,T1,F1,U,Summary) :- | |
| 3425 | add_error(treat_csp_ass,'Unknown CSP assertion: ',H), | |
| 3426 | U1 is U+1, treat_csp_ass(T,TP,T1,F1,U1,Summary). | |
| 3427 | ||
| 3428 | % assertModelCheckExt(False,val_of(P3,src_span(25,8,25,10,562,2)),DeadlockFree,F) | |
| 3429 | ||
| 3430 | :- use_module(extrasrc(refinement_checker),[in_situ_model_check/5, reset_refinement_checker/0]). | |
| 3431 | ||
| 3432 | run_assertion_check(assertModelCheckExt(Negated,Spec,Type,ModelStyle),Negated,ResTrace) :- | |
| 3433 | haskell_csp_analyzer: compile_body(Spec,'assertModelCheck',[],[],CSpec), | |
| 3434 | debug_println(9,assertModelCheckExt(Negated,CSpec,Type,ModelStyle)), | |
| 3435 | add_csp_general_process_id(CSpec,SpecNodeID), | |
| 3436 | translate_csp_ref_style(ModelStyle,RefStyle), | |
| 3437 | in_situ_model_check(SpecNodeID,ResTrace,Type,RefStyle,10000000), | |
| 3438 | formatsilent('Result trace for assertModelCheck: ~w~n',[ResTrace]). | |
| 3439 | run_assertion_check(assertModelCheck(Negated,Spec,Style),Negated,ResTrace) :- | |
| 3440 | run_assertion_check(assertModelCheckExt(Negated,Spec,Style,'FailureDivergence'),Negated,ResTrace). | |
| 3441 | run_assertion_check(assertRef(Negated,Spec,Style,Impl,Span),Negated,ResTrace) :- | |
| 3442 | haskell_csp_analyzer: compile_body(Spec,'assertRef',[],[],CSpec), | |
| 3443 | haskell_csp_analyzer: compile_body(Impl,'assertRef',[],[],CImpl), | |
| 3444 | debug_println(9,assertRef(Negated,CSpec,Style,CImpl,Span)), | |
| 3445 | add_csp_general_process_id(CSpec,SpecNodeID), | |
| 3446 | add_csp_general_process_id(CImpl,ImplNodeID), | |
| 3447 | translate_csp_ref_style(Style,RefStyle), | |
| 3448 | refinement_checker:in_situ_ref_search(ImplNodeID,SpecNodeID,ResTrace,RefStyle,10000000). | |
| 3449 | run_assertion_check(assertLtl(Negated,Spec,FormulaAsAtom,_Span),Negated,ResTrace) :- | |
| 3450 | add_csp_process_id_normalized(Spec,'assertLtl',CSpec,CSpecNodeID), | |
| 3451 | %% print(add_csp_general_process_id(Spec,CSpec,SpecNodeID)),nl, | |
| 3452 | tcltk_reset, | |
| 3453 | ltl_model_check_with_ce1(CSpec,FormulaAsAtom,-1,specific_node(CSpecNodeID),Result), | |
| 3454 | translate_ltl_result(Result,ResTrace), | |
| 3455 | debug_println(9,ltl_result(Negated,CSpec,CSpecNodeID,FormulaAsAtom,Result)). | |
| 3456 | run_assertion_check(assertCtl(Negated,Spec,FormulaAsAtom,_Span),Negated,ResTrace) :- | |
| 3457 | add_csp_process_id_normalized(Spec,'assertCtl',CSpec,CSpecNodeID), | |
| 3458 | tcltk_reset, | |
| 3459 | ctl_model_check_with_ce(CSpec,FormulaAsAtom,-1,specific_node(CSpecNodeID),Result,Trace), | |
| 3460 | debug_println(9,ctl_result(Negated,CSpec,CSpecNodeID,FormulaAsAtom,Result)), | |
| 3461 | translate_ctl_result(Result,Trace,ResTrace). | |
| 3462 | ||
| 3463 | checkAssertion(Assertion,PP,Negated,Ok,ResTrace) :- | |
| 3464 | translate_csp_assertion(Assertion,PP), | |
| 3465 | formatsilent('CHECKING ~w~n',[PP]), | |
| 3466 | debug_println(9,checkAssertion(Assertion)), | |
| 3467 | reset_refinement_checker, | |
| 3468 | (run_assertion_check(Assertion,Negated,ResTrace) | |
| 3469 | -> debug_println(9,result(ResTrace)), | |
| 3470 | (ResTrace=no_counter_example | |
| 3471 | -> (Negated = 'False' -> Ok=true ; Ok=false) | |
| 3472 | ; ResTrace=no_counter_example_found | |
| 3473 | -> Ok=interrupted | |
| 3474 | ; ResTrace=[interrupted|_] | |
| 3475 | -> Ok=interrupted, print('*** Execution interrupted by user ***'),nl | |
| 3476 | ; Negated = 'False' -> Ok=false | |
| 3477 | ; Ok=true | |
| 3478 | ), | |
| 3479 | (Ok=true -> printsilent('OK'),nls | |
| 3480 | ; Ok=interrupted -> print('*** UNKNOWN ***'),nl | |
| 3481 | ; print('*** FALSE ***'),nl | |
| 3482 | ) | |
| 3483 | ; add_error_fail(checkAssertion,'Internal Error, Assertion Checking Failed for: ',PP) | |
| 3484 | ). | |
| 3485 | ||
| 3486 | add_csp_process_id_normalized(Spec,Functor,CSpec,CSpecNodeID) :- | |
| 3487 | % stripping out the src_span info | |
| 3488 | haskell_csp_analyzer: clear_span(Spec,SpecNoSpan), | |
| 3489 | haskell_csp_analyzer: compile_body(SpecNoSpan,Functor,[],[],CSpec), | |
| 3490 | add_csp_general_process_id(CSpec,CSpecNodeID). | |
| 3491 | ||
| 3492 | translate_ltl_result(ok,Res) :- !, | |
| 3493 | Res = no_counter_example. | |
| 3494 | translate_ltl_result(no,Res) :- !, | |
| 3495 | Res = no. | |
| 3496 | translate_ltl_result(ce(Atom),Res) :- | |
| 3497 | !, % we have a counter-example for the LTL formula | |
| 3498 | Res=Atom. | |
| 3499 | translate_ltl_result(interrupted,Res) :- | |
| 3500 | !, | |
| 3501 | Res=[interrupted]. | |
| 3502 | translate_ltl_result(Status,_Res) :- | |
| 3503 | add_error_fail(ltl_assertions_result, 'Internal Error: unknown LTL assertion result ', Status). | |
| 3504 | ||
| 3505 | translate_ctl_result(true,_Trace,ResTrace) :- !, | |
| 3506 | ResTrace = no_counter_example. | |
| 3507 | translate_ctl_result(false,ce(Atom),ResTrace) :- !, | |
| 3508 | ResTrace = Atom. | |
| 3509 | translate_ctl_result(interrupted,_TRace,ResTrace) :- | |
| 3510 | !, | |
| 3511 | ResTrace=[interrupted]. | |
| 3512 | translate_ctl_result(Status,_Trace,_ResTrace) :- | |
| 3513 | add_error_fail(ctl_assertions_result, 'Internal Error: unknown CTL assertion result ', Status). | |
| 3514 | ||
| 3515 | ||
| 3516 | tcltk_check_csp_assertion(Assertion,CSPFile,Negated,Result) :- | |
| 3517 | tcltk_check_csp_assertion(Assertion,CSPFile,Negated,_PlTerm,Result). | |
| 3518 | ||
| 3519 | tcltk_check_csp_assertion(Assertion,CSPFile,Negated,PlTerm,Result) :- | |
| 3520 | parse_single_csp_declaration(Assertion,CSPFile,PlTerm), | |
| 3521 | checkAssertion(PlTerm,_PP,Negated,_Ok,Result). | |
| 3522 | ||
| 3523 | :- public tcltk_play_ltl_ctl_counterexample_trace/4. | |
| 3524 | tcltk_play_ltl_ctl_counterexample_trace(Assertion,CSPFile,Type,FairnessChecked) :- | |
| 3525 | announce_event(play_counterexample), | |
| 3526 | ( Type == ltl -> Functor = assertLtl | |
| 3527 | ; Type == ctl -> Functor = assertCtl | |
| 3528 | ; add_error_fail(ltl_ctl_counterexample, 'Internal Error: Model checker type unknown: ',Type)), | |
| 3529 | % constructing the prolog declaration term | |
| 3530 | PlDeclTerm =.. [Functor,_Negated,Spec,FormulaAsAtom,_Span], | |
| 3531 | parse_single_csp_declaration(Assertion,CSPFile,PlDeclTerm), | |
| 3532 | haskell_csp_analyzer: clear_span(Spec,SpecNoSpan), | |
| 3533 | haskell_csp_analyzer: compile_body(SpecNoSpan,'assertLtl',[],[],CSpec), | |
| 3534 | % parsing and preprocessing the LTL/CTL formula | |
| 3535 | parse_and_preprocess_formula(FormulaAsAtom,Type,PF), | |
| 3536 | (is_fairness_implication(PF) -> FairnessChecked='yes'; FairnessChecked='no'), | |
| 3537 | % need to reset history and current state before loading the counter-example | |
| 3538 | tcltk_reset, | |
| 3539 | tcltk_play_counterexample(Type,CSpec,PF). | |
| 3540 | ||
| 3541 | tcltk_play_counterexample(ltl,Spec,Formula) :- !, | |
| 3542 | tcltk_play_ltl_counterexample(Spec,Formula). | |
| 3543 | tcltk_play_counterexample(ctl,Spec,Formula) :- !, | |
| 3544 | tcltk_play_ctl_counterexample(Spec,Formula). | |
| 3545 | tcltk_play_counterexample(Type,Spec,Formula) :- | |
| 3546 | add_error_fail(ltl_ctl_counterexample, 'Internal Error: Unknown domain type: ', (Type,Spec,Formula)). | |
| 3547 | ||
| 3548 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |
| 3549 | ||
| 3550 | ||
| 3551 | %%%% Parse and get LTL formulas from LTL File %%%% | |
| 3552 | get_ltl_formulas_from_file(Filename,Text) :- | |
| 3553 | parse_ltlfile(Filename, Formulas), print(Formulas),nl, | |
| 3554 | translate_ltl_formulas(Formulas,Text). | |
| 3555 | ||
| 3556 | translate_ltl_formulas(Formulas,Text) :- | |
| 3557 | maplist(translate_ltl_formula,Formulas,Strings), | |
| 3558 | haskell_csp: concatenate_string_list(Strings,Text). | |
| 3559 | ||
| 3560 | translate_ltl_formula(formula(_Name,Formula),Text) :- !, | |
| 3561 | pp_ltl_formula(Formula,T), | |
| 3562 | string_concatenate(T,'$',Text). | |
| 3563 | translate_ltl_formula(F,'') :- add_error(get_ltl_formulas_from_file,'Illegal formula: ',F). | |
| 3564 | ||
| 3565 | ||
| 3566 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |
| 3567 | ||
| 3568 | ||
| 3569 | tcltk_explore_csp_process(ProcString,SpecNodeID) :- | |
| 3570 | haskell_csp: parse_single_csp_expression(ltl,ProcString,Res), | |
| 3571 | haskell_csp_analyzer: clear_span(Res,ResNoSpan), | |
| 3572 | haskell_csp_analyzer: compile_body(ResNoSpan,'assertLtl',[],[],CRes), | |
| 3573 | add_csp_general_process_id(CRes,SpecNodeID), | |
| 3574 | refinement_checker:dfs_check(SpecNodeID,_ResTrace,false,false). | |
| 3575 | ||
| 3576 | tcltk_visualize_csp_process(SpecNodeID,F) :- | |
| 3577 | visualize_graph: tcltk_print_csp_process_states_for_dot(F,SpecNodeID). | |
| 3578 | ||
| 3579 | :- dynamic nr_csp_process_state/1. | |
| 3580 | get_csp_process_stats(NrNodes) :- | |
| 3581 | assertz(nr_csp_process_state(0)), | |
| 3582 | count_nodes, | |
| 3583 | nr_csp_process_state(NrNodes), | |
| 3584 | retractall(nr_csp_process_state(_)). | |
| 3585 | ||
| 3586 | count_nodes :- | |
| 3587 | refinement_checker: dvisited(_NodeID), | |
| 3588 | nr_csp_process_state(NrNodes), | |
| 3589 | NewNrNodes is NrNodes +1, | |
| 3590 | retractall(nr_csp_process_state(_)), | |
| 3591 | assertz(nr_csp_process_state(NewNrNodes)), | |
| 3592 | fail. | |
| 3593 | count_nodes. | |
| 3594 | ||
| 3595 | %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | |
| 3596 | ||
| 3597 | tcltk_machine_has_assertions :- | |
| 3598 | ( b_get_static_assertions_from_machine([_|_]); b_get_dynamic_assertions_from_machine([_|_]) ), !. | |
| 3599 | ||
| 3600 | tcltk_unique_top_level_operation(Name) :- b_top_level_operation(Name), | |
| 3601 | \+ (b_top_level_operation(N2), N2 \= Name). | |
| 3602 | ||
| 3603 | tcltk_top_level_operations(list(Res)) :- | |
| 3604 | findall(Name,b_top_level_operation(Name),Names), | |
| 3605 | length(Names,L), | |
| 3606 | (L>5 -> sort(Names,Res) ; Res=Names). | |
| 3607 | ||
| 3608 | tcltk_get_vacuous_guards(list(L)) :- | |
| 3609 | eclipse_interface:get_vacuous_guards(LP), % to do: add source column | |
| 3610 | (LP=[] -> L = ['No vacuous guards'] | |
| 3611 | ; L = [list(['VACUOUS GUARDS'])|L1], | |
| 3612 | findall(list([P]), member(P,LP), L1) | |
| 3613 | ). | |
| 3614 | ||
| 3615 | tcltk_get_vacuous_invariants(list(L)) :- | |
| 3616 | eclipse_interface:get_vacuous_invariants(LP), | |
| 3617 | (LP=[] -> L = ['No vacuous invariants'] | |
| 3618 | ; L = [list(['VACUOUS INVARIANTS'])|L1], | |
| 3619 | findall(list([TP]), (member(P,LP), translate_bexpression(P,TP)), L1) | |
| 3620 | ). | |
| 3621 | ||
| 3622 | tcltk_get_vacuous_invariants_table(list([list(['LHS','Op','RHS','Source'])|L])) :- | |
| 3623 | eclipse_interface:get_vacuous_invariants(LP), | |
| 3624 | LP \= [], !, | |
| 3625 | maplist(get_expr_and_source,LP,L). | |
| 3626 | tcltk_get_vacuous_invariants_table(list(['No vacuous invariants'])). | |
| 3627 | ||
| 3628 | :- use_module(translate,[translate_bexpression_with_limit/3]). | |
| 3629 | :- use_module(error_manager,[get_tk_table_position_info/2]). | |
| 3630 | get_expr_and_source(P,list([TS1,Op,TS2,Src])) :- | |
| 3631 | decompose(P,LHS,Op,RHS), | |
| 3632 | translate_bexpression_with_limit(LHS,150,TS1), | |
| 3633 | translate_bexpression_with_limit(RHS,60,TS2), | |
| 3634 | get_tk_table_position_info(P,Src). | |
| 3635 | ||
| 3636 | decompose(b(implication(LHS,RHS),pred,_),LHS,'=>',RHS) :- !. | |
| 3637 | decompose(b(disjunction(LHS,RHS),pred,_),LHS,'or',RHS) :- !. | |
| 3638 | decompose(LHS,LHS,'?',b(truth,pred,[])). | |
| 3639 | ||
| 3640 | ||
| 3641 | % ------------------- | |
| 3642 | ||
| 3643 | ||
| 3644 | :- use_module(extrasrc(mcts_game_play), [mcts_auto_play/4, mcts_auto_play_available/0]). | |
| 3645 | ||
| 3646 | tcltk_mcts_auto_play :- tcltk_mcts_auto_play(_). | |
| 3647 | tcltk_mcts_auto_play(TransID) :- | |
| 3648 | mcts_auto_play_available, | |
| 3649 | current_state_id(CurID), | |
| 3650 | mcts_auto_play(CurID,ActionAsTerm,TransID,State2), | |
| 3651 | (tcltk_perform_action(CurID,ActionAsTerm,TransID,State2) | |
| 3652 | -> true | |
| 3653 | ; add_error(tcltk_mcts_auto_play,'Cannot perform chosen action:',ActionAsTerm),fail). | |
| 3654 | ||
| 3655 | ||
| 3656 | % ----------------------- | |
| 3657 | ||
| 3658 | ||
| 3659 | :- dynamic current_simb_state/1, simb_history/5. | |
| 3660 | ||
| 3661 | :- use_module(extrasrc(simb_parser)). | |
| 3662 | :- use_module(extrasrc(simb_simulator)). | |
| 3663 | ||
| 3664 | tcltk_start_simulation :- | |
| 3665 | retractall(current_simb_state(_)), | |
| 3666 | retractall(simb_history(_,_,_,_,_)), | |
| 3667 | simb_file_loaded(_),!, | |
| 3668 | tcltk_reset, | |
| 3669 | simb_initial_state(Init), | |
| 3670 | assert(current_simb_state(Init)). | |
| 3671 | tcltk_start_simulation :- add_error(simb,'Cannot start simulation, no SimB file loaded'). | |
| 3672 | ||
| 3673 | % Options: visible, stop_if_time_progresses, stop_if_time_exceeds(T) | |
| 3674 | tcltk_peform_simulation_steps(Nr,ResElapsedTime,StopReason,Opts) :- \+ current_simb_state(_),!, | |
| 3675 | tcltk_start_simulation, | |
| 3676 | tcltk_peform_simulation_steps2(1,0,Nr,ResElapsedTime,StopReason,Opts). | |
| 3677 | tcltk_peform_simulation_steps(Nr,ResElapsedTime,StopReason,Opts) :- | |
| 3678 | tcltk_peform_simulation_steps2(1,0,Nr,ResElapsedTime,StopReason,Opts). | |
| 3679 | ||
| 3680 | tcltk_peform_simulation_steps2(CurStepNr,ElapsedTime,MaxNr,ResElapsedTime,StopReason,Opts) :- | |
| 3681 | stop_simulation(CurStepNr,ElapsedTime,MaxNr,StopReason,Opts), !, | |
| 3682 | (debug_mode(off) -> true | |
| 3683 | ; format('Stop simulation at step ~w after ~w ms~n',[CurStepNr,ElapsedTime]), | |
| 3684 | current_simb_state(State), portray_simb_state(State)), | |
| 3685 | ResElapsedTime = ElapsedTime. | |
| 3686 | tcltk_peform_simulation_steps2(CurStepNr,ElapsedTime,MaxNr,ResElapsedTime,StopReason,Opts) :- | |
| 3687 | (tcltk_peform_simulation_step(Delta,Opts) | |
| 3688 | -> N1 is MaxNr-1, | |
| 3689 | C1 is CurStepNr+1, E1 is ElapsedTime+Delta, | |
| 3690 | tcltk_peform_simulation_steps2(C1,E1,N1,ResElapsedTime,StopReason,Opts) | |
| 3691 | ; % Simulation is deadlocked | |
| 3692 | ResElapsedTime = ElapsedTime, | |
| 3693 | StopReason = deadlock, | |
| 3694 | add_warning(simb,'Simulation is deadlocked at step nr: ',CurStepNr) | |
| 3695 | %,current_simb_state(State), portray_simb_state(State) | |
| 3696 | ). | |
| 3697 | ||
| 3698 | stop_simulation(_,_,Nr,max_steps_reached,_Opts) :- Nr =< 0. | |
| 3699 | stop_simulation(CurStepNr,_,_Nr,time_progresses,Opts) :- CurStepNr>1, | |
| 3700 | member(stop_if_time_progresses,Opts), | |
| 3701 | current_simb_state(State), | |
| 3702 | get_simb_delay_until_next_step(State,Delta), | |
| 3703 | Delta > 0. | |
| 3704 | stop_simulation(_,ElapsedTime,_Nr,max_time_exceeded,Opts) :- | |
| 3705 | member(stop_if_time_exceeds(MaxTime),Opts), | |
| 3706 | ElapsedTime > MaxTime. | |
| 3707 | ||
| 3708 | tcltk_peform_simulation_step(Delta,Opts) :- | |
| 3709 | current_state_id(CurID), % todo: assert/retract in tcltk_peform_simulation_steps | |
| 3710 | retract(current_simb_state(State)),!, | |
| 3711 | simb_update_current_state_id(State,CurID,State2), | |
| 3712 | (simb_perform_step(Opts,State2, TransID, Delta, Probability,NewSimBState) | |
| 3713 | -> true | |
| 3714 | ; assert(current_simb_state(State2)), | |
| 3715 | fail | |
| 3716 | ), | |
| 3717 | assert(current_simb_state(NewSimBState)), | |
| 3718 | save_last_simulation_step(State2,TransID,Delta,Probability), | |
| 3719 | (TransID=none -> true | |
| 3720 | ; tcltk_perform_action(CurID,_,TransID,_) | |
| 3721 | -> true % TODO: add time and maybe activation id store_transition_infos(TransInfo,TransID) | |
| 3722 | ; add_error(simb,'Cannot perform chosen transition:',TransID),fail). | |
| 3723 | ||
| 3724 | % save last simulation state and the transition that was performed from it | |
| 3725 | save_last_simulation_step(LastSimBState,TransID,Delta,Probability) :- | |
| 3726 | tcltk_get_simb_history_length(Len), L1 is Len+1, | |
| 3727 | asserta(simb_history(L1,TransID,Delta,Probability,LastSimBState)). | |
| 3728 | ||
| 3729 | tcltk_get_simb_history_length(Len) :- simb_history(Len,_,_,_,_),!. | |
| 3730 | tcltk_get_simb_history_length(0). | |
| 3731 | ||
| 3732 | % try and go back one simulation step | |
| 3733 | tcltk_backtrack_simulation_step :- | |
| 3734 | retract(simb_history(_,TransID,_Delta,_Prob,LastSimBState)), | |
| 3735 | get_simb_current_state_id(LastSimBState,LastCurID), | |
| 3736 | (TransID = none -> true | |
| 3737 | ; tcltk_can_backtrack_to_state_id(LastCurID) -> tcltk_backtrack | |
| 3738 | ; add_warning(simb,'Animator and simulator not synchronised, cannot step back in animator to state, : ',LastCurID) | |
| 3739 | ), | |
| 3740 | retract(current_simb_state(_)), % TODO: add to forward history | |
| 3741 | assert(current_simb_state(LastSimBState)). | |
| 3742 | ||
| 3743 | tcltk_can_backtrack_simulation_step :- | |
| 3744 | simb_history(_,TransID,_Delta,_Prob,LastSimBState), | |
| 3745 | (TransID=none -> true | |
| 3746 | ; get_simb_current_state_id(LastSimBState,LastCurID), | |
| 3747 | tcltk_can_backtrack_to_state_id(LastCurID)). | |
| 3748 | ||
| 3749 | tk_get_simb_history_entry([Step,Time,Delta,ProbS,ActID,ActionString]) :- | |
| 3750 | simb_history(Step,TransID,Delta,Prob,LastSimBState), | |
| 3751 | (Prob=none -> ProbS = 'det' ; ProbS = Prob), | |
| 3752 | get_simb_current_state_id(LastSimBState,CurID), | |
| 3753 | translate_event_from_src_and_target_id(CurID,TransID,ActionString), | |
| 3754 | get_simb_time(LastSimBState,Time), | |
| 3755 | get_simb_next_activation_term(LastSimBState,ActID,_Params). % TODO: extract number of activations, ... | |
| 3756 | ||
| 3757 | translate_event_from_src_and_target_id(_,none,ActionString) :- !, ActionString='-'. | |
| 3758 | translate_event_from_src_and_target_id(CurID,TransID,ActionString) :- | |
| 3759 | transition(CurID,ActionAsTerm,TransID,NewID), | |
| 3760 | translate_event_with_src_and_target_id(ActionAsTerm,CurID,NewID,40,ActionString). | |
| 3761 | ||
| 3762 | tk_get_simb_history_table(list([list(['Step','Time','Delta','Probability','ActivationID','VisibleEvent'])|RList])) :- | |
| 3763 | findall(list(EntryList),tk_get_simb_history_entry(EntryList),List), | |
| 3764 | reverse(List,RList). | |
| 3765 | ||
| 3766 | simb_perform_step(Opts,State, TransID, Delta, Probability, NewSimBState) :- member(visible,Opts),!, | |
| 3767 | simb_perform_visible_step(State, TransID, Delta, Probability, NewSimBState). | |
| 3768 | simb_perform_step(_,State, TransID, Delta, Probability, NewSimBState) :- | |
| 3769 | simb_perform_step(State, TransID, Delta, Probability, NewSimBState). | |
| 3770 | ||
| 3771 | tcltk_delay_until_next_step(Time) :- | |
| 3772 | current_simb_state(State), !, get_simb_delay_until_next_step(State,Time). | |
| 3773 | tcltk_delay_until_next_step(0). | |
| 3774 | ||
| 3775 | tcltk_simulation_time(Time) :- | |
| 3776 | current_simb_state(State), !, get_simb_time(State,Time). | |
| 3777 | tcltk_simulation_time('-'). | |
| 3778 | ||
| 3779 | tk_get_simb_scheduling_table_stats(Info) :- | |
| 3780 | current_simb_state(State), !, get_simb_scheduling_table_info(State,Info). | |
| 3781 | tk_get_simb_scheduling_table_stats('-'). | |
| 3782 | ||
| 3783 | ||
| 3784 | tk_get_simb_scheduling_table(list([list(['Time(ms)','Prio','ActivationID','Params'])|List])) :- | |
| 3785 | current_simb_state(State),!, %simb_simulator:portray_simb_state(State),nl, | |
| 3786 | findall(list([Time,Prio,ID,ParamStr]),(get_simb_scheduling_entry(State,Time,Prio,ID,Params), | |
| 3787 | get_simb_params(Params,ParamStr)),List). | |
| 3788 | tk_get_simb_scheduling_table(list(['Simulation Not Started'])). | |
| 3789 | ||
| 3790 | get_simb_params([],Res) :- !, Res='-'. | |
| 3791 | get_simb_params(List,ParamString) :- | |
| 3792 | get_param_tokens(List,Tokens), ajoin(Tokens,ParamString). | |
| 3793 | ||
| 3794 | % note we could use translate_bstate_limited; but it inserts spaces/newlines | |
| 3795 | :- use_module(probsrc(translate), [translate_bvalue_with_limit/3]). | |
| 3796 | get_param_tokens([],[]). | |
| 3797 | get_param_tokens([bind(Name,Val)],[Name,'=',ValS]) :- !, | |
| 3798 | translate_bvalue_with_limit(Val,20,ValS). | |
| 3799 | get_param_tokens([bind(Name,Val)|T],[Name,'=',ValS,','|TT]) :- | |
| 3800 | translate_bvalue_with_limit(Val,20,ValS), | |
| 3801 | get_param_tokens(T,TT). | |
| 3802 | ||
| 3803 | tk_get_simb_activations(list([list(['ActivationID','Prio','Kind','After','TransSelection','Guard','Execute'])|List])) :- | |
| 3804 | simb_file_loaded(_),!, | |
| 3805 | findall(list([ID,PrioS,ActKind,AftS,TransSelection,Gs,ExList]), | |
| 3806 | (simb_activation(ID,Prio,ActKind), | |
| 3807 | simb_activation_effect(ID,Execute,AddGuard,TransSelection,After,_ActivationList), | |
| 3808 | get_simb_number_as_str(After,20,AftS), | |
| 3809 | get_simb_number_as_str(Prio,20,PrioS), | |
| 3810 | ajoin_with_sep(Execute,',',ExList), | |
| 3811 | translate_bexpression_with_limit(AddGuard,20,Gs)),List). | |
| 3812 | tk_get_simb_activations(list(['Simulation Not Loaded'])). | |
| 3813 | ||
| 3814 | get_simb_number_as_str(After,Lim,AftS) :- | |
| 3815 | (number(After) -> AftS = After ; translate_bexpression_with_limit(After,Lim,AftS)). | |
| 3816 | ||
| 3817 | % for reacting to clicks in tk_get_simb_activations | |
| 3818 | tk_get_simb_activation_details(Nr,ID,list([list(['Attribute','Value'])|Details])) :- | |
| 3819 | findall(ID, simb_activation(ID,_Prio,_ActKind), List), | |
| 3820 | nth1(Nr,List,ID), | |
| 3821 | findall(list([Attr,Val]),describe_activation(ID,Attr,Val),Details). | |
| 3822 | ||
| 3823 | :- use_module(probsrc(bsyntaxtree), [def_get_texpr_id/2]). | |
| 3824 | ||
| 3825 | describe_activation(ID,id,ID). | |
| 3826 | describe_activation(ID,param,Para) :- | |
| 3827 | simb_activation_params(ID,TParams), | |
| 3828 | member(TID,TParams), def_get_texpr_id(TID,ParaID), | |
| 3829 | get_texpr_type(TID,Type), pretty_type(Type,String), | |
| 3830 | ajoin([ParaID,' : ',String],Para). | |
| 3831 | describe_activation(ID,priority,PrioS) :- | |
| 3832 | simb_activation(ID,Prio,_ActKind),get_simb_number_as_str(Prio,150,PrioS). | |
| 3833 | describe_activation(ID,activationKind,ActKind) :- simb_activation(ID,_Prio,ActKind). | |
| 3834 | describe_activation(ID,additionalGuard,Gs) :- | |
| 3835 | simb_activation_effect(ID,_,AddGuard,_,_After,_),translate_bexpression_with_limit(AddGuard,150,Gs). | |
| 3836 | describe_activation(ID,after,AfterS) :- | |
| 3837 | simb_activation_effect(ID,_,_,_,After,_),get_simb_number_as_str(After,150,AfterS). | |
| 3838 | describe_activation(ID,execute,OpName) :- | |
| 3839 | simb_activation_effect(ID,Execute,_,_TransSelect,_After,_), member(OpName,Execute). | |
| 3840 | describe_activation(ID,transitionSelection,TransSelect) :- | |
| 3841 | simb_activation_effect(ID,_,_,TransSelect,_After,_). | |
| 3842 | describe_activation(ID,activating,Activating) :- | |
| 3843 | simb_activation_effect(ID,_,_,_TransSelect,_After,ActivatingList), | |
| 3844 | member(A,ActivatingList), | |
| 3845 | (atomic(A) -> Activating=A | |
| 3846 | ; A=triggerActivation(A2,_Params,_Prob) -> Activating=A2 % TODO: show params | |
| 3847 | ; member(chooseActivation(A2,Prob),A), get_simb_number_as_str(Prob,30,P2), ajoin([A2,':',P2],Activating)). | |
| 3848 | describe_activation(ID,Option,true) :- | |
| 3849 | simb_activation_options(ID,Options), member(Option,Options). | |
| 3850 | % TODO: extend for all other infos | |
| 3851 | ||
| 3852 | % --------------------- | |
| 3853 | ||
| 3854 | :- use_module(probsrc(tools),[wrap_and_truncate_atom/4,string_escape/2]). | |
| 3855 | :- use_module(dotsrc(dot_graph_generator), [gen_dot_graph/3, list_to_dot_record/2]). | |
| 3856 | :- use_module(probsrc(preferences),[temporary_set_preference/3, reset_temporary_preference/2]). | |
| 3857 | ||
| 3858 | tcltk_print_simb_activation_graph(File) :- | |
| 3859 | (current_simb_state(State) -> true ; State=none), | |
| 3860 | temporary_set_preference(dot_print_self_loops,true,Chng), | |
| 3861 | call_cleanup(gen_dot_graph(File,dot_activation_node(State),dot_activation_trans(State)), | |
| 3862 | reset_temporary_preference(dot_print_self_loops,Chng)). | |
| 3863 | ||
| 3864 | %:- use_module(library(codesio),[format_to_codes/3]). | |
| 3865 | dot_activation_node(State,ID,none,EDesc,record,none,Color) :- | |
| 3866 | simb_activation(ID,Prio,ActKind), | |
| 3867 | simb_activation_effect(ID,Execute,AddGuard,_TransSelection,After,_ActivationList), | |
| 3868 | (get_simb_scheduling_entry(State,Time,_Prio,ID,_) -> Color=purple, ajoin(['* ',Time,' ms *'],TimeS) | |
| 3869 | ; Color=blue, TimeS=none), | |
| 3870 | (After=0 -> EAftSS=none | |
| 3871 | ; get_simb_number_as_str(After,30,AftS),string_escape(AftS,EAftS), atom_concat('after: ',EAftS,EAftSS)), | |
| 3872 | (Prio=1 -> EPrioSS=none | |
| 3873 | ; get_simb_number_as_str(Prio,30,PrioS),string_escape(PrioS,EPrioS),atom_concat('prio: ',EPrioS,EPrioSS)), | |
| 3874 | (Execute=[] -> ExecSS=none | |
| 3875 | ; Execute=[Ex], atom(Ex) -> string_escape(Ex,ExecS), atom_concat('execute: ',ExecS,ExecSS) | |
| 3876 | ; length(Execute,Len) -> ajoin(['execute list: ',Len],ExecSS) | |
| 3877 | ; ExecSS = 'execute: ??' | |
| 3878 | ), | |
| 3879 | (simb_activation_params(ID,TParams), TParams = [_|_], get_texpr_ids(TParams,Params) | |
| 3880 | -> ajoin_with_sep(Params,',',ParamsS), atom_concat('params: ',ParamsS,ParamsSS) | |
| 3881 | ; ParamsSS = none), | |
| 3882 | (AddGuard=b(truth,_,_) -> GuardSS=none | |
| 3883 | ; translate_bexpression_with_limit(AddGuard,30,Gs), string_escape(Gs,EGs), | |
| 3884 | atom_concat('guard: ',EGs,GuardSS)), | |
| 3885 | list_to_dot_record([ID,ParamsSS,TimeS,EPrioSS,ActKind,EAftSS,ExecSS,GuardSS],EDesc). | |
| 3886 | %simb_activation_options(ID,Options). | |
| 3887 | ||
| 3888 | ||
| 3889 | ||
| 3890 | dot_activation_trans(_State,NodeID,Label,SuccNodeID,Color,Style) :- Color=black, | |
| 3891 | simb_activation(NodeID,_,_ActKind), | |
| 3892 | simb_activation_effect(NodeID,_Execute,_AddGuard,_TransSelection,_After,ActivationList), | |
| 3893 | (member(SuccNodeID,ActivationList), simb_activation_id(SuccNodeID),Label = '', Style=solid | |
| 3894 | ; member(triggerActivation(SuccNodeID,_Params,Prob),ActivationList), | |
| 3895 | (Prob=none -> Label = '', Style=solid | |
| 3896 | ; get_simb_number_as_str(Prob,30,Label), Style=dashed) % TODO: show params | |
| 3897 | ; member(List,ActivationList),member(chooseActivation(SuccNodeID,Prob),List), | |
| 3898 | get_simb_number_as_str(Prob,30,Label), Style=dashed | |
| 3899 | ). |