| 1 | % (c) 2016-2025 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, | |
| 2 | % Heinrich Heine Universitaet Duesseldorf | |
| 3 | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) | |
| 4 | :- module(ltsmin,[ltsmin_init/2,ltsmin_init/3,ltsmin_loop/1, | |
| 5 | ltsmin_teardown/2, start_ltsmin/4, | |
| 6 | ltsmin_generate_ltlfile/2, generate_bindings/3]). | |
| 7 | ||
| 8 | :- use_module(library(fastrw),[ fast_buf_read/2]). | |
| 9 | :- use_module(library(codesio), [write_to_codes/2]). | |
| 10 | :- use_module(library(lists)). | |
| 11 | ||
| 12 | :- use_module(extension('ltsmin/ltsmin_c_interface')). | |
| 13 | :- use_module(extension('ltsmin/msg_interop')). | |
| 14 | ||
| 15 | ||
| 16 | :- use_module('../../src/module_information.pl'). | |
| 17 | ||
| 18 | :- use_module(extension('plspec/plspec/plspec_core')). | |
| 19 | :- enable_spec_check(write_matrix/3). | |
| 20 | ||
| 21 | :- use_module(probsrc(specfile)). | |
| 22 | :- use_module(probsrc(bmachine)). | |
| 23 | :- use_module(probsrc(b_read_write_info), [tcltk_read_write_matrix/1]). | |
| 24 | :- use_module(probsrc(debug), [debug_println/2, debug_mode/1, debug_format/3]). | |
| 25 | ||
| 26 | :- use_module(probsrc(typing_tools)). | |
| 27 | %:- enable_all_spec_checks. | |
| 28 | ||
| 29 | :- module_info(group,experimental). | |
| 30 | :- module_info(description,'This is the interface to C code for LTSmin integration.'). | |
| 31 | :- use_module(probsrc(b_state_model_check), [get_guard/2]). | |
| 32 | :- use_module(probsrc(bsyntaxtree), [conjunction_to_list/2, same_texpr/2, | |
| 33 | conjunct_predicates/2, is_truth/1, create_negation/2]). | |
| 34 | %:- use_module(probsrc(system_call), [system_call_keep_open/7]). | |
| 35 | :- use_module(library(process), [process_wait/2]). | |
| 36 | ||
| 37 | :- dynamic label_to_reads/2. | |
| 38 | ||
| 39 | :- spec_pre(msg_interop:write_matrix/3, [c_pointer, | |
| 40 | one_of([ltsmin_matrix(ltsmin_state_label, ltsmin_variable), % state label / guard / LTL matrices | |
| 41 | ltsmin_matrix(ltsmin_transition_group, ltsmin_variable), % read/write matrices | |
| 42 | ltsmin_matrix(ltsmin_state_label, ltsmin_transition_group), % NES / NDS | |
| 43 | ltsmin_matrix(ltsmin_transition_group, ltsmin_state_label), % guard info | |
| 44 | ltsmin_matrix(ltsmin_state_label, ltsmin_state_label), % may be co-enabled | |
| 45 | ltsmin_matrix(ltsmin_transition_group, ltsmin_transition_group)]), % DNA | |
| 46 | any]). | |
| 47 | ||
| 48 | :- defspec(ltsmin_flag, one_of([atom(por), | |
| 49 | atom(g), | |
| 50 | atom(nocache), | |
| 51 | compound(ltl_formula(any))])). | |
| 52 | :- defspec(ltsmin_backend, one_of([atom(sequential), atom(symbolic)])). | |
| 53 | :- defspec(atom_bool, one_of([atom(true), atom(false)])). | |
| 54 | :- defspec(c_pointer, int). | |
| 55 | :- defspec(ltsmin_matrix(X, Y), [tuple([X, list(Y)])]). | |
| 56 | :- defspec(b_pred_ish, compound(bpred(any))). | |
| 57 | ||
| 58 | ltsmin_variable(X) :- | |
| 59 | varname_list(Variables), member(X, Variables). | |
| 60 | :- defspec_pred(ltsmin_variable, ltsmin_variable). | |
| 61 | ||
| 62 | ltsmin_transition_group(X) :- | |
| 63 | get_transition_groups(TGs), member(X, TGs). | |
| 64 | :- defspec_pred(ltsmin_transition_group, ltsmin_transition_group). | |
| 65 | ||
| 66 | ltsmin_state_label(X) :- state_label(X, _, _). | |
| 67 | :- defspec_pred(ltsmin_state_label, ltsmin_state_label). | |
| 68 | ||
| 69 | :- spec_pre(ltsmin_loop/1, [c_pointer]). | |
| 70 | ltsmin_loop(Zocket) :- | |
| 71 | h_zocket2(Zocket, Ret), % this is a C function in ltsmin_c_interface, which does the call-backs to Prolog | |
| 72 | Ret == 0, !, | |
| 73 | ltsmin_loop(Zocket). | |
| 74 | ltsmin_loop(_). | |
| 75 | ||
| 76 | interpose([], _, []). | |
| 77 | interpose([X], _, [X]) :- !. | |
| 78 | interpose([H|T], I, [H,I|IT]) :- | |
| 79 | interpose(T, I, IT). | |
| 80 | ||
| 81 | atom_concat([X], X) :- !. | |
| 82 | atom_concat([H1, H2|T], R) :- | |
| 83 | atom_concat(H1, H2, H), | |
| 84 | atom_concat([H|T], R). | |
| 85 | ||
| 86 | :- spec_pre(get_ltsmin_invariant/2, [var, atom_bool]). | |
| 87 | :- spec_invariant(get_ltsmin_invariant/2, ['return value: an atom containing the flags for invariant checking for ltsmin':atom, | |
| 88 | 'input: true or false describing whether POR is disabled or enabled':atom_bool]). | |
| 89 | get_ltsmin_invariant(LTSminInv, Por) :- | |
| 90 | (Por == false -> Type = invariant ; Type = por_invariant), | |
| 91 | findall(InvLabel, state_label(InvLabel, Type, _AST), InvariantNames), | |
| 92 | (InvariantNames == [] -> Invariant = ['true']; interpose(InvariantNames, ' && ', Invariant)), | |
| 93 | atom_concat(Invariant, Invariant2), | |
| 94 | atom_concat(['--invariant=!is_init || (', Invariant2, ')'], LTSminInv). | |
| 95 | ||
| 96 | ||
| 97 | backend_specific_flags(symbolic, ['--lace-workers=1'], _). | |
| 98 | backend_specific_flags(sequential, FlagsSeq, MoreFlags) :- | |
| 99 | (member(nocache, MoreFlags) -> FlagsSeq = [] ; FlagsSeq = ['-c']). | |
| 100 | ||
| 101 | :- spec_pre(property_flags/4, [atom_bool, atom_bool, atom_bool, var]). | |
| 102 | :- spec_invariant(property_flags/4, ['no deadlock checking':atom_bool, | |
| 103 | 'no invariant checking':atom_bool, | |
| 104 | 'POR active':atom_bool, | |
| 105 | 'resulting flags':[atomic]]). | |
| 106 | property_flags(true, true, _, []). | |
| 107 | property_flags(false, true, _, ['-d']). | |
| 108 | property_flags(true, false, POR, [InvariantFlags]) :- | |
| 109 | get_ltsmin_invariant(InvariantFlags, POR). | |
| 110 | ||
| 111 | ||
| 112 | % TODO: maybe the path should be chosen in another way | |
| 113 | get_path_to_ltl_file('/tmp/prob-ltsmin-formula.ltl'). | |
| 114 | :- use_module(probsrc(system_call),[get_temporary_filename/2]). | |
| 115 | %get_path_to_trace_file('/tmp/prob-ltsmin-trace.gcf'). | |
| 116 | get_path_to_fresh_trace_file(File) :- get_temporary_filename('prob-ltsmin-trace.gcf',File). | |
| 117 | %get_path_to_csv_trace('/tmp/prob-ltsmin-trace.csv'). | |
| 118 | get_path_to_fresh_csv_trace_file(File) :- get_temporary_filename('prob-ltsmin-trace.csv',File). | |
| 119 | get_path_to_fresh_ltsmin_endpoint(File) :- get_temporary_filename('ltsmin.probz',File). | |
| 120 | ||
| 121 | :- spec_pre(ltsmin_flag/2, [ltsmin_flag, var]). | |
| 122 | :- spec_invariant(ltsmin_flag/2, [ltsmin_flag, atom]). | |
| 123 | ltsmin_flag(por, '--por'). | |
| 124 | ltsmin_flag(g, '-g'). | |
| 125 | ltsmin_flag(ltl_formula(_), Flag) :- | |
| 126 | get_path_to_ltl_file(Path), | |
| 127 | atom_concat('--ltl=', Path, Flag). | |
| 128 | ||
| 129 | ||
| 130 | % MoreFlags can contain: por, nocache, g (for guard splitting), ltl_formula(String) | |
| 131 | :- spec_pre(get_ltsmin_flags/6, [ltsmin_backend, atom_bool, atom_bool, [ltsmin_flag], atom, var]). | |
| 132 | :- spec_invariant(get_ltsmin_flags/6, ['symbolic_or_sequential':ltsmin_backend, | |
| 133 | % at least one of the checks has to be false | |
| 134 | 'no deadlock checking':atom_bool, | |
| 135 | 'no invariant checking':atom_bool, | |
| 136 | 'more flags that should be converted to LTSmin flags':[ltsmin_flag], | |
| 137 | 'trace_file':atom, | |
| 138 | 'resulting flags for LTSmin':[atom]]). | |
| 139 | get_ltsmin_flags(Backend, NoDead, NoInv, MoreFlags, TraceFile, ResFlags) :- | |
| 140 | backend_specific_flags(Backend, BackendFlags, MoreFlags), | |
| 141 | (member(por, MoreFlags) -> POR = true ; POR = false), | |
| 142 | property_flags(NoDead, NoInv, POR, PropertyFlags), | |
| 143 | convlist(ltsmin_flag, MoreFlags, EvenMoreFlags), | |
| 144 | TraceFlags = ['--trace', TraceFile], | |
| 145 | append([TraceFlags, BackendFlags, PropertyFlags, EvenMoreFlags], ResFlags). | |
| 146 | ||
| 147 | ||
| 148 | ||
| 149 | :- use_module(probsrc(tools_printing),[print_error/1]). | |
| 150 | :- use_module(probsrc(preferences), [get_preference/2]). | |
| 151 | :- use_module(probsrc(error_manager), [add_warning/3, add_internal_error/2]). | |
| 152 | :- use_module(probsrc(pathes),[runtime_application_path/1]). | |
| 153 | :- use_module(probsrc(pathes_lib), [lib_component_full_path/4]). | |
| 154 | ||
| 155 | :- use_module(library(file_systems),[file_exists/1,delete_file/1]). | |
| 156 | del_temp_file(F) :- (file_exists(F) -> delete_file(F) ; true). | |
| 157 | ||
| 158 | get_tool_name(symbolic, 'prob2lts-sym'). | |
| 159 | get_tool_name(sequential, 'prob2lts-seq'). | |
| 160 | get_tool_name(printtrace, 'ltsmin-printtrace'). | |
| 161 | ||
| 162 | :- spec_pre(start_ltsmin/4, [ltsmin_backend, tuple([atom_bool, atom_bool]), [ltsmin_flag],var]). | |
| 163 | :- spec_invariant(start_ltsmin/4, ['which backend should be used (symbolic or sequential)':ltsmin_backend, | |
| 164 | 'tuple of length 2: no deadlock checking, no invariant checking':tuple([atom_bool, atom_bool]), | |
| 165 | 'more ltsmin flags':[ltsmin_flag], | |
| 166 | 'resulting of LTSmin model-checking':any ]). | |
| 167 | start_ltsmin(Backend, [NoDead, NoInv], MoreFlags,Result) :- | |
| 168 | (NoDead = false, NoInv = false -> | |
| 169 | add_warning(start_ltsmin,'Turning off deadlock checking for LTSmin command: ',Backend), | |
| 170 | NoDead2 = true | |
| 171 | ; NoDead2 = NoDead), | |
| 172 | get_path_to_fresh_ltsmin_endpoint(Endpoint), | |
| 173 | ltsmin:ltsmin_init(Endpoint, Zocket), | |
| 174 | get_path_to_fresh_trace_file(TraceFile), | |
| 175 | get_ltsmin_flags(Backend, NoDead2, NoInv, MoreFlags, TraceFile, Flags), | |
| 176 | (member(ltl_formula(Formula), MoreFlags) | |
| 177 | -> get_path_to_ltl_file(LTLFile), | |
| 178 | ltsmin_generate_ltlfile(Formula, LTLFile) | |
| 179 | ; true), | |
| 180 | preferences:get_preference(path_to_ltsmin, Path), | |
| 181 | runtime_application_path(PROBPATH), | |
| 182 | get_tool_name(Backend, Tool), | |
| 183 | lib_component_full_path(executable, Tool, ltsmin_extension, LTSminCmd), | |
| 184 | debug_format(19,'Creating LTSMin process for: ~w~n',[LTSminCmd]), | |
| 185 | catch( | |
| 186 | process:process_create(LTSminCmd, [Endpoint, '--stats', '--when'|Flags], [process(PID)]), | |
| 187 | % we could add stdout(pipe(STDOut)) option to process_create and try and parse output | |
| 188 | error(existence_error(_,_),E), | |
| 189 | (format(user_error,'process_create exception: ~w~n',[E]), | |
| 190 | format('LTSMIN preference is set to: "~w"~n',[Path]), | |
| 191 | format(' relative to ProB path: "~w"~n',[PROBPATH]), | |
| 192 | format(' using tool: "~w"~n',[Tool]), | |
| 193 | add_error_fail(ltsmin,'Path to LTSmin incorrect (LTSMIN preference) or LTSmin command not installed (copy prob2lts-sym, prob2lts-seq, ltsmin-printtrace from https://github.com/utwente-fmt/ltsmin/releases to ProB\'s lib folder), cannot execute: ',LTSminCmd))), | |
| 194 | ltsmin_loop(Zocket), | |
| 195 | process_wait(PID, ExitStatus), | |
| 196 | (ExitStatus == exit(0) | |
| 197 | -> Result = ltsmin_model_checking_ok | |
| 198 | ; ExitStatus = killed(_) | |
| 199 | -> Result = ltsmin_model_checking_aborted | |
| 200 | ; ExitStatus == exit(1) | |
| 201 | -> get_tool_name(printtrace, PrintTrace), | |
| 202 | lib_component_full_path(executable, PrintTrace, ltsmin_extension, PrintTraceCmd), | |
| 203 | get_path_to_fresh_csv_trace_file(CsvFile), | |
| 204 | format('writing trace to ~w~n', CsvFile), | |
| 205 | catch( | |
| 206 | process:process_create(PrintTraceCmd, [TraceFile, CsvFile, '-s,,'], [process(PID2)]), | |
| 207 | error(existence_error(_,_),E), | |
| 208 | (format(user_error,'process_create exception: ~w~n',[E]), | |
| 209 | add_error_fail(ltsmin,'Path to LTSmin incorrect or ltsmin-printtrace command not installed (copy command from https://github.com/utwente-fmt/ltsmin/releases to ProB\'s lib folder), cannot execute: ',PrintTraceCmd))), | |
| 210 | process_wait(PID2, _ExitStatus2), | |
| 211 | Result = ltsmin_counter_example_found(CsvFile) | |
| 212 | ; add_internal_error('Unexpected LTSmin exit status:',ExitStatus), | |
| 213 | Result = ltsmin_model_checking_aborted | |
| 214 | ), | |
| 215 | del_temp_file(TraceFile), | |
| 216 | del_temp_file(Endpoint), | |
| 217 | format('~w with ~w exited with status: ~w~n',[Tool, Flags, ExitStatus]), | |
| 218 | ltsmin:ltsmin_teardown(Zocket, Endpoint). | |
| 219 | ||
| 220 | ||
| 221 | :- use_module(probsrc(state_space),[get_operation_name_coverage_infos/4]). | |
| 222 | :- public print_ltsmin_stats/0. | |
| 223 | % can be called from ltsmin.c | |
| 224 | print_ltsmin_stats :- | |
| 225 | get_operation_name_coverage_infos(PossibleNr,_FeasibleNr,UncovNr,UncoveredList), | |
| 226 | Cov is PossibleNr - UncovNr, | |
| 227 | format('~w/~w operations covered, uncovered = ~w~n~n',[Cov,PossibleNr,UncoveredList]). | |
| 228 | ||
| 229 | :- dynamic varname_list/1. | |
| 230 | ||
| 231 | :- use_module(probltlsrc(ltl_tools), [temporal_parser/3]). | |
| 232 | ||
| 233 | :- dynamic(inv_state_label_matrix/1). | |
| 234 | :- dynamic(inv_state_label_matrix_for_por/1). | |
| 235 | ||
| 236 | write_to_ltl_file(Formula, Path) :- | |
| 237 | open(Path, write, Stream), | |
| 238 | tell(Stream), | |
| 239 | print(Formula), | |
| 240 | told. | |
| 241 | ||
| 242 | ltsmin_generate_ltlfile(Formula, OutputFile) :- | |
| 243 | %% firstly, wrap the Formula into X(Formula) | |
| 244 | %% this avoids that a property is already considered true | |
| 245 | %% because it is in the artificial initial state | |
| 246 | atom_concat('X(', Formula, XFormula), | |
| 247 | atom_concat(XFormula, ')', FinalFormula), | |
| 248 | format('parsing LTL formula ~a~N', [FinalFormula]), | |
| 249 | setup_ltl_formula(FinalFormula, ResAtom), | |
| 250 | format('done. writing to: ~a~N', [OutputFile]), | |
| 251 | write_to_ltl_file(ResAtom, OutputFile). | |
| 252 | ||
| 253 | ||
| 254 | setup_ltl_formula(Formula, ResAtom) :- | |
| 255 | temporal_parser(Formula, ltl, ParsedFormula), | |
| 256 | ltl_safety:pp_formula_to_ltl2ba_syntax(ParsedFormula, ResAtom). | |
| 257 | ||
| 258 | ||
| 259 | :- spec_pre(ltsmin_init/3, [atom, var, atom]). | |
| 260 | :- spec_pre(ltsmin_init/3, [atom, var, var]). | |
| 261 | :- spec_invariant(ltsmin_init/3, ['the path to the ZMQ endpoint':atom, | |
| 262 | 'return value: a C pointer to a ZMQ zocket':c_pointer, | |
| 263 | 'an LTL formula':atom]). | |
| 264 | ltsmin_init(Endpoint,Zocket, LtlFormula) :- | |
| 265 | (var(LtlFormula) -> true ; setup_ltl_formula(LtlFormula, _)), | |
| 266 | ltsmin_init(Endpoint, Zocket). | |
| 267 | ||
| 268 | :- spec_pre(ltsmin_init/2, [atom, var]). | |
| 269 | :- spec_pre(ltsmin_init/2, [atom, var]). | |
| 270 | :- spec_invariant(ltsmin_init/2, ['the path to the ZMQ endpoint':atom, | |
| 271 | 'return value: a C pointer to a ZMQ zocket':c_pointer]). | |
| 272 | ltsmin_init(Endpoint,Zocket) :- | |
| 273 | loadfr, | |
| 274 | reset_ltsmin_extension, | |
| 275 | split_invariant(ListOfInvariantConjuncts, InvNames, ListOfInvariantConjunctsForPOR, InvNamesForPOR), | |
| 276 | get_state_labels(ListOfInvariantConjuncts, InvNames, invariant, InvStateLabelMatrix), | |
| 277 | get_state_labels(ListOfInvariantConjunctsForPOR, InvNamesForPOR, por_invariant, InvStateLabelMatrixForPOR), | |
| 278 | assertz(inv_state_label_matrix(InvStateLabelMatrix)), | |
| 279 | assertz(inv_state_label_matrix_for_por(InvStateLabelMatrixForPOR)), | |
| 280 | ltsmin_initialize(Endpoint, Zocket). | |
| 281 | ||
| 282 | %assert_dir :- (user:library_directory('.') -> true ; | |
| 283 | %assertz(user:library_directory('.'))). | |
| 284 | ||
| 285 | ||
| 286 | :- use_module(probsrc(runtime_profiler),[profile_single_call/2]). | |
| 287 | :- use_module(probsrc(state_space),[mark_operation_as_covered/1]). | |
| 288 | :- public get_next_states/4. % not sure how this is called | |
| 289 | get_next_states(LongOrPattern, Msg, State,Op) :- % State is a list of bindings | |
| 290 | % TO DO: set_context_state(SomeID) and look if state_error(SomeID,Id,Error) were added | |
| 291 | profile_single_call(Op,ltsmin:compute_successors(Op, State, Succs)), | |
| 292 | length(Succs,NrStates), | |
| 293 | % format(" ~w successor states for ~w~n ~w~n",[NrStates,Op,Succs]),nl, | |
| 294 | (NrStates>0 -> mark_operation_as_covered(Op) ; true), % TO DO: we should probably use another Prolog fact for this; to avoid confusion which operations are covered in ProB's internal statespace | |
| 295 | put_number(Msg, NrStates), | |
| 296 | put_successors(LongOrPattern, Succs, Msg). | |
| 297 | ||
| 298 | ||
| 299 | read_state([],[]). | |
| 300 | read_state([Addr|T], [Arg|R]) :- read_state(T,R), fast_buf_read(Arg,Addr). | |
| 301 | ||
| 302 | :- meta_predicate mnf1(0). | |
| 303 | mnf1(Call) :- %format('Calling ~w~n',[Call]), flush_output, | |
| 304 | if( catch(Call, E, | |
| 305 | (add_internal_error('LTSMin Extension Exception: ',[E]),flush_output,fail) | |
| 306 | ), | |
| 307 | true, | |
| 308 | (add_internal_error('LTSMin Extension Call Failed: ',[Call]),flush_output,fail) | |
| 309 | ). | |
| 310 | ||
| 311 | :- use_module(probsrc(specfile),[csp_with_bz_mode/0]). | |
| 312 | % convert a list of values into a ProB environment [bind(x,Vx),...] | |
| 313 | generate_bound_long_state([CSP|BState],Res) :- csp_with_bz_mode,!, | |
| 314 | Res=csp_and_b(CSP,BoundState), | |
| 315 | varname_list(L), | |
| 316 | %print(gen_bind(BState,L)),nl, | |
| 317 | generate_bindings(BState, L, BoundState). | |
| 318 | /* this needs to be fixed for short states ; | |
| 319 | * it does not get the entire varname list */ | |
| 320 | generate_bound_long_state(BState,BoundState) :- | |
| 321 | varname_list(L), | |
| 322 | generate_bindings(BState, L, BoundState). | |
| 323 | ||
| 324 | generate_bound_state_short_label(BState,Label,BoundState) :- | |
| 325 | label_to_reads(Label, L), | |
| 326 | generate_bindings(BState, L, BoundState). | |
| 327 | ||
| 328 | :- spec_pre(generate_bindings/3, [list(any), list(atom), list(compound(bind(atom, any)))]). | |
| 329 | :- spec_pre(generate_bindings/3, [list(any), list(atom), var]). | |
| 330 | :- spec_pre(generate_bindings/3, [var, var, list(compound(bind(atom, any)))]). | |
| 331 | :- spec_invariant(generate_bindings/3, ['a list of values':list(any), | |
| 332 | 'a list of identifiers':list(atom), | |
| 333 | 'list of identifiers and values, wrapped in functor bind/2':list(compound(bind(atom, any)))]). | |
| 334 | ||
| 335 | :- load_files(library(system), [when(compile_time), imports([environ/2])]). | |
| 336 | :- if(environ(prob_safe_mode,true)). | |
| 337 | :- use_module(probsrc(bmachine),[b_is_variable/2]). | |
| 338 | :- use_module(probsrc(btypechecker), [unify_types_strict/2]). | |
| 339 | :- use_module(probsrc(error_manager),[add_internal_error/2]). | |
| 340 | :- debug_println(19,'TYPE CHECKING LTSMIN BINDINGS:'). | |
| 341 | generate_bindings([], [], []) :- !. | |
| 342 | generate_bindings([H|T], [Name|TN], [bind(Name, H)|R]) :- | |
| 343 | (get_type(Name,Type) | |
| 344 | -> kernel_objects:infer_value_type(H,HType), | |
| 345 | (unify_types_strict(HType,Type) -> true | |
| 346 | ; add_internal_error('Unexpected type for:',id(Name,HType,Type,H)) | |
| 347 | ) | |
| 348 | ; add_internal_error('Unknown identifier:',Name) | |
| 349 | ), | |
| 350 | generate_bindings(T, TN, R). | |
| 351 | ||
| 352 | get_type(Name,Type) :- b_is_variable(Name,Type). | |
| 353 | get_type(Name,Type) :- b_get_machine_constants(Csts), | |
| 354 | member(b(identifier(Name),Type,_),Csts). | |
| 355 | :- else. | |
| 356 | generate_bindings([], [], []) :- !. | |
| 357 | generate_bindings([H|T], [Name|TN], [bind(Name, H)|R]) :- | |
| 358 | generate_bindings(T, TN, R). | |
| 359 | :- endif. | |
| 360 | ||
| 361 | % print callbacks from ltsmin.c to Prolog: | |
| 362 | start_lts_min_call_back(Term) :- debug_mode(on),!, | |
| 363 | format(' ---> LTSMIN callback : ~w~n',[Term]), | |
| 364 | flush_output. | |
| 365 | start_lts_min_call_back(_). | |
| 366 | ||
| 367 | stop_lts_min_call_back(Term) :- debug_mode(on),!, | |
| 368 | format(' ---> LTSMIN callback FINISHED : ~w~n',[Term]), | |
| 369 | flush_output. | |
| 370 | stop_lts_min_call_back(_). | |
| 371 | ||
| 372 | :- public get_successors_short/3. % called from C code | |
| 373 | % implements R2W | |
| 374 | get_successors_short(Msg, OperationA, StateA) :- | |
| 375 | start_lts_min_call_back(get_successors_short(OperationA)), | |
| 376 | mnf1(get_successors_aux(short, Msg, OperationA, StateA)). | |
| 377 | ||
| 378 | :- public get_successors/3. % called from C code | |
| 379 | get_successors(Msg, OperationA, StateA) :- | |
| 380 | start_lts_min_call_back(get_successors(OperationA)), | |
| 381 | mnf1(get_successors_aux(long, Msg, OperationA, StateA)). | |
| 382 | ||
| 383 | get_successors_aux(Type, Msg, OperationA, StateA) :- | |
| 384 | read_state(StateA,State), | |
| 385 | fast_buf_read(Operation,OperationA), | |
| 386 | %print(operation(Operation)),nl, | |
| 387 | % print(successors(Operation, State)),nl, | |
| 388 | (Type == short -> black_magic_short_transformation(Operation, BoundState, State, LongPattern, ShortSucc, Defaults, _, _, _, _, _), ShortOrLong = LongPattern-ShortSucc-Defaults | |
| 389 | ; generate_bound_long_state(State, BoundState), ShortOrLong = long), | |
| 390 | %print(generate(BoundState)),nl, | |
| 391 | (debug:debug_mode(on) | |
| 392 | -> format('~n ** get_successors for ~w (~w)~n',[Operation,ShortOrLong]), | |
| 393 | translate:print_state(BoundState),nl | |
| 394 | ; true), | |
| 395 | get_next_states(ShortOrLong, Msg, BoundState,Operation). | |
| 396 | ||
| 397 | :- public get_state_label/3. % called by C | |
| 398 | get_state_label(Msg, LabelA, StateA) :- | |
| 399 | start_lts_min_call_back(get_state_label(LabelA)), | |
| 400 | mnf1(get_state_label_aux(long, Msg, LabelA, StateA)). | |
| 401 | ||
| 402 | :- public get_state_label_short/3. % called by C | |
| 403 | get_state_label_short(Msg, LabelA, StateA) :- | |
| 404 | start_lts_min_call_back(get_state_label_short(LabelA)), | |
| 405 | mnf1(get_state_label_aux(short, Msg, LabelA, StateA)). | |
| 406 | ||
| 407 | get_state_label_aux(Type, Msg, LabelA, StateA) :- | |
| 408 | read_state(StateA, State), | |
| 409 | fast_buf_read(Label,LabelA), %print(get_state_label(Label)),nl, | |
| 410 | (Type == long -> generate_bound_long_state(State,BoundState) | |
| 411 | ; generate_bound_state_short_label(State, Label, BoundState)), | |
| 412 | %print(get_state_label_state(Label, BoundState)),nl, | |
| 413 | eval_label(Msg, BoundState,Label). | |
| 414 | ||
| 415 | % NOTE: LTSMin assumes the first transition group is the initialisation action, it is called only once | |
| 416 | % all other events are not called in the initial state | |
| 417 | get_transition_groups(['$init_state'|L]) :- | |
| 418 | (specfile:b_or_z_mode | |
| 419 | -> findall(OperationName, bmachine:b_top_level_feasible_operation(OperationName), BL), | |
| 420 | (csp_with_bz_mode -> L = ['$CSP'|BL] ; L=BL) | |
| 421 | ; L=[]). % FIXME: provide list for CSP-M | |
| 422 | ||
| 423 | extract_name_and_type([],[], []). | |
| 424 | extract_name_and_type([b(identifier(HT),TypeTerm,_)|T], [HT|RT], [TypeTerm|RType]) :- | |
| 425 | extract_name_and_type(T,RT,RType). | |
| 426 | ||
| 427 | /* is that already defined somewhere? */ | |
| 428 | get_ltsmin_variable_names(Names, Types) :- | |
| 429 | bmachine:b_get_machine_variables(V), | |
| 430 | % bmachine:b_get_machine_all_constants(C), % this includes constants which have been moved to deferred sets; causes issue with hanoi model | |
| 431 | bmachine:b_get_machine_constants(C), % this does not include global set constants | |
| 432 | append(V,C,CV), % compatible with b_initialise_machine2 and expand_const_and_vars order | |
| 433 | extract_name_and_type(CV,Names,Types). | |
| 434 | % b_initialise_machine2 puts constants at end to make sharing of complete tail-list easier for successor states | |
| 435 | ||
| 436 | ||
| 437 | ||
| 438 | extract_tg_and_nth_entry([], _, R, R). | |
| 439 | extract_tg_and_nth_entry([list(H)|T], Arg, Acc, R) :- | |
| 440 | nth1(1, H, TransitionGroup), | |
| 441 | nth1(Arg, H, X), | |
| 442 | extract_tg_and_nth_entry(T, Arg, [[TransitionGroup, X]|Acc], R). | |
| 443 | ||
| 444 | % patch matrix for CSP||B | |
| 445 | put_patched_matrix(Msg, Type,M) :- | |
| 446 | patch_matrix(M,PM), | |
| 447 | write_matrix_to_lts_min(Msg, PM, Type). | |
| 448 | ||
| 449 | ||
| 450 | % add $CSP as read/write dependency to matrixes | |
| 451 | % [ [Odd,[]], [Even,[]], [Inc,[count]], [Reset,[count]]] | |
| 452 | patch_matrix(M,Res) :- csp_with_bz_mode, !, | |
| 453 | Res = [ ['$CSP',['$CSP_CHUNK']] | PM], % add virtual CSP transition for CSP only events; TO DO: also allow/treat other pure CSP events; the CSP transition can only modify the $CSP chunk | |
| 454 | maplist(patch_row,M,PM). | |
| 455 | patch_matrix(M,M). | |
| 456 | ||
| 457 | patch_row([Op,Vars], [Op,['$CSP_CHUNK'|Vars]]). | |
| 458 | ||
| 459 | ||
| 460 | build_initial_state(_, VType, VVal) :- | |
| 461 | any_value_for_type(VType, VVal). | |
| 462 | % do not use term undefined in order to avoid guard errors in the initial state | |
| 463 | %VVal = term(undefined). | |
| 464 | ||
| 465 | ||
| 466 | term_to_atom(T, A) :- | |
| 467 | write_to_codes(T, Codes), | |
| 468 | atom_codes(A, Codes). | |
| 469 | ||
| 470 | ||
| 471 | :- use_module(probsrc(b_operation_guards), [get_operation_propositional_guards/3]). | |
| 472 | ||
| 473 | ||
| 474 | guard_seen(G, [H|_]) :- | |
| 475 | same_texpr(G, H), !. | |
| 476 | guard_seen(G, [_|LofG]) :- | |
| 477 | guard_seen(G, LofG). | |
| 478 | ||
| 479 | ||
| 480 | setify_guards(L, R) :- | |
| 481 | setify_guards(L, [], R). | |
| 482 | setify_guards([], Seen, Seen). | |
| 483 | setify_guards([G|RGuards], Seen, Res) :- | |
| 484 | (guard_seen(G, Seen) | |
| 485 | -> setify_guards(RGuards, Seen, Res) | |
| 486 | ; setify_guards(RGuards, [G|Seen], Res)). | |
| 487 | ||
| 488 | ||
| 489 | guard_vector(ListOfListOfGuards, Res) :- | |
| 490 | append(ListOfListOfGuards, ListOfGuards), | |
| 491 | setify_guards(ListOfGuards, Res). | |
| 492 | ||
| 493 | ||
| 494 | get_name([H|_], [Name|_], G, Name) :- | |
| 495 | same_texpr(G, H), !. | |
| 496 | get_name([_|GV], [_|Names], G, R) :- | |
| 497 | get_name(GV, Names, G, R). | |
| 498 | ||
| 499 | ||
| 500 | guards_to_indices(GuardVector, Names, ListOfGuards, ListOfIndices) :- | |
| 501 | maplist(get_name(GuardVector, Names), ListOfGuards, ListOfIndices). | |
| 502 | ||
| 503 | split_guards(Por, ['$init_state'|TransitionGroups], GuardVector, Names, [[]|IndexVectors]) :- | |
| 504 | % if we use POR, the transition group has to be enabled iff all its guards are true; | |
| 505 | % thus, for POR we need to use get_guard that also provides | |
| 506 | % existential quantifications for parameters as additional guards | |
| 507 | (Por == false | |
| 508 | -> maplist(get_ltsmin_guards, TransitionGroups, RGuards, _Bodies) | |
| 509 | ; maplist(get_guard, TransitionGroups, Guards), | |
| 510 | maplist(conjunction_to_list, Guards, RGuards)), | |
| 511 | %% TODO: normalise guards | |
| 512 | guard_vector(RGuards, GuardVector), | |
| 513 | generate_names(GuardVector, 'guard_', Names), % get list [guardN, ..., guard1] | |
| 514 | maplist(guards_to_indices(GuardVector, Names), RGuards, IndexVectors). | |
| 515 | ||
| 516 | :- use_module(probsrc(bsyntaxtree),[always_well_defined/1]). | |
| 517 | get_ltsmin_guards(OpName,Guards,RestBody) :- | |
| 518 | get_preference(ltsmin_guard_splitting,true),!, | |
| 519 | get_operation_propositional_guards(OpName,Guards,RestBody). | |
| 520 | get_ltsmin_guards(OpName,ResGuards,RestBody) :- | |
| 521 | get_operation_propositional_guards(OpName,Guards,RestBody), | |
| 522 | conjunct_predicates(Guards,BigGuard), | |
| 523 | (always_well_defined(BigGuard) | |
| 524 | -> ResGuards = Guards | |
| 525 | ; ResGuards = [BigGuard] % avoid WD errors when splitting guard | |
| 526 | ). | |
| 527 | ||
| 528 | create_matrix([], [], Res, Res) :- !. | |
| 529 | create_matrix([H1|T1], [H2|T2], Acc, Res) :- | |
| 530 | create_matrix(T1, T2, [[H1,H2]|Acc], Res). | |
| 531 | create_matrix(Headings, Entries, Res) :- | |
| 532 | create_matrix(Headings, Entries, [], Res). | |
| 533 | ||
| 534 | ||
| 535 | generate_names(Terms, PrefixAtom, Names) :- | |
| 536 | atom_codes(PrefixAtom, PrefixChars), | |
| 537 | generate_names_aux(Terms, PrefixChars, 1, [], Names). | |
| 538 | generate_names_aux([], _, _, Acc, Acc) :- !. | |
| 539 | generate_names_aux([_|T], Prefix, N, Acc, Res) :- | |
| 540 | number_codes(N, NC), | |
| 541 | append(Prefix, NC, NamedC), | |
| 542 | atom_codes(Named, NamedC), | |
| 543 | N1 is N+1, | |
| 544 | generate_names_aux(T, Prefix, N1, [Named|Acc], Res). | |
| 545 | ||
| 546 | wrap_named_inv(Type, Name, Invariant, state_label(Name, Type, Invariant)). | |
| 547 | :- dynamic state_label/3. | |
| 548 | ||
| 549 | ||
| 550 | assert_all([]). | |
| 551 | assert_all([H|T]) :- | |
| 552 | assertz(H), assert_all(T). | |
| 553 | ||
| 554 | /* need to extract this from the atomic props of the formula, | |
| 555 | we can also use the prolog term of a formula as its state label */ | |
| 556 | get_state_labels(ListOfConjuncts, Names, Type, StateLabelMatrix) :- | |
| 557 | %% format of StateLabelMatrix is | |
| 558 | % [[label1, [id1, id2, ...]] | |
| 559 | % [label2, [id2, id4, ...]] | |
| 560 | % ...] | |
| 561 | maplist(wrap_named_inv(Type), Names, ListOfConjuncts, Facts), | |
| 562 | assert_all(Facts), | |
| 563 | maplist(bsyntaxtree:predicate_identifiers, ListOfConjuncts, SLSVars), | |
| 564 | create_matrix(Names, SLSVars, StateLabelMatrix). | |
| 565 | ||
| 566 | ||
| 567 | :- use_module(probsrc(bmachine),[get_unproven_invariants/1]). | |
| 568 | split_invariant(ListOfInvariantConjuncts, InvNames, ListOfInvariantConjunctsForPOR, InvNamesForPOR) :- | |
| 569 | get_unproven_invariants(ListOfInvariantConjuncts),!, % does now check for INITIALISATION as well | |
| 570 | shorten_inv_list(ListOfInvariantConjuncts,ListOfInvariantConjunctsForPOR), | |
| 571 | generate_names(ListOfInvariantConjunctsForPOR, 'porinv', InvNamesForPOR), | |
| 572 | generate_names(ListOfInvariantConjuncts, 'inv', InvNames), | |
| 573 | (debug_mode(on) -> maplist(portray_invariant,InvNames,ListOfInvariantConjuncts) ; true). | |
| 574 | ||
| 575 | % shorten to maximal 8 invariants, as otherwise ltsmin segfaults | |
| 576 | shorten_inv_list([I1,I2,I3,I4,I5,I6,I7,I8|T],[I1,I2,I3,I4,I5,I6,I7,I8New]) :- T \= [], !, | |
| 577 | length([I8|T],Len), NrInvs is Len+7, | |
| 578 | format('Merging last ~w of ~w invariants (LTSMin POR supports max 8 invariants)~n',[Len,NrInvs]), | |
| 579 | conjunct_predicates([I8|T],I8New). | |
| 580 | shorten_inv_list([],R) :- !, format('No invariants to check~n',[]), R=[]. | |
| 581 | shorten_inv_list(I,I). | |
| 582 | ||
| 583 | :- use_module(probsrc(translate),[translate_bexpression_with_limit/3]). | |
| 584 | portray_invariant(Label,Inv) :- | |
| 585 | translate_bexpression_with_limit(Inv,100,IS), | |
| 586 | format(' ~w : ~w~n',[Label,IS]). | |
| 587 | ||
| 588 | ||
| 589 | :- use_module(probporsrc(static_analysis), [test_path/6, dependent_actions/5]). | |
| 590 | ||
| 591 | does_not_accord_with_aux([], _, []). | |
| 592 | does_not_accord_with_aux([H|T], TransitionGroup, [H|R]) :- | |
| 593 | debug_println(9,check_dependency(H,TransitionGroup)), | |
| 594 | get_preference(timeout_cbc_analysis,TO), | |
| 595 | dependent_actions(H, TransitionGroup, 0, TO, _), !, % TODO: handle interrupts? | |
| 596 | does_not_accord_with_aux(T, TransitionGroup, R). | |
| 597 | does_not_accord_with_aux([_|T], TransitionGroup, R) :- | |
| 598 | does_not_accord_with_aux(T, TransitionGroup, R). | |
| 599 | ||
| 600 | do_not_accord(['$init_state'|TransitionGroups], [[]|DoNotAccordMatrix]) :- | |
| 601 | maplist(does_not_accord_with_aux(TransitionGroups), TransitionGroups, DoNotAccordMatrix). | |
| 602 | ||
| 603 | can_enable(TransitionGroup, Guard, NGuard) :- | |
| 604 | ltsmin_test_path_possible(NGuard, [TransitionGroup], Guard). | |
| 605 | ||
| 606 | ltsmin_test_path_possible(Conjunction,Path,Guard) :- | |
| 607 | get_preference(use_cbc_analysis,true),!, | |
| 608 | get_preference(timeout_cbc_analysis,TO), | |
| 609 | temporary_set_preference(use_chr_solver,true,CHNG1), | |
| 610 | test_path(Conjunction, Path, Guard, 0, TO, Result), | |
| 611 | reset_temporary_preference(use_chr_solver,CHNG1), | |
| 612 | (Result = ok ; Result == timeout ; Result == unknown). | |
| 613 | ltsmin_test_path_possible(_,_,_). % assume possible | |
| 614 | ||
| 615 | ||
| 616 | calculate_enabling_set_aux([], _Guard, _NGuard, []) :- !. | |
| 617 | calculate_enabling_set_aux([Transition|Rest], Guard, NGuard, [Transition|ResList]) :- | |
| 618 | can_enable(Transition, Guard, NGuard), !, | |
| 619 | calculate_enabling_set_aux(Rest, Guard, NGuard, ResList). | |
| 620 | calculate_enabling_set_aux([_|Rest], Guard, NGuard, ResList) :- | |
| 621 | calculate_enabling_set_aux(Rest, Guard, NGuard, ResList). | |
| 622 | ||
| 623 | calculate_enabling_set(TransitionGroupList, Guard, Res) :- | |
| 624 | create_negation(Guard, NGuard), | |
| 625 | calculate_enabling_set_aux(TransitionGroupList, Guard, NGuard, Res). | |
| 626 | ||
| 627 | necessary_enabling_set(GuardVector, ['$init_state'|TransitionGroups], R) :- | |
| 628 | maplist(calculate_enabling_set(TransitionGroups), GuardVector, R). | |
| 629 | ||
| 630 | necessary_disabling_set(GuardVector, TransitionGroups, R) :- | |
| 631 | maplist(create_negation, GuardVector, NGuardVector), | |
| 632 | necessary_enabling_set(NGuardVector, TransitionGroups, R). | |
| 633 | ||
| 634 | ||
| 635 | may_be_coenabled_guards(G1, _G2Name, G2) :- | |
| 636 | conjunct_predicates([G1, G2], Conjunction), | |
| 637 | is_truth(Truth), | |
| 638 | ltsmin_test_path_possible(Conjunction, [], Truth). | |
| 639 | % fail on interrupt | |
| 640 | ||
| 641 | may_be_coenabled2([], [], []). | |
| 642 | may_be_coenabled2([_], [_], []). | |
| 643 | may_be_coenabled2([H|T], [Name|NameRest], [[Name,R]|RT]) :- | |
| 644 | include(may_be_coenabled_guards(H), NameRest, T, R), | |
| 645 | may_be_coenabled2(T, NameRest, RT). | |
| 646 | may_be_coenabled(GuardVector, Names, MayBeCoEnabledMatrix) :- | |
| 647 | % calculates an upper triangle matrix without the elements on the diagonal | |
| 648 | may_be_coenabled2(GuardVector, Names, MayBeCoEnabledMatrix). | |
| 649 | ||
| 650 | :- dynamic(guard_labels/1). | |
| 651 | ||
| 652 | get_label_group_guards(Msg, State) :- | |
| 653 | guard_labels(Labels), | |
| 654 | maplist(eval_label(Msg, State), Labels). | |
| 655 | ||
| 656 | :- public get_state_label_group/3. % this is called from ltmsin.c | |
| 657 | get_state_label_group(Msg, OperationA, StateA) :- | |
| 658 | start_lts_min_call_back(get_state_label_group(OperationA)), | |
| 659 | mnf1(get_state_label_group_aux(Msg, OperationA, StateA)). | |
| 660 | get_state_label_group_aux(Msg, TypeA, StateA) :- | |
| 661 | read_state(StateA,State), | |
| 662 | %print(generate(State)),nl, | |
| 663 | generate_bound_long_state(State,BoundState), | |
| 664 | fast_buf_read(Type,TypeA), | |
| 665 | (debug:debug_mode(on) | |
| 666 | -> format('~n ** get_state_label_group for ~w~n',[Type]), | |
| 667 | translate:print_state(BoundState),nl | |
| 668 | ; true), | |
| 669 | (Type == '1' -> get_label_group_guards(Msg, BoundState) | |
| 670 | ; print(unhandled_group_type(Type)),nl,fail). | |
| 671 | ||
| 672 | get_ltl_labels(ASTs, Names) :- | |
| 673 | findall(ap_representation(Hash, AST), ltl_safety:ap_representation(Hash, AST), APReprs), | |
| 674 | maplist(arg(2), APReprs, ASTs), | |
| 675 | maplist(arg(1), APReprs, Names). | |
| 676 | ||
| 677 | ||
| 678 | :- use_module(probsrc(error_manager), [add_error_fail/3]). | |
| 679 | ||
| 680 | op_to_reads_guard(Op, ReadSet) :- | |
| 681 | get_opname(Op, OpName), | |
| 682 | op_guards(OpName, GuardList), | |
| 683 | maplist(guard_reads, GuardList, ReadSets), | |
| 684 | append(ReadSets, ReadSet). | |
| 685 | ||
| 686 | oplist_to_reads_guards(OpList, ReadSet) :- | |
| 687 | maplist(op_to_reads_guard, OpList, ReadSets), | |
| 688 | append(ReadSets, ReadSet). | |
| 689 | % identifiers might be contained multiple times due to append | |
| 690 | get_ltl_readsets(bpred(X), ReadSet) :- | |
| 691 | bsyntaxtree:predicate_identifiers(X, ReadSet). | |
| 692 | get_ltl_readsets(enabled(Op), ReadSet) :- | |
| 693 | op_to_reads_guard(Op, ReadSet). % get readset of guards of op | |
| 694 | get_ltl_readsets(det(OpList), ReadSet) :- | |
| 695 | oplist_to_reads_guards(OpList, ReadSet). | |
| 696 | get_ltl_readsets(dlk(OpList), ReadSet) :- | |
| 697 | oplist_to_reads_guards(OpList, ReadSet). | |
| 698 | get_ltl_readsets(ctrl(OpList), ReadSet) :- !, | |
| 699 | oplist_to_reads_guards(OpList, ReadSet). | |
| 700 | get_ltl_readsets(deadlock, ReadSet) :- | |
| 701 | get_transition_groups(OpList), | |
| 702 | oplist_to_reads_guards(OpList, ReadSet). | |
| 703 | get_ltl_readsets(AP,_) :- !, | |
| 704 | add_error_fail(ltsmin, 'operation is not supported for LTSmin', AP). | |
| 705 | ||
| 706 | :- dynamic(guard_reads/2). | |
| 707 | ||
| 708 | assert_guard_readsets([]). | |
| 709 | assert_guard_readsets([[GuardName, ReadSet]|R]) :- | |
| 710 | assertz(guard_reads(GuardName, ReadSet)), | |
| 711 | assert_guard_readsets(R). | |
| 712 | ||
| 713 | :- dynamic(op_guards/2). | |
| 714 | ||
| 715 | assert_op_guards([], []). | |
| 716 | assert_op_guards([Op|T], [GuardList|T2]) :- | |
| 717 | assertz(op_guards(Op, GuardList)), | |
| 718 | assert_op_guards(T, T2). | |
| 719 | ||
| 720 | :- spec_pre(ltl_to_state_label_matrix/3, [[b_pred_ish], [atom], var]). | |
| 721 | :- spec_invariant(ltl_to_state_label_matrix/3, [[b_pred_ish], [atom], ltsmin_matrix(ltsmin_state_label, ltsmin_variable)]). | |
| 722 | :- spec_post(ltl_to_state_label_matrix/3, [[b_pred_ish], [atom], var], [[b_pred_ish], [atom], ltsmin_matrix(ltsmin_state_label, ltsmin_variable)]). | |
| 723 | ltl_to_state_label_matrix(ListOfAPs, LtlApNames, LtlStateLabelMatrix) :- | |
| 724 | %% format of StateLabelMatrix is | |
| 725 | % [[label1, [id1, id2, ...]] | |
| 726 | % [label2, [id2, id4, ...]] | |
| 727 | % ...] | |
| 728 | maplist(wrap_named_inv(ltl_ap), LtlApNames, ListOfAPs, Facts), | |
| 729 | assert_all(Facts), | |
| 730 | maplist(get_ltl_readsets, ListOfAPs, SLSVars), | |
| 731 | create_matrix(LtlApNames, SLSVars, LtlStateLabelMatrix). | |
| 732 | ||
| 733 | ||
| 734 | calc_and_append_por_info(false, _Msg, _, _, _) :- !. | |
| 735 | calc_and_append_por_info(_Por, Msg, GuardVector, GuardNames, TransitionGroups) :- | |
| 736 | may_be_coenabled(GuardVector, GuardNames, MayBeCoEnabledMatrix), | |
| 737 | write_matrix_to_lts_min(Msg, MayBeCoEnabledMatrix, may_be_coenabled_matrix), | |
| 738 | ||
| 739 | necessary_enabling_set(GuardVector, TransitionGroups, NES), | |
| 740 | create_matrix(GuardNames, NES, NesMatrix), | |
| 741 | write_matrix_to_lts_min(Msg, NesMatrix, necessary_enabling_set), | |
| 742 | ||
| 743 | necessary_disabling_set(GuardVector, TransitionGroups, NDS), | |
| 744 | create_matrix(GuardNames, NDS, NdsMatrix), | |
| 745 | write_matrix_to_lts_min(Msg, NdsMatrix, necessary_disabling_set), | |
| 746 | ||
| 747 | do_not_accord(TransitionGroups, DNA), | |
| 748 | create_matrix(TransitionGroups, DNA, DnaMatrix), | |
| 749 | write_matrix_to_lts_min(Msg, DnaMatrix, do_not_accord_matrix). | |
| 750 | ||
| 751 | ||
| 752 | sort_by_and_distinct(SortByList, ToBeSortedMayContainDups, SortedUniqs) :- | |
| 753 | findall(X, (member(X, SortByList), member(X, ToBeSortedMayContainDups)), SortedWithDups), | |
| 754 | distinct(SortedWithDups, SortedUniqs). | |
| 755 | ||
| 756 | ||
| 757 | ||
| 758 | :- dynamic black_magic_short_transformation/11. | |
| 759 | % arg 1: Name of Operation | |
| 760 | % arg 2: a pattern in order to create a bound state | |
| 761 | % arg 3: a list of variables that unify the second argument to a bound state | |
| 762 | % arg 4: a long state pattern that can be unified in order to get a short state in arg 5 | |
| 763 | % arg 5: the corresponding short state | |
| 764 | % arg 6: default values in case variables are not written | |
| 765 | % arg 7-11: see arg 2-6, but for next_action | |
| 766 | ||
| 767 | ||
| 768 | % the last argument should be unified with the LTSmin short state values; | |
| 769 | % this way, we acquire a bound state in the second to last argument. | |
| 770 | prepare_binding([], [], [], []). | |
| 771 | prepare_binding([H|AccessedTail], [H|ReadTail], [bind(H, V)|BindingTail], [V|ValTail]) :- !, | |
| 772 | prepare_binding(AccessedTail, ReadTail, BindingTail, ValTail). | |
| 773 | prepare_binding([H|AccessedTail], Reads, [bind(H, term(undefined))|BindingTail], Vals) :- | |
| 774 | prepare_binding(AccessedTail, Reads, BindingTail, Vals). | |
| 775 | ||
| 776 | % TODO: maybe refactor this (pk, 07.03.2018) | |
| 777 | back_to_short([], [], [], [], [], _InitialState). | |
| 778 | back_to_short([bind(H, _)|T], [H|WriteTail], [bind(H, V)|LongStateTail], [bind(H, V)|ShortTail], [bind(H, Default)|DefaultBindingsTail], InitialState) :- !, | |
| 779 | % variable is written to | |
| 780 | memberchk(bind(H, Default), InitialState), | |
| 781 | back_to_short(T, WriteTail, LongStateTail, ShortTail, DefaultBindingsTail, InitialState). | |
| 782 | back_to_short([bind(H, _)|T], Writes, [bind(H, _)|LongStateTail], Short, DefaultBindings, InitialState) :- | |
| 783 | back_to_short(T, Writes, LongStateTail, Short, DefaultBindings, InitialState). | |
| 784 | ||
| 785 | assert_short_state_transformations([], InitialState) :- | |
| 786 | varname_list(L), | |
| 787 | prepare_binding(L, [], PreparedBinding, PreparedVarListForUnification), | |
| 788 | back_to_short(PreparedBinding, L, LongPattern, PreparedShort, InitialState, InitialState), | |
| 789 | assertz(black_magic_short_transformation('$init_state', PreparedBinding, PreparedVarListForUnification, LongPattern, PreparedShort, InitialState, | |
| 790 | PreparedBinding, PreparedVarListForUnification, LongPattern, PreparedShort, InitialState)). | |
| 791 | assert_short_state_transformations([list([Op, ReadsGuard, ReadsAction, MustWrite, MayWrite|_])|T], InitialState) :- | |
| 792 | varname_list(L), | |
| 793 | sort_by_and_distinct(L, ReadsAction, SortedReadsAction), | |
| 794 | append([ReadsGuard, ReadsAction, MustWrite, MayWrite], AllAccessedVarsWithDups), | |
| 795 | append([ReadsAction, MustWrite, MayWrite], AllAccessedVarsForActionWithDups), | |
| 796 | append([ReadsGuard, ReadsAction], AllReadsWithDups), | |
| 797 | append([MustWrite, MayWrite], AllWritesWithDups), | |
| 798 | sort_by_and_distinct(L, AllAccessedVarsWithDups, AllAccessedVars), | |
| 799 | sort_by_and_distinct(L, AllAccessedVarsForActionWithDups, AllAccessedVarsForAction), | |
| 800 | sort_by_and_distinct(L, AllReadsWithDups, AllReads), | |
| 801 | sort_by_and_distinct(L, AllWritesWithDups, AllWrites), | |
| 802 | prepare_binding(AllAccessedVars, AllReads, PreparedBinding, PreparedVarListForUnification), | |
| 803 | prepare_binding(AllAccessedVarsForAction, SortedReadsAction, PreparedBindingForNextAction, PreparedVarListForUnificationForNextActionFactoryProviderSingleton), | |
| 804 | back_to_short(PreparedBinding, AllWrites, LongPattern, PreparedShort, Defaults, InitialState), | |
| 805 | back_to_short(PreparedBindingForNextAction, AllWrites, LongPatternForAction, PreparedShortForNextAction, DefaultsForAction, InitialState), | |
| 806 | assertz(black_magic_short_transformation(Op, PreparedBinding, PreparedVarListForUnification, LongPattern, PreparedShort, Defaults, | |
| 807 | PreparedBindingForNextAction, PreparedVarListForUnificationForNextActionFactoryProviderSingleton, LongPatternForAction, PreparedShortForNextAction, DefaultsForAction)), | |
| 808 | assert_short_state_transformations(T, InitialState). | |
| 809 | ||
| 810 | ||
| 811 | assert_label_to_accessed_vars([]). | |
| 812 | assert_label_to_accessed_vars([[Label,ListOfVars]|T]) :- | |
| 813 | varname_list(L), | |
| 814 | findall(AccessedOrderedVars, (member(AccessedOrderedVars, L), | |
| 815 | member(AccessedOrderedVars, ListOfVars)), | |
| 816 | AccessedVarSet), % poor man's sort-by | |
| 817 | assertz(label_to_reads(Label, AccessedVarSet)), | |
| 818 | assert_label_to_accessed_vars(T). | |
| 819 | ||
| 820 | ||
| 821 | ||
| 822 | ||
| 823 | ||
| 824 | ||
| 825 | distinct(X, Y) :- | |
| 826 | distinct(X, [], Y). | |
| 827 | distinct([], _, []). | |
| 828 | distinct([H|T], Seen, Res) :- | |
| 829 | member(H, Seen), !, | |
| 830 | distinct(T, Seen, Res). | |
| 831 | distinct([H|T], Seen, [H|Res]) :- | |
| 832 | distinct(T, [H|Seen], Res). | |
| 833 | ||
| 834 | ||
| 835 | ||
| 836 | put_read_write_matrices(Msg, MR) :- | |
| 837 | %% read write matrices | |
| 838 | tcltk_read_write_matrix(M), | |
| 839 | (debug:debug_mode(on) -> print(M),nl,flush_output ; true), | |
| 840 | M = list([_Headings|MR]), | |
| 841 | (debug:debug_mode(on) -> print(MR),nl ; true), | |
| 842 | extract_tg_and_nth_entry(MR, 5, [], MayWriteMatrix), | |
| 843 | extract_tg_and_nth_entry(MR, 4, [], MustWriteMatrix), | |
| 844 | extract_tg_and_nth_entry(MR, 3, [], ReadsActionMatrix), | |
| 845 | extract_tg_and_nth_entry(MR, 2, [], ReadsGuardMatrix), | |
| 846 | put_may_write_matrix(Msg, MayWriteMatrix), | |
| 847 | put_patched_matrix(Msg, must_write_matrix,MustWriteMatrix), | |
| 848 | put_patched_matrix(Msg, reads_action_matrix,ReadsActionMatrix), | |
| 849 | put_patched_matrix(Msg, reads_guard_matrix,ReadsGuardMatrix). | |
| 850 | ||
| 851 | assert_short_state_info(MR, InitialState) :- | |
| 852 | varname_list(L), | |
| 853 | generate_bindings(InitialState, L, BoundInitialState), | |
| 854 | assert_short_state_transformations(MR, BoundInitialState). | |
| 855 | ||
| 856 | reset_ltsmin_extension :- | |
| 857 | reset_c_counters, | |
| 858 | retractall(black_magic_short_transformation(_,_,_,_,_,_,_,_,_,_,_)), | |
| 859 | retractall(label_to_reads(_,_)), | |
| 860 | retractall(inv_state_label_matrix(_)), | |
| 861 | retractall(inv_state_label_matrix_for_por(_)), | |
| 862 | retractall(varname_list(_)), | |
| 863 | retractall(op_guards(_, _)), | |
| 864 | retractall(state_label(_, _, _)), | |
| 865 | retractall(guard_labels(_)), | |
| 866 | retractall(guard_reads(_, _)). | |
| 867 | ||
| 868 | :- use_module(probsrc(debug),[formatsilent/2]). | |
| 869 | :- public get_init/2. % called from C | |
| 870 | get_init(Msg, PorInt) :- | |
| 871 | start_lts_min_call_back(get_init(PorInt)), | |
| 872 | (PorInt == 0 -> Por = false ; Por = true), | |
| 873 | get_ltsmin_variable_names(VS, VTypes), | |
| 874 | assertz(varname_list(VS)), | |
| 875 | formatsilent('List of variables for LTSmin (por=~w): ~w~n',[Por,VS]), | |
| 876 | maplist(build_initial_state, VS, VTypes, BInitialState), | |
| 877 | %maplist(any_value_for_type,VTypes,InitialState), | |
| 878 | maplist(term_to_atom, VTypes, VTypeAtoms), | |
| 879 | get_transition_groups(TransitionGroups), | |
| 880 | (csp_with_bz_mode | |
| 881 | -> InitialState = [stop(no_loc_info_available) | BInitialState], % DUMMY Values | |
| 882 | Vars = ['$CSP_CHUNK'|VS], Types = ['csp_process'|VTypeAtoms] | |
| 883 | ; InitialState = BInitialState, | |
| 884 | Vars = VS, Types = VTypeAtoms | |
| 885 | ), | |
| 886 | debug_println(9,initial(InitialState)), | |
| 887 | write_chunklist_to_lts_min(Msg, InitialState, initial_state), | |
| 888 | write_chunklist_to_lts_min(Msg, TransitionGroups, transition_group_list), | |
| 889 | write_chunklist_to_lts_min(Msg, Vars, variables_name_list), % we use $CSP_CHUNK as name for the CSP chunk | |
| 890 | write_chunklist_to_lts_min(Msg, Types, variables_type_list), | |
| 891 | ||
| 892 | ||
| 893 | put_read_write_matrices(Msg, MR), | |
| 894 | assert_short_state_info(MR, InitialState), | |
| 895 | ||
| 896 | (Por == false -> inv_state_label_matrix(InvStateLabelMatrix) | |
| 897 | ; inv_state_label_matrix_for_por(InvStateLabelMatrix)), | |
| 898 | ||
| 899 | %print(slm(InvStateLabelMatrix)),nl, | |
| 900 | %% split guards to state labels | |
| 901 | split_guards(Por, TransitionGroups, GuardVector, GuardNames, IndexVectors), | |
| 902 | get_state_labels(GuardVector, GuardNames, guard, GuardStateLabelMatrix), | |
| 903 | ||
| 904 | % memoize mapping OpName -> GuardNames | |
| 905 | assert_op_guards(TransitionGroups, IndexVectors), | |
| 906 | % memoize mapping GuardName -> ReadSet(Guard) | |
| 907 | assert_guard_readsets(GuardStateLabelMatrix), | |
| 908 | ||
| 909 | reverse(GuardNames, GuardNamesInOrder), | |
| 910 | assertz(guard_labels(GuardNamesInOrder)), | |
| 911 | ||
| 912 | get_ltl_labels(ListOfLabelASTs, LtlApNames), | |
| 913 | ltl_to_state_label_matrix(ListOfLabelASTs, LtlApNames, LtlStateLabelMatrix), | |
| 914 | ||
| 915 | % accessed variable names in order (for short states) | |
| 916 | assert_label_to_accessed_vars(InvStateLabelMatrix), | |
| 917 | assert_label_to_accessed_vars(GuardStateLabelMatrix), | |
| 918 | assert_label_to_accessed_vars(LtlStateLabelMatrix), | |
| 919 | (append([InvStateLabelMatrix, GuardStateLabelMatrix,LtlStateLabelMatrix], []) | |
| 920 | -> InvStateLabelMatrix2 = [[dummy, []]] | |
| 921 | ; InvStateLabelMatrix2 = InvStateLabelMatrix), | |
| 922 | ||
| 923 | ||
| 924 | %% write all state labels (invariant conjuncts and guard conjuncts) | |
| 925 | write_matrix_to_lts_min(Msg, InvStateLabelMatrix2, state_label_matrix), | |
| 926 | write_matrix_to_lts_min(Msg, GuardStateLabelMatrix, guard_label_matrix), | |
| 927 | write_matrix_to_lts_min(Msg, LtlStateLabelMatrix, ltl_label_matrix), | |
| 928 | ||
| 929 | %% create guard info matrix, i.e. which transition depends on which guards | |
| 930 | create_matrix(TransitionGroups, IndexVectors, GuardInfoMatrix), | |
| 931 | write_matrix_to_lts_min(Msg, GuardInfoMatrix, guard_info_matrix), | |
| 932 | calc_and_append_por_info(Por, Msg, GuardVector, GuardNames, TransitionGroups), | |
| 933 | stop_lts_min_call_back(get_init(PorInt)). | |
| 934 | ||
| 935 | ||
| 936 | ||
| 937 | compute_successors('$init_state',_,Result) :- !, | |
| 938 | findall(S,init_state(S),Result), | |
| 939 | debug:debug_println(9,res_init_state(Result)). | |
| 940 | compute_successors(OpName,L,Result) :- | |
| 941 | temporary_set_preference(try_operation_reuse,false,CHNG2), | |
| 942 | % operation reuse done by LTSmin; we would only get no_packed_state_info messages and no benefit | |
| 943 | (debug:debug_mode(on) -> nl,print(compute_successors(OpName)),nl,flush_output ; true), | |
| 944 | findall(S,specfile:specfile_trans(L,OpName,_,S,_,_),Result), | |
| 945 | reset_temporary_preference(try_operation_reuse,CHNG2). | |
| 946 | % this in turn will call b_execute_top_level_operation_update for normal operations | |
| 947 | ||
| 948 | :- public next_action/3. % called from C (ltsmin.c, see init_predicate) | |
| 949 | next_action(Msg, OperationA, StateA) :- | |
| 950 | start_lts_min_call_back(next_action(OperationA)), | |
| 951 | mnf1(next_action_aux(long, Msg, OperationA, StateA)). | |
| 952 | ||
| 953 | :- public next_action_short/3. % called from C (ltsmin.c, see init_predicate) | |
| 954 | next_action_short(Msg, OperationA, StateA) :- | |
| 955 | start_lts_min_call_back(next_action_short(OperationA)), | |
| 956 | mnf1(next_action_aux(short, Msg, OperationA, StateA)). | |
| 957 | next_action_aux(Type, Msg, OperationA, StateA) :- | |
| 958 | read_state(StateA,State), | |
| 959 | fast_buf_read(Operation,OperationA), | |
| 960 | %print(generate(Type, State, Operation)),nl, | |
| 961 | (Type == short -> black_magic_short_transformation(Operation, _, _, _, _, _, BoundState, State, LongPattern, ShortSucc, Defaults), LongOrPattern = LongPattern-ShortSucc-Defaults | |
| 962 | ; generate_bound_long_state(State, BoundState), LongOrPattern = long), | |
| 963 | (debug:debug_mode(on) | |
| 964 | -> format('~n ** get_successors for ~w~n',[Operation]), | |
| 965 | translate:print_state(BoundState),nl | |
| 966 | ; true), | |
| 967 | get_next_action(LongOrPattern, Msg, BoundState,Operation). | |
| 968 | ||
| 969 | :- use_module(probsrc(preferences),[get_preference/2,temporary_set_preference/3,reset_temporary_preference/2]). | |
| 970 | get_next_action(Type, Msg, State,Op) :- % State is a list of bindings | |
| 971 | temporary_set_preference(ltsmin_do_not_evaluate_top_level_guards,true,CHNG), | |
| 972 | get_next_states(Type, Msg, State,Op), | |
| 973 | reset_temporary_preference(ltsmin_do_not_evaluate_top_level_guards,CHNG). | |
| 974 | ||
| 975 | init_state(Res) :- specfile:specfile_trans(root,_,_,S,_,_), | |
| 976 | init_state2(S,Res). % , nl,print(init(Res)),nl. | |
| 977 | ||
| 978 | init_state2(csp_and_b_root,Res) :- !, | |
| 979 | specfile:specfile_trans(csp_and_b_root,_,_,S,_,_), | |
| 980 | init_state2(S,Res). | |
| 981 | init_state2(concrete_constants(L),FullRes) :- !, | |
| 982 | specfile:specfile_trans(concrete_constants(L),_,_,Res,_,_), | |
| 983 | expand_const_and_vars_to_full_store(Res,FullRes). | |
| 984 | init_state2(R,R). | |
| 985 | ||
| 986 | :- use_module(probsrc(b_interpreter),[b_test_boolean_expression_for_ground_state/5]). | |
| 987 | eval_label(Msg, _State,dummy) :- !, | |
| 988 | %% this probably *should* never be called | |
| 989 | %% included just for safety | |
| 990 | put_number(Msg, 1). | |
| 991 | eval_label(Msg, State,invariant) :- | |
| 992 | bmachine:b_get_invariant_from_machine(Invariant),!, % Should we use: get_unproven_invariants | |
| 993 | (profile_single_call(check_invariant, | |
| 994 | b_interpreter:b_test_boolean_expression_for_ground_state(Invariant,[],State,'LTSMin invariant label',0)) -> | |
| 995 | put_number(Msg, 1); put_number(Msg, 0)). | |
| 996 | eval_label(Msg, State,Label) :- | |
| 997 | (debug:debug_mode(on) -> print(eval(Label)),nl,flush_output ; true), | |
| 998 | state_label(Label, Type, AST), | |
| 999 | profile_single_call(Label,ltsmin:eval_label2(Type, Msg, State, AST)). | |
| 1000 | ||
| 1001 | ||
| 1002 | %:- use_module(probltlsrc(ltl_prepositions), [check_ap/2]). | |
| 1003 | eval_label2(ltl_ap, Msg, State, AST) :- | |
| 1004 | (check_ap_bound_state(AST,State) -> | |
| 1005 | put_number(Msg, 1); put_number(Msg, 0)). | |
| 1006 | eval_label2(_, Msg, State, AST) :- | |
| 1007 | (b_test_boolean_expression_for_ground_state(AST,[],State,'LTSMin label',0) -> | |
| 1008 | put_number(Msg, 1) ; put_number(Msg, 0)). | |
| 1009 | % foreign predicate put_number(Msg, X) :: 0 = false, 1=true | |
| 1010 | ||
| 1011 | ||
| 1012 | get_opname(bop(Name, _, _, _, _), Name). | |
| 1013 | get_opname(btrans(event(Name)), Name). | |
| 1014 | get_opname(btrans(event(Name, _, _)), Name). | |
| 1015 | ||
| 1016 | op_enabled(Op, State) :- | |
| 1017 | get_opname(Op, OpName), | |
| 1018 | get_guard(OpName, Guard), | |
| 1019 | b_test_boolean_expression_for_ground_state(Guard, [], State,'LTSMin op_enabled',0). | |
| 1020 | ||
| 1021 | % check an atomic proposition in a given node (i.e. state) | |
| 1022 | check_ap_bound_state(bpred(Property),Node) :- | |
| 1023 | b_test_boolean_expression_for_ground_state(Property, [], Node,'LTSMin atomic proposition',0). | |
| 1024 | check_ap_bound_state(enabled(Op),Node) :- !, | |
| 1025 | op_enabled(Op, Node). | |
| 1026 | check_ap_bound_state(det(OpList),Node) :- !, | |
| 1027 | max_enabled(OpList, Node, 1, 0, R), | |
| 1028 | R < 2. | |
| 1029 | check_ap_bound_state(dlk(OpList),Node) :- !, | |
| 1030 | max_enabled(OpList, Node, 0, 0, 0). | |
| 1031 | check_ap_bound_state(ctrl(OpList),Node) :- !, | |
| 1032 | max_enabled(OpList, Node, 1, 0, 1). | |
| 1033 | check_ap_bound_state(deadlock,Node) :- !, | |
| 1034 | get_transition_groups(OpList), | |
| 1035 | check_ap_bound_state(dlk(OpList), Node). | |
| 1036 | ||
| 1037 | %max_enabled(OpList, Max, EnabledSoFar, ResEnabled) | |
| 1038 | max_enabled([], _State, _Max, R, R). | |
| 1039 | max_enabled([Op|T], State, Max, EnabledSoFar, R) :- | |
| 1040 | (op_enabled(Op, State) | |
| 1041 | -> Enabled is EnabledSoFar + 1, | |
| 1042 | Max >= Enabled, | |
| 1043 | max_enabled(T, State, Max, Enabled, R) | |
| 1044 | ; max_enabled(T, State, Max, EnabledSoFar, R)). | |
| 1045 | ||
| 1046 |