| 1 | % (c) 2014-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(before_after_predicates, [tcltk_before_after_predicate_for_operation/2, | |
| 6 | before_after_predicate_for_operation/2, | |
| 7 | before_after_predicate_for_operation_no_equalities/5, | |
| 8 | before_after_predicate_with_equalities/3, | |
| 9 | before_after_predicate_list_conjunct_with_equalities/3, | |
| 10 | before_after_predicate_list_disjunct_with_equalities/3, | |
| 11 | before_after_predicate_no_equalities/3, | |
| 12 | add_missing_equalities/3, | |
| 13 | prime_bexpr_for_ids/4, prime_dollar0_bexpr_for_ids/3, | |
| 14 | list_renamings_to_primed_vars/2]). | |
| 15 | ||
| 16 | :- use_module(probsrc(module_information),[module_info/2]). | |
| 17 | :- module_info(group,cbc). | |
| 18 | :- module_info(description,'This module computes before-after-predicates of B and Event-B actions.'). | |
| 19 | % NOTE: for the moment it assumes no clashes between operation parameters and variables, constants, ... | |
| 20 | ||
| 21 | :- use_module(library(lists)). | |
| 22 | ||
| 23 | :- use_module(probsrc(bsyntaxtree), [get_texpr_expr/2, | |
| 24 | get_texpr_id/2, | |
| 25 | is_truth/1, | |
| 26 | safe_create_texpr/3, | |
| 27 | get_texpr_type/2, | |
| 28 | conjunct_predicates/2, | |
| 29 | conjunction_to_list/2, | |
| 30 | create_implication/3, | |
| 31 | create_couple/3, | |
| 32 | disjunct_predicates/2, | |
| 33 | find_typed_identifier_uses/2, | |
| 34 | rename_bt/3, | |
| 35 | create_exists/3, create_or_merge_exists/3, | |
| 36 | create_negation/2]). | |
| 37 | :- use_module(probsrc(error_manager), [add_error_fail/3]). | |
| 38 | :- use_module(probsrc(bmachine),[b_get_machine_operation/4, | |
| 39 | b_get_machine_variables/1, | |
| 40 | b_get_machine_constants/1]). | |
| 41 | %:- use_module(probsrc(specfile,[animation_minor_mode/1]). | |
| 42 | :- use_module(probsrc(tools),[split_list/4]). | |
| 43 | :- use_module(probsrc(translate),[translate_bexpression/2]). | |
| 44 | :- use_module(symbolic_model_checker(predicate_handling), | |
| 45 | [prime_id_atom/2, remove_prime_id_atom/2, is_primed_id_atom/1, | |
| 46 | prime_typed_identifier/2,remove_prime_typed_identifier/2, | |
| 47 | is_primed_typed_identifier/1]). | |
| 48 | ||
| 49 | ||
| 50 | tcltk_before_after_predicate_for_operation(OpName,list(Res)) :- | |
| 51 | before_after_predicate_for_operation(OpName,BAPredicate), | |
| 52 | %translate:print_bexpr(BAPredicate),nl, | |
| 53 | conjunction_to_list(BAPredicate,LP), | |
| 54 | maplist(translate_bexpression,LP,Res). | |
| 55 | ||
| 56 | before_after_predicate_for_operation(OpName,BAPredicate) :- | |
| 57 | ? | b_get_machine_operation(OpName,_Results,_Parameters,OpBody), |
| 58 | %print(op(OpName)),nl, | |
| 59 | b_get_machine_variables(Variables), | |
| 60 | %b_get_machine_constants(Constants), append(Variables,Constants,VarsAndConsts), | |
| 61 | before_after_predicate_with_equalities(OpBody,Variables,BAPredicate). | |
| 62 | ||
| 63 | % ---------------- | |
| 64 | ||
| 65 | :- use_module(probsrc(translate), [generate_typing_predicates/2]). | |
| 66 | ||
| 67 | % without equalities for UNCHANGED vars | |
| 68 | before_after_predicate_for_operation_no_equalities(OpName,Parameters,Results,BAPredicate,ChangedIds) :- | |
| 69 | b_get_machine_operation(OpName,Results,Parameters,OpBody), | |
| 70 | % TO DO: rename parameters if clashing | |
| 71 | generate_typing_predicates(Parameters,Typings1), | |
| 72 | generate_typing_predicates(Results,Typings2), | |
| 73 | before_after_predicate_no_equalities_tl4(top_level,OpBody,BAPred,ChangedIds), | |
| 74 | append([Typings1,Typings2,[BAPred]],LP), | |
| 75 | conjunct_predicates(LP,BAPredicate). | |
| 76 | % predicate contains new open identifiers: Results and Parameters | |
| 77 | ||
| 78 | % :- before_after_predicates:before_after_predicate_for_operation_no_equalities(Op,_,_,P,C), format('Op ~w (writing ~w):~n',[Op,C]), translate:print_bexpr(P),nl,nl,fail. | |
| 79 | ||
| 80 | ||
| 81 | ||
| 82 | :- use_module(probsrc(bsyntaxtree),[transform_bexpr_with_scoping/3]). | |
| 83 | % prime those variables inside a formula which are in the ChangedIds list | |
| 84 | prime_bexpr_for_ids(TExpr,ChangedIds,PrimedTExpr,ChangesPerformed) :- | |
| 85 | prime_bexpr_for_ids(TExpr,prime_with_quote,ChangedIds,PrimedTExpr,ChangesPerformed). | |
| 86 | prime_dollar0_bexpr_for_ids(TExpr,ChangedIds,PrimedTExpr) :- | |
| 87 | prime_bexpr_for_ids(TExpr,prime_with_dollar0,ChangedIds,PrimedTExpr,_ChangesPerformed). | |
| 88 | ||
| 89 | prime_bexpr_for_ids(TExpr,Kind,ChangedIds,PrimedTExpr,ChangesPerformed) :- | |
| 90 | (ChangedIds = '$all' -> SortedCIds = ChangedIds % '$all' returned by b_get_read_write if computation fails | |
| 91 | ; sort(ChangedIds,SortedCIds)), | |
| 92 | transform_bexpr_with_scoping(before_after_predicates:prime_changed_id(Kind,SortedCIds,Changed),TExpr,PrimedTExpr), | |
| 93 | (var(Changed) -> ChangesPerformed=false ; ChangesPerformed=true). | |
| 94 | ||
| 95 | :- use_module(library(ordsets),[ord_member/2,ord_nonmember/2]). | |
| 96 | prime_changed_id(Kind,ChangedIds,Changed,b(identifier(ID),Type,Info),Result,LocalIds) :- | |
| 97 | (ChangedIds='$all' -> true ; ord_member(ID,ChangedIds)), | |
| 98 | ord_nonmember(ID,LocalIds), % The ID is not overriden by a locally quantified variable | |
| 99 | my_prime_id(Kind,ID,PrimedID), | |
| 100 | Changed=true, % change was performed | |
| 101 | Result = b(identifier(PrimedID),Type,Info). | |
| 102 | ||
| 103 | ||
| 104 | :- use_module(probsrc(btypechecker),[prime_id/2, prime_atom0/2]). | |
| 105 | my_prime_id(prime_with_dollar0,ID,PrimedID0) :- !, prime_atom0(ID,PrimedID0). % x -> x$0 | |
| 106 | my_prime_id(_,ID,PrimedID) :- !, prime_id(ID,PrimedID). % prime_with_quote: x -> x' | |
| 107 | ||
| 108 | ||
| 109 | % ---------------- | |
| 110 | ||
| 111 | %! before_after_predicate_with_equalities(+Action,+AllIdentifiers,-Predicate) | |
| 112 | % these add missing y' = y equalities for unchanged variables | |
| 113 | before_after_predicate_with_equalities(Action,AllIdentifiers,Predicate) :- | |
| 114 | before_after_predicate_list_conjunct_with_equalities([Action],AllIdentifiers,Predicate). | |
| 115 | before_after_predicate_list_conjunct_with_equalities(Actions,AllIdentifiers,BAPredicateWithEq) :- | |
| 116 | maplist(before_after_predicate_no_equalities_tl3(top_level),Actions,AllPredicates), | |
| 117 | conjunct_predicates(AllPredicates,BAPredicate), | |
| 118 | add_missing_equalities(AllIdentifiers,BAPredicate,BAPredicateWithEq). | |
| 119 | before_after_predicate_list_disjunct_with_equalities(Actions,AllIdentifiers,BAPredicate) :- | |
| 120 | maplist(before_after_predicate_no_equalities_tl3(top_level),Actions,AllPredicates), | |
| 121 | maplist(add_missing_equalities(AllIdentifiers),AllPredicates,BAPredicates), | |
| 122 | disjunct_predicates(BAPredicates,BAPredicate). | |
| 123 | ||
| 124 | % ---------------- | |
| 125 | ||
| 126 | % does not add missing y' = y equalities for unchanged variables | |
| 127 | % top-level version: has a special rule for PRE | |
| 128 | before_after_predicate_no_equalities_tl3(TopLevel,Action,Predicate) :- | |
| 129 | before_after_predicate_no_equalities_tl4(TopLevel,Action,Predicate,_). | |
| 130 | before_after_predicate_no_equalities_tl4(TopLevel,Action,Predicate,ChangedIDs) :- | |
| 131 | get_texpr_expr(Action,Expr), | |
| 132 | before_after_predicate_no_equalities_top_level_aux(Expr,Predicate,ChangedIDs,TopLevel). | |
| 133 | ||
| 134 | :- use_module(probsrc(preferences),[get_preference/2]). | |
| 135 | before_after_predicate_no_equalities_top_level_aux(precondition(Pre,Body),Predicate,ChangedIDs,top_level) :- | |
| 136 | get_preference(treat_outermost_pre_as_select,true), | |
| 137 | !, | |
| 138 | before_after_predicate_no_equalities(Body,BABody,ChangedIDs), | |
| 139 | conjunct_predicates([Pre,BABody],Predicate). % May sometimes have to be an implication (depending on how BA-predicate is used) ! | |
| 140 | before_after_predicate_no_equalities_top_level_aux(Expr,Pred,ChangedIDs,_) :- | |
| 141 | before_after_predicate_no_equalities_aux(Expr,Pred,ChangedIDs). | |
| 142 | ||
| 143 | % ---------------- | |
| 144 | ||
| 145 | % does not add missing y' = y equalities for unchanged variables | |
| 146 | before_after_predicate_no_equalities(Action,Predicate,ChangedIDs) :- | |
| 147 | get_texpr_expr(Action,Expr), | |
| 148 | before_after_predicate_no_equalities_aux(Expr,Predicate,ChangedIDs). | |
| 149 | ||
| 150 | get_changed_id(b(function(FUN,_),_,_),ID) :- !, get_changed_id(FUN,ID). | |
| 151 | get_changed_id(ID,ID). | |
| 152 | ||
| 153 | % TO DO: return list of Predicates rather than single predicate; avoid conjunct_predicates and create flat conj at end | |
| 154 | before_after_predicate_no_equalities_aux(assign_single_id(Id,Pred),Predicate,ChangedIDs) :- !, | |
| 155 | before_after_predicate_no_equalities_aux(assign([Id],[Pred]),Predicate,ChangedIDs). | |
| 156 | before_after_predicate_no_equalities_aux(assign(Ids,Preds),Predicate,ChangedIds) :- !, | |
| 157 | maplist(get_changed_id,Ids,ChangedIds), | |
| 158 | maplist(ba_predicate_equal,Ids,Preds,Predicates), | |
| 159 | conjunct_predicates(Predicates,Predicate). | |
| 160 | before_after_predicate_no_equalities_aux(becomes_element_of(Ids,Set),Predicate,Ids) :- !, | |
| 161 | maplist(ba_predicate_member(Set),Ids,Predicates), | |
| 162 | % THIS IS WRONG: it asserts that each Id is an element of Set, but the tuple Ids is an element! | |
| 163 | conjunct_predicates(Predicates,Predicate). % should we generate Set /= {} => Predicate | |
| 164 | before_after_predicate_no_equalities_aux(becomes_such(Ids,Pred),Predicate,Ids) :- !, | |
| 165 | ba_predicate_becomes_such(Ids,Pred,Predicate). | |
| 166 | before_after_predicate_no_equalities_aux(choice(Choices),Predicate,ChangedIDs) :- !, | |
| 167 | maplist(before_after_predicate_no_equalities,Choices,BAChoices,Changes), | |
| 168 | append(Changes,ChangedIDs), | |
| 169 | maplist(add_missing_equalities(ChangedIDs),BAChoices,BAChoicesWithEqualities), | |
| 170 | disjunct_predicates(BAChoicesWithEqualities,Predicate). | |
| 171 | before_after_predicate_no_equalities_aux(precondition(Pre,Body),Predicate,ChangedIDs) :- !, | |
| 172 | before_after_predicate_no_equalities(Body,BABody,ChangedIDs), | |
| 173 | create_implication(Pre,BABody,Predicate). | |
| 174 | before_after_predicate_no_equalities_aux(witness_then(Pre,Body),Predicate,ChangedIDs) :- !, | |
| 175 | before_after_predicate_no_equalities_aux(assertion(Pre,Body),Predicate,ChangedIDs). % TODO: check if ok, or if we should use SELECT | |
| 176 | before_after_predicate_no_equalities_aux(assertion(Pre,Body),Predicate,ChangedIDs) :- | |
| 177 | !, | |
| 178 | before_after_predicate_no_equalities(Body,BABody,ChangedIDs), | |
| 179 | create_implication(Pre,BABody,Predicate1), | |
| 180 | create_negation(Pre,NotPre), | |
| 181 | add_missing_equalities(ChangedIDs,b(truth,pred,[]),NotPrePredicate), | |
| 182 | create_implication(NotPre,NotPrePredicate,Predicate2), | |
| 183 | conjunct_predicates([Predicate1,Predicate2],Predicate). | |
| 184 | before_after_predicate_no_equalities_aux(select_when(Pre,Body),Predicate,ChangedIDs) :- !, | |
| 185 | before_after_predicate_no_equalities(Body,BABody,ChangedIDs), | |
| 186 | conjunct_predicates([Pre,BABody],Predicate). | |
| 187 | before_after_predicate_no_equalities_aux(select(Whens),Predicate,ChangedIDs) :- !, | |
| 188 | maplist(before_after_predicate_no_equalities,Whens,WhensPredicates,Changes), | |
| 189 | append(Changes,ChangedIDs), | |
| 190 | maplist(add_missing_equalities(ChangedIDs),WhensPredicates,WhensPredicatesWithEqualities), | |
| 191 | disjunct_predicates(WhensPredicatesWithEqualities,Predicate). | |
| 192 | before_after_predicate_no_equalities_aux(select(Whens,Else),Predicate,ChangedIDs) :- !, | |
| 193 | maplist(before_after_predicate_no_equalities,Whens,WhensPredicates,Changes), | |
| 194 | maplist(add_missing_equalities(ChangedIDs),WhensPredicates,WhensPredicatesWithEqualities), | |
| 195 | maplist(get_select_conditions,Whens,SelectConditions), | |
| 196 | disjunct_predicates(SelectConditions,ElseTemp), | |
| 197 | create_negation(ElseTemp,ElseLHS), | |
| 198 | before_after_predicate_no_equalities(Else,ElseRHS,ElseChangedIDs), | |
| 199 | append([ElseChangedIDs|Changes],ChangedIDs), | |
| 200 | conjunct_predicates([ElseLHS,ElseRHS],ElsePred), | |
| 201 | add_missing_equalities(ChangedIDs,ElsePred,ElsePredWithEqualities), | |
| 202 | disjunct_predicates([ElsePredWithEqualities|WhensPredicatesWithEqualities],Predicate). | |
| 203 | % TODO: case, handle while | |
| 204 | before_after_predicate_no_equalities_aux(sequence(ListOfSteps),Predicate,ChangedIDs) :- !, | |
| 205 | ba_predicate_sequence(ListOfSteps,Predicate,ChangedIDs). | |
| 206 | before_after_predicate_no_equalities_aux(if(IfList),Predicate,ChangedIDs) :- !, | |
| 207 | ba_predicate_if(IfList,Predicate,ChangedIDs). | |
| 208 | before_after_predicate_no_equalities_aux(let(P,D,B),Predicate,ChangedIDs) :- !, | |
| 209 | before_after_predicate_no_equalities_aux(any(P,D,B),Predicate,ChangedIDs). % TO DO: create let_predicate | |
| 210 | before_after_predicate_no_equalities_aux(any(Parameters,PreCond,Body),Predicate,ChangedIDs) :- !, | |
| 211 | before_after_predicate_no_equalities(Body,BABody,ChangedIDs), | |
| 212 | conjunct_predicates([PreCond,BABody],Inner), | |
| 213 | create_or_merge_exists(Parameters,Inner,Predicate). | |
| 214 | before_after_predicate_no_equalities_aux(parallel(P),Predicate,ChangedIDs) :- !, | |
| 215 | maplist(before_after_predicate_no_equalities,P,Preds,Changes), | |
| 216 | append(Changes,ChangedIDs), | |
| 217 | conjunct_predicates(Preds,Predicate). | |
| 218 | before_after_predicate_no_equalities_aux(skip,Predicate,[]) :- !, | |
| 219 | Predicate = b(truth,pred,[]). | |
| 220 | before_after_predicate_no_equalities_aux(var(Parameters,Body),Predicate,ChangedIDs) :- !, | |
| 221 | before_after_predicate_no_equalities(Body,BABody,ChangedIDs), | |
| 222 | create_or_merge_exists(Parameters,BABody,Predicate). | |
| 223 | before_after_predicate_no_equalities_aux(rlevent(_Name,_Section,_Stat,_Parameters,Guards,_Thm,Actions,_VWit,_PWit,_Unmod,_AbsEvents),Predicate,ChangedIDs) :- !, | |
| 224 | maplist(before_after_predicate_no_equalities,Actions,BAActions,Changes), | |
| 225 | append(Changes,ChangedIDs), | |
| 226 | conjunct_predicates([Guards|BAActions],Predicate). % should probably be an implication? see precondition. | |
| 227 | before_after_predicate_no_equalities_aux(operation_call(OpId,[],[]),Predicate,ChangedIDs) :- !, | |
| 228 | get_texpr_id(OpId,op(OpName)), | |
| 229 | b_get_machine_operation(OpName,[],[],OpBody), | |
| 230 | before_after_predicate_no_equalities(OpBody,Predicate,ChangedIDs). | |
| 231 | before_after_predicate_no_equalities_aux(Expr,Predicate,ChangedIDs) :- | |
| 232 | add_error_fail(before_after_predicate,'before-after-predicate implementation missing: ',[Expr,Predicate,ChangedIDs]). | |
| 233 | ||
| 234 | get_select_conditions(b(select_when(Condition,_),_,_),Condition). | |
| 235 | ||
| 236 | ba_predicate_equal(LHS,RHS,Res) :- | |
| 237 | % LHS := RHS | |
| 238 | ? | get_override(LHS,RHS,TPred), !, |
| 239 | %nl,translate:print_bexpr(TPred),nl, | |
| 240 | Res=TPred. | |
| 241 | ||
| 242 | :- use_module(probsrc(error_manager),[add_internal_error/2]). | |
| 243 | % get override Term for f(X)(Y)... := RHS | |
| 244 | get_override(b(function(FUN,ARG),_Type,_Info),ExprSoFar,Res) :- !, % FUN(ARG) := RHS | |
| 245 | %print(fun(FUN)),nl, translate:print_bexpr(ExprSoFar),nl, | |
| 246 | get_texpr_type(FUN,FType), | |
| 247 | create_couple(ARG,ExprSoFar,Update), % ARG|-> ExprSoFar | |
| 248 | safe_create_texpr(set_extension([Update]),FType,UpdateSET), % {ARG|->ExprSoFar} | |
| 249 | construct_override(FUN,UpdateSET,Override), % FUN <+ {ARG |-> {...}} | |
| 250 | get_override(FUN,Override,Res). % Pass Override as new RHS in case FUN itself is a function application | |
| 251 | get_override(FUNID,OverrideExpr,TPred) :- | |
| 252 | get_texpr_id(FUNID,_ID), %print(base(ID)),nl, | |
| 253 | prime_typed_identifier(FUNID,FUNPrimeId), | |
| 254 | safe_create_texpr(equal(FUNPrimeId,OverrideExpr),pred,TPred). % FUN' = FUN <+ {ARG |-> RHS} | |
| 255 | get_override(FUNID,OverrideExpr,TPred) :- | |
| 256 | add_internal_error('Cannot compute override: ',get_override(FUNID,OverrideExpr,TPred)),fail. | |
| 257 | ||
| 258 | construct_override(FunID,Update,Override) :- | |
| 259 | get_texpr_type(Update,Type), | |
| 260 | Override = b(overwrite(FunID,Update),Type,[]). | |
| 261 | ||
| 262 | ba_predicate_member(Set,Id,TPred) :- | |
| 263 | % prime identifiers on the lhs | |
| 264 | prime_typed_identifier(Id,PrimedId), | |
| 265 | safe_create_texpr(member(PrimedId,Set),pred,TPred). | |
| 266 | ||
| 267 | ba_predicate_becomes_such(Ids,Pred,Predicate) :- | |
| 268 | list_renamings_to_primed_vars(Ids,RenamingList), | |
| 269 | rename_bt(Pred,RenamingList,Predicate). | |
| 270 | ||
| 271 | list_renamings_to_primed_vars([],[]). | |
| 272 | list_renamings_to_primed_vars([Var|Vars],[rename(VarId,PrimedId)|T]) :- | |
| 273 | get_texpr_id(Var,VarId), | |
| 274 | prime_id_atom(VarId,PrimedId), | |
| 275 | list_renamings_to_primed_vars(Vars,T). | |
| 276 | ||
| 277 | % add missing UNCHANGED equalities (x'=x for all variables that are unchanged) | |
| 278 | add_missing_equalities([],PredWithoutEqualities,Res) :- !, Res=PredWithoutEqualities. | |
| 279 | add_missing_equalities(AllVariables,PredWithoutEqualities,PredWithEqualities) :- | |
| 280 | find_typed_identifier_uses(PredWithoutEqualities,UsedIdentifiers), | |
| 281 | exclude(primed_var_is_used(UsedIdentifiers),AllVariables,VariablesNotOccuringPrimed), | |
| 282 | maplist(ba_predicate_equal,VariablesNotOccuringPrimed,VariablesNotOccuringPrimed,EqualityPredicates), | |
| 283 | conjunct_predicates([PredWithoutEqualities|EqualityPredicates],PredWithEqualities). | |
| 284 | ||
| 285 | :- use_module(probsrc(typing_tools),[normalize_type/2]). | |
| 286 | primed_var_is_used(UsedIdentifiers,Identifier) :- | |
| 287 | prime_typed_identifier(Identifier,PrimedIdentifier), | |
| 288 | remove_infos_and_norm(PrimedIdentifier,PrimedIdentifierWithoutInfos), | |
| 289 | ? | member(PrimedIdentifierWithoutInfos,UsedIdentifiers). |
| 290 | ||
| 291 | remove_infos_and_norm(b(E,Type,_),b(E,NType,_)) :- normalize_type(Type,NType). | |
| 292 | ||
| 293 | add_else_if_missing([],[DefaultElse]) :- | |
| 294 | safe_create_texpr(if_elsif(b(truth,pred,[]),b(skip,subst,[])),subst,DefaultElse). | |
| 295 | add_else_if_missing([If|Ifs],[If|Ifs]) :- | |
| 296 | get_texpr_expr(If,if_elsif(Test,_)), | |
| 297 | is_truth(Test), !. | |
| 298 | add_else_if_missing([If|Ifs],[If|MoreIfs]) :- | |
| 299 | add_else_if_missing(Ifs,MoreIfs). | |
| 300 | ||
| 301 | ba_predicate_if(IF,BA,AllChangedIDs) :- | |
| 302 | add_else_if_missing(IF,IFWithElse), | |
| 303 | maplist(ba_predicate_if_aux,IFWithElse,BAPreds,ChangedIDs), | |
| 304 | append(ChangedIDs,AllChangedIDs), | |
| 305 | ba_predicate_if(IFWithElse,BAPreds,AllChangedIDs,BA). | |
| 306 | ||
| 307 | ba_predicate_if([IF|IFs],[BAPred|BAPreds],IDs,BA) :- | |
| 308 | get_texpr_expr(IF,if_elsif(Test,_)), | |
| 309 | % if-part | |
| 310 | add_missing_equalities(IDs,BAPred,InnerBAPredIf), | |
| 311 | (is_truth(Test) | |
| 312 | -> InnerBAPredIf = BAPredIf | |
| 313 | ; safe_create_texpr(implication(Test,InnerBAPredIf),pred,BAPredIf)), | |
| 314 | % if there are further else/elseif parts, create pos | |
| 315 | (ba_predicate_if(IFs,BAPreds,IDs,ElsePred) | |
| 316 | -> create_negation(Test,NegTest), | |
| 317 | safe_create_texpr(implication(NegTest,ElsePred),pred,BAPredElse), | |
| 318 | conjunct_predicates([BAPredIf,BAPredElse],BA) | |
| 319 | ; BA = BAPredIf). | |
| 320 | ||
| 321 | ba_predicate_if_aux(IF,BAPred,ChangedIDs) :- | |
| 322 | get_texpr_expr(IF,if_elsif(_,Body)), | |
| 323 | before_after_predicate_no_equalities(Body,BAPred,ChangedIDs). | |
| 324 | ||
| 325 | ba_predicate_sequence([Last],Predicate,ChangedIDs) :- !, | |
| 326 | before_after_predicate_no_equalities(Last,Predicate,ChangedIDs). | |
| 327 | ba_predicate_sequence([First|SomeMore],Predicate,ChangedIDs) :- | |
| 328 | before_after_predicate_no_equalities(First,FirstPred,ChangesFirst), | |
| 329 | find_typed_identifier_uses(FirstPred,TypedIdsOfFirst), | |
| 330 | % get primed typed identifiers | |
| 331 | include(is_primed_typed_identifier,TypedIdsOfFirst,PrimedTypedIdsOfFirst), | |
| 332 | % rename them if they are already used in SomeMore | |
| 333 | ba_predicate_sequence(SomeMore,SecondPred,FurtherChanges), | |
| 334 | maplist(find_free_id_by_priming(SecondPred),PrimedTypedIdsOfFirst,UnusedPrimedTypedIds), | |
| 335 | maplist(create_id_renaming,PrimedTypedIdsOfFirst,UnusedPrimedTypedIds,RenamingOfFirst), | |
| 336 | rename_bt(FirstPred,RenamingOfFirst,FirstPredAfterReplacement), | |
| 337 | % rename unprimed ids in SecondPred, which are written by FirstPred | |
| 338 | maplist(remove_prime_typed_identifier,PrimedTypedIdsOfFirst,UnprimedTypedIds), | |
| 339 | maplist(create_id_renaming,UnprimedTypedIds,UnusedPrimedTypedIds,RenamingOfSecond), | |
| 340 | rename_bt(SecondPred,RenamingOfSecond,SecondPredAfterReplacement), | |
| 341 | ||
| 342 | conjunct_predicates([FirstPredAfterReplacement,SecondPredAfterReplacement],FullPred), | |
| 343 | % create exists for typed identifiers, which are primed more than once | |
| 344 | include(is_primed_more_than_once,UnusedPrimedTypedIds,TwoOrMorePrimedTypedIds), | |
| 345 | conjunction_to_list(FullPred,FullPredList), | |
| 346 | split_list(contains_some_typed_id(TwoOrMorePrimedTypedIds),FullPredList,ExistsPredList,RemainingPredList), | |
| 347 | conjunct_predicates(ExistsPredList,ExistsPred), | |
| 348 | create_exists(TwoOrMorePrimedTypedIds,ExistsPred,Exists), | |
| 349 | conjunct_predicates([Exists|RemainingPredList],Predicate), | |
| 350 | append(ChangesFirst,FurtherChanges,ChangedIDs). | |
| 351 | ||
| 352 | ||
| 353 | find_free_id_by_priming(Pred,TypedId,FreePrimedTypedId) :- | |
| 354 | find_typed_identifier_uses(Pred,TypedIds), | |
| 355 | (member(TypedId,TypedIds) -> | |
| 356 | prime_typed_identifier(TypedId,PrimedTypedId), | |
| 357 | find_free_id_by_priming(Pred,PrimedTypedId,FreePrimedTypedId) | |
| 358 | ; FreePrimedTypedId = TypedId). | |
| 359 | ||
| 360 | contains_some_typed_id(TypedIds,Pred) :- | |
| 361 | some(contains_typed_id(Pred),TypedIds). | |
| 362 | ||
| 363 | contains_typed_id(Pred,TypedId) :- | |
| 364 | find_typed_identifier_uses(Pred,TypedIds), | |
| 365 | member(TypedId,TypedIds). | |
| 366 | ||
| 367 | %prime_identifiers(TExprs,Primed) :- | |
| 368 | % maplist(prime_typed_identifier,TExprs,Primed). | |
| 369 | ||
| 370 | is_primed_more_than_once(TExpr) :- | |
| 371 | get_texpr_id(TExpr,ID), | |
| 372 | remove_prime_id_atom(ID,ID2), | |
| 373 | is_primed_id_atom(ID2). | |
| 374 | ||
| 375 | create_id_renaming(Var,RenamedVar,rename(Id,RenamedId)) :- | |
| 376 | get_texpr_id(Var,Id), | |
| 377 | get_texpr_id(RenamedVar,RenamedId). | |
| 378 | ||
| 379 |