| 1 | | % (c) 2009-2025 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, |
| 2 | | % Heinrich Heine Universitaet Duesseldorf |
| 3 | | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) |
| 4 | | |
| 5 | | :- module(cbc_refinement_checks, [cbc_refinement_check/2]). |
| 6 | | |
| 7 | | :- use_module(probsrc(module_information),[module_info/2]). |
| 8 | | :- module_info(group,cbc). |
| 9 | | :- module_info(description,'This module provides constraint-based checking of B and Event-B refinements.'). |
| 10 | | |
| 11 | | :- use_module(library(lists)). |
| 12 | | :- use_module(library(sets), [subtract/3]). |
| 13 | | |
| 14 | | :- use_module(probsrc(solver_interface), [solve_predicate/5]). |
| 15 | | |
| 16 | | :- use_module(probsrc(specfile), [animation_minor_mode/1]). |
| 17 | | :- use_module(probsrc(bmachine), [full_b_machine/1, |
| 18 | | b_get_refined_machine/1, |
| 19 | | b_get_machine_operation/6, |
| 20 | | b_get_invariant_from_machine/1, |
| 21 | | b_get_linking_invariant_from_machine/1, |
| 22 | | b_get_properties_from_machine/1, |
| 23 | | b_get_machine_variables/1, |
| 24 | | b_get_machine_constants/1, |
| 25 | | b_machine_name/1]). |
| 26 | | |
| 27 | | :- use_module(probsrc(translate), [nested_print_bexpr/1]). |
| 28 | | :- use_module(probsrc(debug), [formatsilent/2, debug_mode/1]). |
| 29 | | :- use_module(probsrc(bsyntaxtree), [get_texpr_expr/2,get_texpr_info/2, |
| 30 | | get_texpr_id/2, add_texpr_description/3, add_labels_to_texpr/3, |
| 31 | | get_rodin_name/2, |
| 32 | | conjunct_predicates/2, |
| 33 | | conjunction_to_list/2, |
| 34 | | create_texpr/4, safe_create_texpr/3, |
| 35 | | rename_bt/3]). |
| 36 | | :- use_module(probsrc(b_interpreter_components), [construct_optimized_exists/3]). |
| 37 | | :- use_module(probsrc(bmachine_structure), [get_section/3]). |
| 38 | | :- use_module(probsrc(btypechecker), [prime_identifiers/2]). |
| 39 | | :- use_module(probsrc(bsyntaxtree), [create_negation/2]). |
| 40 | | :- use_module(extrasrc(weakest_preconditions), [weakest_precondition/3, |
| 41 | | set_reference_machine/1, |
| 42 | | delete_reference_machine/0]). |
| 43 | | :- use_module(extrasrc(before_after_predicates), [before_after_predicate_with_equalities/3, |
| 44 | | before_after_predicate_list_conjunct_with_equalities/3, |
| 45 | | list_renamings_to_primed_vars/2]). |
| 46 | | :- use_module(probsrc(preferences),[get_preference/2]). |
| 47 | | :- use_module(probsrc(tools_strings), [ajoin/2]). |
| 48 | | |
| 49 | | cbc_refinement_check(List,ViolationFound) :- |
| 50 | | (animation_minor_mode(eventb) |
| 51 | | -> eventb_refinement_check(List,ViolationFound) |
| 52 | | ; classical_refinement_check(List,ViolationFound)). |
| 53 | | |
| 54 | | % ------------------------------------------- |
| 55 | | % eventb po generation |
| 56 | | % ------------------------------------------- |
| 57 | | |
| 58 | | eventb_refinement_check(ResultList,ViolationFound) :- |
| 59 | | % fetch Axioms and Invariant/properties first |
| 60 | | full_b_machine(Machine), |
| 61 | | (get_section(axioms,Machine,Axioms) -> true ; Axioms = []), |
| 62 | | b_get_invariant_from_machine(Invariant), |
| 63 | | b_get_properties_from_machine(Properties), |
| 64 | | % evt/p/WFIS |
| 65 | | witness_feasibility(Axioms,Invariant,Properties,ListWF,V1), |
| 66 | | % evt/grd/GRD proof obligations |
| 67 | | guard_strengthening(Axioms,Invariant,Properties,ListGS,V2), |
| 68 | | % evt/act/SIM |
| 69 | | action_simulation(Axioms,Invariant,Properties,ListAS,V3), |
| 70 | | append([ListWF,['\n'],ListGS,['\n'],ListAS],ResultList), |
| 71 | | merge_violation_found([V1,V2,V3],ViolationFound). |
| 72 | | |
| 73 | | witness_feasibility(Axioms,Invariant,Properties,['Witness Feasibility:'|FlatResults],ViolationFound) :- |
| 74 | | % action simulation: |
| 75 | | % A & I & J & H & W & Tau => Q_i |
| 76 | | % find all candidates for evt/act/SIM proof obligations |
| 77 | | findall(RLEVENT, |
| 78 | | (b_get_machine_operation(_Name,_R,_P,Body,_OType,_OpPos), |
| 79 | | get_texpr_expr(Body,RLEVENT)), |
| 80 | | ListOfOperations), |
| 81 | | maplist(witness_feasibility_aux(Axioms,Invariant,Properties),ListOfOperations,Results,SubViolationFound), |
| 82 | | append(Results,FlatResults), |
| 83 | | merge_violation_found(SubViolationFound,ViolationFound). |
| 84 | | |
| 85 | | witness_feasibility_aux(Axioms,Invariant,Properties, |
| 86 | | rlevent(Name,_Section,_Stat,Parameters,Guards,_Thm,_Actions,_VWit,PWit,_Unmod,AbsEvents), |
| 87 | | ResultsParameters,ViolationFound) :- |
| 88 | | % feasibility for parameters - the abstract events have a parameter |
| 89 | | % that is not a parameter of the concrete events |
| 90 | | all_abstract_parameters(AbsEvents,AllAbsParameters), |
| 91 | | subtract(AllAbsParameters,Parameters,ParametersForWfisPos), |
| 92 | | |
| 93 | | conjunct_predicates([Invariant,Properties,Guards|Axioms],LHSPred), |
| 94 | | |
| 95 | | % map over all abstract events |
| 96 | | maplist(witness_feasibility_parameters(Name,LHSPred,PWit),ParametersForWfisPos,ResultsParameters,SubViolationFound), |
| 97 | | merge_violation_found(SubViolationFound,ViolationFound). |
| 98 | | |
| 99 | | witness_feasibility_parameters(Name,LHSPred,PWit,Parameter,Result,ViolationFound) :- |
| 100 | | % find matching witness - same identifier |
| 101 | | get_texpr_id(Parameter,Identifier), |
| 102 | | member(Witness,PWit), get_texpr_expr(Witness,witness(WitnessIdentifier,Pred)), |
| 103 | | get_texpr_id(WitnessIdentifier,Identifier), !, |
| 104 | | |
| 105 | | % set up PO: A & I & J & H => exists p : W_p |
| 106 | | construct_optimized_exists([Parameter],Pred,ExistsPred), |
| 107 | | create_negation(ExistsPred,NegatedExistsPred), |
| 108 | | conjunct_predicates([LHSPred,NegatedExistsPred],CounterExamplePred), |
| 109 | | |
| 110 | | cbc_solve_predicate(CounterExamplePred,State,Res), |
| 111 | | assign_violation_found(Res,ViolationFound,ResTxt), |
| 112 | | |
| 113 | | % result string |
| 114 | | ajoin([Name,'/',Identifier,'/WFIS: ','Counter-Example found: ', ResTxt],Result), |
| 115 | | % print |
| 116 | | formatsilent(' * ~w~n',[Result]), |
| 117 | | (debug_mode(off) -> true ; nested_print_bexpr(Pred), write(State),nl). |
| 118 | | |
| 119 | | action_simulation(Axioms,Invariant,Properties,['Action Simulation:'|ResultsFlat],ViolationFound) :- |
| 120 | | % action simulation: |
| 121 | | % A & I & J & H & W & Tau => Q_i |
| 122 | | % find all candidates for evt/act/SIM proof obligations |
| 123 | | findall(RLEVENT, |
| 124 | | (b_get_machine_operation(_Name,_R,_P,Body,_OType,_), |
| 125 | | get_texpr_expr(Body,RLEVENT)), |
| 126 | | ListOfOperations), |
| 127 | | maplist(action_simulation(Axioms,Invariant,Properties),ListOfOperations,Results,SubViolationFound), |
| 128 | | merge_violation_found(SubViolationFound,ViolationFound), |
| 129 | | append(Results,ResultsFlat). |
| 130 | | |
| 131 | | action_simulation(Axioms,Invariant,Properties, |
| 132 | | rlevent(Name,_Section,_Stat,_Parameters,Guards,_Thm,Actions,VWit,PWit,_Unmod,AbsEvents), |
| 133 | | ResultsFlat,ViolationFound) :- |
| 134 | | % concrete before-after-predicate |
| 135 | | b_get_machine_variables(Vars), |
| 136 | | b_get_machine_constants(Consts), |
| 137 | | append(Vars,Consts,Both), |
| 138 | | before_after_predicate_list_conjunct_with_equalities(Actions,Both,Tau), |
| 139 | | maplist(extract_witness_predicate,VWit,VWitPreds), |
| 140 | | maplist(extract_witness_predicate,PWit,PWitPreds), |
| 141 | | append([Axioms,[Invariant,Properties,Guards,Tau],VWitPreds,PWitPreds],LHSPreds), |
| 142 | | conjunct_predicates(LHSPreds,LHS), |
| 143 | | |
| 144 | | % map over all abstract events |
| 145 | | maplist(action_simulation2(Name,LHS),AbsEvents,Results,SubViolationFound), |
| 146 | | merge_violation_found(SubViolationFound,ViolationFound), |
| 147 | | append(Results,ResultsFlat). |
| 148 | | |
| 149 | | action_simulation2(Name,LHS,AbsEvent,Result,ViolationFound) :- |
| 150 | | get_texpr_expr(AbsEvent,rlevent(_AbsName,_Section,_Stat,_AbsParameters,_Guards,_Thm,Actions,_VWit,_PWit,_Unmod,_AbsEvents)), |
| 151 | | % map over all abstract actions |
| 152 | | maplist(action_simulation3(Name,LHS),Actions,Result,SubViolationFound), |
| 153 | | merge_violation_found(SubViolationFound,ViolationFound). |
| 154 | | |
| 155 | | action_simulation3(Name,LHS,Action,Result,ViolationFound) :- |
| 156 | | modifies_concrete_var(Action), !, |
| 157 | | get_rodin_name(Action,ActionName), |
| 158 | | |
| 159 | | % before after predicate of abstract action, negate, solve |
| 160 | | b_get_machine_variables(AllVars), |
| 161 | | exclude(is_concrete_var,AllVars,AbstractVars), |
| 162 | | before_after_predicate_with_equalities(Action,AbstractVars,BAPred), |
| 163 | | create_negation(BAPred,NegatedBAPred), |
| 164 | | conjunct_predicates([NegatedBAPred,LHS],Pred), |
| 165 | | |
| 166 | | cbc_solve_predicate(Pred,State,Res), |
| 167 | | assign_violation_found(Res,ViolationFound,ResTxt), |
| 168 | | |
| 169 | | % result string |
| 170 | | ajoin([Name,'/',ActionName,'/SIM: ','Counter-Example found: ', ResTxt],Result), |
| 171 | | % print |
| 172 | | formatsilent(' * ~w~n',[Result]), |
| 173 | | (debug_mode(off) -> true ; nested_print_bexpr(Pred), write(State),nl). |
| 174 | | |
| 175 | | % abstract action does not modify a concrete variable -> no PO |
| 176 | | action_simulation3(_Name,_LHS,_Action,[],false). |
| 177 | | |
| 178 | | guard_strengthening(Axioms,Invariant,Properties,['Guard Strengthening:'|ResultsFlat],ViolationFound) :- |
| 179 | | % guard strengthening: |
| 180 | | % A & I & J & H & W => G_i |
| 181 | | % guard strengthening (merge): |
| 182 | | % A & I & J & H & W & Tau => G_1 or ... or G_n |
| 183 | | % find all candidates for evt/grd/GRD proof obligations |
| 184 | | findall(RLEVENT, |
| 185 | | (b_get_machine_operation(_Name,_R,_P,Body,_OType,_), |
| 186 | | get_texpr_expr(Body,RLEVENT)), |
| 187 | | ListOfOperations), |
| 188 | | maplist(guard_strengthening_aux(Axioms,Invariant,Properties),ListOfOperations,Results,SubViolationFound), |
| 189 | | append(Results,ResultsFlat), |
| 190 | | merge_violation_found(SubViolationFound,ViolationFound). |
| 191 | | |
| 192 | | % guard_strengthening: not a refinement |
| 193 | | guard_strengthening_aux(_Axioms,_Invariant,_Properties, |
| 194 | | rlevent(_Name,_Section,_Stat,_Parameters,_Guards,_Thm,_Actions,_VWit,_PWit,_Unmod,[]), |
| 195 | | [],false) :- !. % nothing to check |
| 196 | | |
| 197 | | % guard_strengthening: refining only one event |
| 198 | | guard_strengthening_aux(Axioms,Invariant,Properties, |
| 199 | | rlevent(Name,_Section,_Stat,_Parameters,Guards,_Thm,_Actions,VWit,PWit,_Unmod,[AbsEvent]), |
| 200 | | Results,ViolationFound) :- !, |
| 201 | | get_texpr_expr(AbsEvent,ABSRLEVENT), |
| 202 | | ABSRLEVENT = rlevent(_AbsName,_Absection,_AbsStat,_AbsParameters,AbsGrds,_AbsThm,_AbsAct,_AbsVWit,_AbsPWit,_AbsUnmod,_AbsEvents), |
| 203 | | conjunction_to_list(AbsGrds,AbsGrdsList), |
| 204 | | % map over all abstract guards |
| 205 | | maplist(guard_strengthening_single_event(Name,Axioms,Invariant,Properties,VWit,PWit,Guards),AbsGrdsList,Results,SubViolationFound), |
| 206 | | merge_violation_found(SubViolationFound,ViolationFound). |
| 207 | | |
| 208 | | % guard_strengthening: refining multiple events |
| 209 | | guard_strengthening_aux(Axioms,Invariant,Properties, |
| 210 | | rlevent(Name,_Section,_Stat,_Parameters,Guards,_Thm,Actions,VWit,PWit,_Unmod,AbsEvents), |
| 211 | | [Result],ViolationFound) :- |
| 212 | | % concrete before-after-predicate |
| 213 | | b_get_machine_variables(Vars), |
| 214 | | b_get_machine_constants(Consts), |
| 215 | | append(Vars,Consts,Both), |
| 216 | | before_after_predicate_list_conjunct_with_equalities(Actions,Both,Tau), |
| 217 | | % collect all abstract guards G_i and negate |
| 218 | | findall(AbsGrds, |
| 219 | | (member(Evt,AbsEvents), |
| 220 | | get_texpr_expr(Evt,rlevent(_AbsName,_AbsSection,_AbsStat,_AbsParams,AbsGrds,_AbsThm,_AbsAct,_AbsVWit,_AbsPWit,_AbsUnmod,_AbsAbsEvents))), |
| 221 | | ListOfAbstractGuards), |
| 222 | | maplist(create_negation,ListOfAbstractGuards,NegatedAbstractGuards), |
| 223 | | |
| 224 | | % build up predicate A & I & J & H & W & Tau => G_1 or ... or G_n |
| 225 | | maplist(extract_witness_predicate,VWit,VWitPreds), |
| 226 | | maplist(extract_witness_predicate,PWit,PWitPreds), |
| 227 | | |
| 228 | | append([Axioms,[Invariant,Properties,Guards,Tau],VWitPreds,PWitPreds,NegatedAbstractGuards],LHSPred), |
| 229 | | conjunct_predicates(LHSPred,Pred), |
| 230 | | cbc_solve_predicate(Pred,State,Res), |
| 231 | | |
| 232 | | assign_violation_found(Res,ViolationFound,ResTxt), |
| 233 | | |
| 234 | | % result string and print |
| 235 | | ajoin([Name,'/MRG: ','Counter-Example found: ', ResTxt],Result), |
| 236 | | formatsilent(' * ~w~n',[Result]), |
| 237 | | (debug_mode(off) -> true ; nested_print_bexpr(Pred), write(State),nl). |
| 238 | | |
| 239 | | guard_strengthening_single_event(OpName,_Axioms,_Invariant,_Properties,_VWit,_PWit,_Guards,AbsGrd,Result,false) :- |
| 240 | | get_rodin_name(AbsGrd,GuardName), |
| 241 | | formatsilent('~nChecking single event guard strengthening for: ~w of ~w~n',[GuardName,OpName]), |
| 242 | | b_machine_name(MainMachineName), % we assume that we prove the guard strengthening for the main machine ! |
| 243 | | bmachine:discharged_guard_strengthening(MainMachineName,AbstractEvent,GuardName,OpName), |
| 244 | | formatsilent('Guard ~w of ~w is already proven for event ~w:~w !~n',[GuardName,AbstractEvent,MainMachineName,OpName]), |
| 245 | | get_preference(use_po,true), |
| 246 | | !, |
| 247 | | ajoin([OpName,'/',GuardName,'/GRD: ','already proven'],Result). |
| 248 | | guard_strengthening_single_event(OpName,Axioms,Invariant,Properties,VWit,PWit,Guards,AbsGrd,Result,ViolationFound) :- |
| 249 | | get_rodin_name(AbsGrd,GuardName), |
| 250 | | % build up predicate and check |
| 251 | | maplist(extract_witness_predicate,VWit,VWitPreds), |
| 252 | | maplist(extract_witness_predicate,PWit,PWitPreds), |
| 253 | | create_negation(AbsGrd,NegAbsGrd), |
| 254 | | |
| 255 | | append([Axioms,[Invariant,Properties,Guards,NegAbsGrd],VWitPreds,PWitPreds],Predicates), |
| 256 | | conjunct_predicates(Predicates,Pred), |
| 257 | | |
| 258 | | cbc_solve_predicate(Pred,State,Res), |
| 259 | | assign_violation_found(Res,ViolationFound,ResTxt), |
| 260 | | |
| 261 | | % result string and print |
| 262 | | ajoin([OpName,'/',GuardName,'/GRD: ','Counter-Example found: ', ResTxt],Result), |
| 263 | | formatsilent(' * ~w~n',[Result]), |
| 264 | | (debug_mode(off) -> true ; nested_print_bexpr(Pred), write(State),nl). |
| 265 | | |
| 266 | | extract_witness_predicate(Witness,Pred) :- |
| 267 | | get_texpr_expr(Witness,witness(_Id,Pred)). |
| 268 | | |
| 269 | | modifies_concrete_var(Action) :- |
| 270 | | get_texpr_info(Action,Info), |
| 271 | | member(modifies(ListOfVars), Info), |
| 272 | | some(is_concrete_var,ListOfVars). |
| 273 | | |
| 274 | | is_concrete_var(b(identifier(Name),_,_)) :- !, |
| 275 | | is_concrete_var(Name). |
| 276 | | is_concrete_var(VarName) :- |
| 277 | | b_get_machine_variables(Variables), |
| 278 | | b_machine_name(TopLevelName), % can have prefix MAIN_MACHINE_FOR_ |
| 279 | | member(b(identifier(VarName),_Type,Infos),Variables), |
| 280 | | member(occurrences(Machines),Infos), |
| 281 | | member(TopLevelName,Machines). |
| 282 | | |
| 283 | | all_abstract_parameters([],[]). |
| 284 | | all_abstract_parameters([Event|FurtherEvents],ParametersOut) :- |
| 285 | | get_texpr_expr(Event,rlevent(_Name,_Section,_Stat,Parameters,_Guards,_Thm,_Actions,_VWit,_PWit,_Unmod,_AbsEvents)), |
| 286 | | all_abstract_parameters(FurtherEvents,FurtherParameters), append(Parameters,FurtherParameters,ParametersOut). |
| 287 | | |
| 288 | | % ------------------------------------------- |
| 289 | | % classical b po generation |
| 290 | | % ------------------------------------------- |
| 291 | | |
| 292 | | classical_refinement_check(ResultList,ViolationFound) :- |
| 293 | | % fetch Axioms and Invariant/properties first |
| 294 | | full_b_machine(Machine), |
| 295 | | b_get_refined_machine(AbsMachine) |
| 296 | | -> b_get_invariant_from_machine(Invariant0), |
| 297 | | add_labels_to_texpr(Invariant0,['Invariant I'], Invariant), |
| 298 | | b_get_linking_invariant_from_machine(LinkingInvariant0), |
| 299 | | add_labels_to_texpr(LinkingInvariant0,['Linking Invariant J'], LinkingInvariant), |
| 300 | | % check initialisation po |
| 301 | | initialisation_pos(LinkingInvariant,Machine,AbsMachine,IniPos,V1), |
| 302 | | % check all operation pos |
| 303 | | get_all_operations_from_machine(Machine,ConcreteOperations), |
| 304 | | get_all_operations_from_machine(AbsMachine,AbstractOperations), |
| 305 | | operations_pos(ConcreteOperations,Invariant,LinkingInvariant,AbsMachine,AbstractOperations,ListOpPos,V2), |
| 306 | | append([[IniPos],['\n'],ListOpPos],ResultList), |
| 307 | | merge_violation_found([V1,V2],ViolationFound) |
| 308 | | ; ResultList = ['Not a Refinement Machine']. |
| 309 | | |
| 310 | | get_all_operations_from_machine(Machine,Operations) :- |
| 311 | | get_section(operation_bodies,Machine,Ops), |
| 312 | | findall(operation(Name,Results,Parameters,Body), |
| 313 | | (get_texpr_expr(Op,operation(TId,Results,Parameters,Body)), |
| 314 | | get_texpr_id(TId,op(Name)),member(Op,Ops)), |
| 315 | | Operations). |
| 316 | | |
| 317 | | % POs for the INITIALISATION: |
| 318 | | initialisation_pos(LinkingInvariant,Machine,AbsMachine,Result,ViolationFound) :- |
| 319 | | % get the two initialisations |
| 320 | | get_section(initialisation,Machine,ConcreteInitialisation), |
| 321 | | get_section(initialisation,AbsMachine,AbstractInitialisation), |
| 322 | | |
| 323 | | % set up proof obligation [T1] not [T] not J (Schneider p.222) |
| 324 | | create_negation(LinkingInvariant,NegLinkingInvariant), |
| 325 | | |
| 326 | | set_reference_machine(AbsMachine), |
| 327 | | weakest_precondition(AbstractInitialisation,NegLinkingInvariant,TempPred), |
| 328 | | delete_reference_machine, |
| 329 | | |
| 330 | | create_negation(TempPred,NotTNotJ), |
| 331 | | weakest_precondition(ConcreteInitialisation,NotTNotJ,PO), |
| 332 | | create_negation(PO,CounterExPO), |
| 333 | | |
| 334 | | cbc_solve_predicate(CounterExPO,State,Res), |
| 335 | | assign_violation_found(Res,ViolationFound,ResTxt), |
| 336 | | |
| 337 | | % result string and print |
| 338 | | ajoin(['Initialisation [T1] not [T] not J: Counter-Example found: ', ResTxt],Result), |
| 339 | | formatsilent(' * ~w~n',[Result]), |
| 340 | | (debug_mode(off) -> true ; nested_print_bexpr(CounterExPO), write(State),nl). |
| 341 | | |
| 342 | | operations_pos([],_I,_LI,_AM,_A,[],false). |
| 343 | | operations_pos([operation(Name,Results,_Parameters,_Body)|FurtherOps],Invariant, |
| 344 | | LinkingInvariant,AbsMachine,AbstractOperations,Results,ViolationFound) :- |
| 345 | | % there might be no abstract operation with the same name (includes, etc.) |
| 346 | | \+ (member(operation(Name,_AbsResults,_AbsParameters,_AbsBody),AbstractOperations)), !, |
| 347 | | operations_pos(FurtherOps,Invariant,LinkingInvariant,AbsMachine,AbstractOperations,Results,ViolationFound). |
| 348 | | operations_pos([operation(Name,Results,_Parameters,Body)|FurtherOps],Invariant, |
| 349 | | LinkingInvariant,AbsMachine,AbstractOperations,[PreRefPoResult,RefPoResult|ListOpPos],ViolationFound) :- |
| 350 | | % first find the matching abstract operation |
| 351 | | member(operation(Name,_AbsResults,_AbsParameters,AbsBody),AbstractOperations), |
| 352 | | |
| 353 | | % check if we have preconditions - otherwise we assume true |
| 354 | | (get_texpr_expr(Body,precondition(Precondition0,RealBody)) -> true |
| 355 | | ; RealBody=Body, create_texpr(truth,pred,[],Precondition0)), |
| 356 | | add_labels_to_texpr(Precondition0,['P1 (concrete PRE)'], Precondition), |
| 357 | | (get_texpr_expr(AbsBody,precondition(AbsPrecondition0,AbsRealBody)) |
| 358 | | -> true |
| 359 | | ; AbsRealBody=AbsBody, create_texpr(truth,pred,[],AbsPrecondition0) |
| 360 | | ), |
| 361 | | add_labels_to_texpr(AbsPrecondition0,['P (abstract PRE)'], AbsPrecondition), |
| 362 | | |
| 363 | | % refinement po for the preconditions |
| 364 | | create_negation(Precondition,NegPrecondition), % description |
| 365 | | conjunct_predicates([Invariant,LinkingInvariant,AbsPrecondition,NegPrecondition],PreRefPo), |
| 366 | | cbc_solve_predicate(PreRefPo,State,PreRefPoRes), |
| 367 | | assign_violation_found(PreRefPoRes,V2,RTxt2), |
| 368 | | |
| 369 | | % result string and print |
| 370 | | % This PO is in Section 14.3, page 225 of Schneider's B Book; part of obligation 4 on page 530 of Abrial's B Book |
| 371 | | ajoin([Name, ' Precondition Refinement I & J & P => P1: Counter-Example found: ', RTxt2],PreRefPoResult), |
| 372 | | formatsilent(' * ~w~n',[PreRefPoResult]), |
| 373 | | (debug_mode(off) -> true ; nested_print_bexpr(PreRefPo), write(State),nl), |
| 374 | | |
| 375 | | % for the refinement of operations, we need to rename existing output variables (i.e. prime them) |
| 376 | | prime_identifiers(Results,PrimedResults), |
| 377 | | list_renamings_to_primed_vars(Results,Renamings), |
| 378 | | rename_bt(RealBody,Renamings,RealBodyWithPrimedVariables), |
| 379 | | create_equals(Results,PrimedResults,EqualResultsPred), |
| 380 | | |
| 381 | | % refinement po for the operation |
| 382 | | % I & J & P => [S1[out'/out]] not S not (J & out'=out) |
| 383 | | conjunct_predicates([LinkingInvariant|EqualResultsPred],RHS), |
| 384 | | create_negation(RHS,NegRHS), |
| 385 | | |
| 386 | | set_reference_machine(AbsMachine), |
| 387 | | weakest_precondition(AbsRealBody,NegRHS,RHS2), |
| 388 | | delete_reference_machine, |
| 389 | | |
| 390 | | create_negation(RHS2,NegRHS2), |
| 391 | | weakest_precondition(RealBodyWithPrimedVariables,NegRHS2,RHS3), |
| 392 | | create_negation(RHS3,NegRHS3), |
| 393 | | conjunct_predicates([Invariant,LinkingInvariant,Precondition,NegRHS3],RefPo), |
| 394 | | |
| 395 | | cbc_solve_predicate(RefPo,State2,RefPoRes), |
| 396 | | assign_violation_found(RefPoRes,V1,RTxt), |
| 397 | | % result string and print |
| 398 | | ajoin([Name, ' Refinement I & J & P => S1 not S not J: Counter-Example found: ', RTxt],RefPoResult), |
| 399 | | formatsilent(' * ~w~n',[RefPoResult]), |
| 400 | | (debug_mode(off) -> true ; nested_print_bexpr(RefPo), write(State2),nl), |
| 401 | | |
| 402 | | operations_pos(FurtherOps,Invariant,LinkingInvariant,AbsMachine,AbstractOperations,ListOpPos,SubViolationFound), |
| 403 | | |
| 404 | | merge_violation_found([V1,V2,SubViolationFound],ViolationFound). |
| 405 | | |
| 406 | | create_equals([],[],[]). |
| 407 | | create_equals([Id|Ids],[Expr|Exprs],[TPred|SubPreds]) :- |
| 408 | | safe_create_texpr(equal(Id,Expr),pred,TPred), |
| 409 | | create_equals(Ids,Exprs,SubPreds). |
| 410 | | |
| 411 | | merge_violation_found(L,true) :- |
| 412 | | some('=='(true),L), !. |
| 413 | | merge_violation_found(L,R) :- |
| 414 | | some('=='(time_out),L), !, R=time_out. |
| 415 | | merge_violation_found(_,false). |
| 416 | | |
| 417 | | assign_violation_found(contradiction_found,false,Txt) :- !, Txt='NONE EXISTS'. |
| 418 | | assign_violation_found(solution(S),true,S) :- !. |
| 419 | | assign_violation_found(time_out,R,time_out) :- !, R= time_out. |
| 420 | | assign_violation_found(X,false,'NONE FOUND'(X)). |
| 421 | | |
| 422 | | |
| 423 | | cbc_solve_predicate(Pred,State,Res) :- TimeoutFactor=1, |
| 424 | | solve_predicate(Pred,State,TimeoutFactor,[clean_up_pred,use_smt_mode/true,use_clpfd_solver/true],Res). |