1 % (c) 2014-2023 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,
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 sort(ChangedIds,SortedCIds),
86 transform_bexpr_with_scoping(before_after_predicates:prime_changed_id(SortedCIds,Changed),TExpr,PrimedTExpr),
87 (var(Changed) -> ChangesPerformed=false ; ChangesPerformed=true).
88
89 :- use_module(library(ordsets),[ord_member/2,ord_nonmember/2]).
90 :- use_module(probsrc(btypechecker),[prime_id/2]).
91 prime_changed_id(ChangedIds,Changed,b(identifier(ID),Type,Info),Result,LocalIds) :-
92 ord_member(ID,ChangedIds),
93 ord_nonmember(ID,LocalIds), % The ID is not overriden by a locally quantified variable
94 prime_id(ID,PrimedID),
95 Changed=true, % change was performed
96 Result = b(identifier(PrimedID),Type,Info).
97
98 % ----------------
99
100 %! before_after_predicate_with_equalities(+Action,+AllIdentifiers,-Predicate)
101 % these add missing y' = y equalities for unchanged variables
102 before_after_predicate_with_equalities(Action,AllIdentifiers,Predicate) :-
103 before_after_predicate_list_conjunct_with_equalities([Action],AllIdentifiers,Predicate).
104 before_after_predicate_list_conjunct_with_equalities(Actions,AllIdentifiers,BAPredicateWithEq) :-
105 maplist(before_after_predicate_no_equalities_tl3(top_level),Actions,AllPredicates),
106 conjunct_predicates(AllPredicates,BAPredicate),
107 add_missing_equalities(AllIdentifiers,BAPredicate,BAPredicateWithEq).
108 before_after_predicate_list_disjunct_with_equalities(Actions,AllIdentifiers,BAPredicate) :-
109 maplist(before_after_predicate_no_equalities_tl3(top_level),Actions,AllPredicates),
110 maplist(add_missing_equalities(AllIdentifiers),AllPredicates,BAPredicates),
111 disjunct_predicates(BAPredicates,BAPredicate).
112
113 % ----------------
114
115 % does not add missing y' = y equalities for unchanged variables
116 % top-level version: has a special rule for PRE
117 before_after_predicate_no_equalities_tl3(TopLevel,Action,Predicate) :-
118 before_after_predicate_no_equalities_tl4(TopLevel,Action,Predicate,_).
119 before_after_predicate_no_equalities_tl4(TopLevel,Action,Predicate,ChangedIDs) :-
120 get_texpr_expr(Action,Expr),
121 before_after_predicate_no_equalities_top_level_aux(Expr,Predicate,ChangedIDs,TopLevel).
122
123 :- use_module(probsrc(preferences),[get_preference/2]).
124 before_after_predicate_no_equalities_top_level_aux(precondition(Pre,Body),Predicate,ChangedIDs,top_level) :-
125 get_preference(treat_outermost_pre_as_select,true),
126 !,
127 before_after_predicate_no_equalities(Body,BABody,ChangedIDs),
128 conjunct_predicates([Pre,BABody],Predicate). % May sometimes have to be an implication (depending on how BA-predicate is used) !
129 before_after_predicate_no_equalities_top_level_aux(Expr,Pred,ChangedIDs,_) :-
130 before_after_predicate_no_equalities_aux(Expr,Pred,ChangedIDs).
131
132 % ----------------
133
134 % does not add missing y' = y equalities for unchanged variables
135 before_after_predicate_no_equalities(Action,Predicate,ChangedIDs) :-
136 get_texpr_expr(Action,Expr),
137 before_after_predicate_no_equalities_aux(Expr,Predicate,ChangedIDs).
138
139 get_changed_id(b(function(FUN,_),_,_),ID) :- !, get_changed_id(FUN,ID).
140 get_changed_id(ID,ID).
141
142 % TO DO: return list of Predicates rather than single predicate; avoid conjunct_predicates and create flat conj at end
143 before_after_predicate_no_equalities_aux(assign_single_id(Id,Pred),Predicate,ChangedIDs) :- !,
144 before_after_predicate_no_equalities_aux(assign([Id],[Pred]),Predicate,ChangedIDs).
145 before_after_predicate_no_equalities_aux(assign(Ids,Preds),Predicate,ChangedIds) :- !,
146 maplist(get_changed_id,Ids,ChangedIds),
147 maplist(ba_predicate_equal,Ids,Preds,Predicates),
148 conjunct_predicates(Predicates,Predicate).
149 before_after_predicate_no_equalities_aux(becomes_element_of(Ids,Set),Predicate,Ids) :- !,
150 maplist(ba_predicate_member(Set),Ids,Predicates),
151 conjunct_predicates(Predicates,Predicate). % should we generate Set /= {} => Predicate
152 before_after_predicate_no_equalities_aux(becomes_such(Ids,Pred),Predicate,Ids) :- !,
153 ba_predicate_becomes_such(Ids,Pred,Predicate).
154 before_after_predicate_no_equalities_aux(choice(Choices),Predicate,ChangedIDs) :- !,
155 maplist(before_after_predicate_no_equalities,Choices,BAChoices,Changes),
156 append(Changes,ChangedIDs),
157 maplist(add_missing_equalities(ChangedIDs),BAChoices,BAChoicesWithEqualities),
158 disjunct_predicates(BAChoicesWithEqualities,Predicate).
159 before_after_predicate_no_equalities_aux(precondition(Pre,Body),Predicate,ChangedIDs) :- !,
160 before_after_predicate_no_equalities(Body,BABody,ChangedIDs),
161 create_implication(Pre,BABody,Predicate).
162 before_after_predicate_no_equalities_aux(assertion(Pre,Body),Predicate,ChangedIDs) :-
163 !,
164 before_after_predicate_no_equalities(Body,BABody,ChangedIDs),
165 create_implication(Pre,BABody,Predicate1),
166 create_negation(Pre,NotPre),
167 add_missing_equalities(ChangedIDs,b(truth,pred,[]),NotPrePredicate),
168 create_implication(NotPre,NotPrePredicate,Predicate2),
169 conjunct_predicates([Predicate1,Predicate2],Predicate).
170 before_after_predicate_no_equalities_aux(select_when(Pre,Body),Predicate,ChangedIDs) :- !,
171 before_after_predicate_no_equalities(Body,BABody,ChangedIDs),
172 conjunct_predicates([Pre,BABody],Predicate).
173 before_after_predicate_no_equalities_aux(select(Whens),Predicate,ChangedIDs) :- !,
174 maplist(before_after_predicate_no_equalities,Whens,WhensPredicates,Changes),
175 append(Changes,ChangedIDs),
176 maplist(add_missing_equalities(ChangedIDs),WhensPredicates,WhensPredicatesWithEqualities),
177 disjunct_predicates(WhensPredicatesWithEqualities,Predicate).
178 before_after_predicate_no_equalities_aux(select(Whens,Else),Predicate,ChangedIDs) :- !,
179 maplist(before_after_predicate_no_equalities,Whens,WhensPredicates,Changes),
180 maplist(add_missing_equalities(ChangedIDs),WhensPredicates,WhensPredicatesWithEqualities),
181 maplist(get_select_conditions,Whens,SelectConditions),
182 disjunct_predicates(SelectConditions,ElseTemp),
183 create_negation(ElseTemp,ElseLHS),
184 before_after_predicate_no_equalities(Else,ElseRHS,ElseChangedIDs),
185 append([ElseChangedIDs|Changes],ChangedIDs),
186 conjunct_predicates([ElseLHS,ElseRHS],ElsePred),
187 add_missing_equalities(ChangedIDs,ElsePred,ElsePredWithEqualities),
188 disjunct_predicates([ElsePredWithEqualities|WhensPredicatesWithEqualities],Predicate).
189 % TODO: case, handle while
190 before_after_predicate_no_equalities_aux(sequence(ListOfSteps),Predicate,ChangedIDs) :- !,
191 ba_predicate_sequence(ListOfSteps,Predicate,ChangedIDs).
192 before_after_predicate_no_equalities_aux(if(IfList),Predicate,ChangedIDs) :- !,
193 ba_predicate_if(IfList,Predicate,ChangedIDs).
194 before_after_predicate_no_equalities_aux(let(P,D,B),Predicate,ChangedIDs) :- !,
195 before_after_predicate_no_equalities_aux(any(P,D,B),Predicate,ChangedIDs). % TO DO: create let_predicate
196 before_after_predicate_no_equalities_aux(any(Parameters,PreCond,Body),Predicate,ChangedIDs) :- !,
197 before_after_predicate_no_equalities(Body,BABody,ChangedIDs),
198 conjunct_predicates([PreCond,BABody],Inner),
199 create_or_merge_exists(Parameters,Inner,Predicate).
200 before_after_predicate_no_equalities_aux(parallel(P),Predicate,ChangedIDs) :- !,
201 maplist(before_after_predicate_no_equalities,P,Preds,Changes),
202 append(Changes,ChangedIDs),
203 conjunct_predicates(Preds,Predicate).
204 before_after_predicate_no_equalities_aux(skip,Predicate,[]) :- !,
205 Predicate = b(truth,pred,[]).
206 before_after_predicate_no_equalities_aux(var(Parameters,Body),Predicate,ChangedIDs) :- !,
207 before_after_predicate_no_equalities(Body,BABody,ChangedIDs),
208 create_or_merge_exists(Parameters,BABody,Predicate).
209 before_after_predicate_no_equalities_aux(rlevent(_Name,_Section,_Stat,_Parameters,Guards,_Thm,Actions,_VWit,_PWit,_Unmod,_AbsEvents),Predicate,ChangedIDs) :- !,
210 maplist(before_after_predicate_no_equalities,Actions,BAActions,Changes),
211 append(Changes,ChangedIDs),
212 conjunct_predicates([Guards|BAActions],Predicate). % should probably be an implication? see precondition.
213 before_after_predicate_no_equalities_aux(operation_call(OpId,[],[]),Predicate,ChangedIDs) :- !,
214 get_texpr_id(OpId,op(OpName)),
215 b_get_machine_operation(OpName,[],[],OpBody),
216 before_after_predicate_no_equalities(OpBody,Predicate,ChangedIDs).
217 before_after_predicate_no_equalities_aux(Expr,Predicate,ChangedIDs) :-
218 add_error_fail(before_after_predicate,'before-after-predicate implementation missing: ',[Expr,Predicate,ChangedIDs]).
219
220 get_select_conditions(b(select_when(Condition,_),_,_),Condition).
221
222 ba_predicate_equal(LHS,RHS,Res) :-
223 % LHS := RHS
224 get_override(LHS,RHS,TPred), !,
225 %nl,translate:print_bexpr(TPred),nl,
226 Res=TPred.
227
228 :- use_module(probsrc(error_manager),[add_internal_error/2]).
229 % get override Term for f(X)(Y)... := RHS
230 get_override(b(function(FUN,ARG),_Type,_Info),ExprSoFar,Res) :- !, % FUN(ARG) := RHS
231 %print(fun(FUN)),nl, translate:print_bexpr(ExprSoFar),nl,
232 get_texpr_type(FUN,FType),
233 create_couple(ARG,ExprSoFar,Update), % ARG|-> ExprSoFar
234 safe_create_texpr(set_extension([Update]),FType,UpdateSET), % {ARG|->ExprSoFar}
235 construct_override(FUN,UpdateSET,Override), % FUN <+ {ARG |-> {...}}
236 get_override(FUN,Override,Res). % Pass Override as new RHS in case FUN itself is a function application
237 get_override(FUNID,OverrideExpr,TPred) :-
238 get_texpr_id(FUNID,_ID), %print(base(ID)),nl,
239 prime_typed_identifier(FUNID,FUNPrimeId),
240 safe_create_texpr(equal(FUNPrimeId,OverrideExpr),pred,TPred). % FUN' = FUN <+ {ARG |-> RHS}
241 get_override(FUNID,OverrideExpr,TPred) :-
242 add_internal_error('Cannot compute override: ',get_override(FUNID,OverrideExpr,TPred)),fail.
243
244 construct_override(FunID,Update,Override) :-
245 get_texpr_type(Update,Type),
246 Override = b(overwrite(FunID,Update),Type,[]).
247
248 ba_predicate_member(Set,Id,TPred) :-
249 % prime identifiers on the lhs
250 prime_typed_identifier(Id,PrimedId),
251 safe_create_texpr(member(PrimedId,Set),pred,TPred).
252
253 ba_predicate_becomes_such(Ids,Pred,Predicate) :-
254 list_renamings_to_primed_vars(Ids,RenamingList),
255 rename_bt(Pred,RenamingList,Predicate).
256
257 list_renamings_to_primed_vars([],[]).
258 list_renamings_to_primed_vars([Var|Vars],[rename(VarId,PrimedId)|T]) :-
259 get_texpr_id(Var,VarId),
260 prime_id_atom(VarId,PrimedId),
261 list_renamings_to_primed_vars(Vars,T).
262
263 % add missing UNCHANGED equalities (x'=x for all variables that are unchanged)
264 add_missing_equalities([],PredWithoutEqualities,Res) :- !, Res=PredWithoutEqualities.
265 add_missing_equalities(AllVariables,PredWithoutEqualities,PredWithEqualities) :-
266 find_typed_identifier_uses(PredWithoutEqualities,UsedIdentifiers),
267 exclude(primed_var_is_used(UsedIdentifiers),AllVariables,VariablesNotOccuringPrimed),
268 maplist(ba_predicate_equal,VariablesNotOccuringPrimed,VariablesNotOccuringPrimed,EqualityPredicates),
269 conjunct_predicates([PredWithoutEqualities|EqualityPredicates],PredWithEqualities).
270
271 :- use_module(probsrc(typing_tools),[normalize_type/2]).
272 primed_var_is_used(UsedIdentifiers,Identifier) :-
273 prime_typed_identifier(Identifier,PrimedIdentifier),
274 remove_infos_and_norm(PrimedIdentifier,PrimedIdentifierWithoutInfos),
275 member(PrimedIdentifierWithoutInfos,UsedIdentifiers).
276
277 remove_infos_and_norm(b(E,Type,_),b(E,NType,_)) :- normalize_type(Type,NType).
278
279 add_else_if_missing([],[DefaultElse]) :-
280 safe_create_texpr(if_elsif(b(truth,pred,[]),b(skip,subst,[])),subst,DefaultElse).
281 add_else_if_missing([If|Ifs],[If|Ifs]) :-
282 get_texpr_expr(If,if_elsif(Test,_)),
283 is_truth(Test), !.
284 add_else_if_missing([If|Ifs],[If|MoreIfs]) :-
285 add_else_if_missing(Ifs,MoreIfs).
286
287 ba_predicate_if(IF,BA,AllChangedIDs) :-
288 add_else_if_missing(IF,IFWithElse),
289 maplist(ba_predicate_if_aux,IFWithElse,BAPreds,ChangedIDs),
290 append(ChangedIDs,AllChangedIDs),
291 ba_predicate_if(IFWithElse,BAPreds,AllChangedIDs,BA).
292
293 ba_predicate_if([IF|IFs],[BAPred|BAPreds],IDs,BA) :-
294 get_texpr_expr(IF,if_elsif(Test,_)),
295 % if-part
296 add_missing_equalities(IDs,BAPred,InnerBAPredIf),
297 (is_truth(Test)
298 -> InnerBAPredIf = BAPredIf
299 ; safe_create_texpr(implication(Test,InnerBAPredIf),pred,BAPredIf)),
300 % if there are further else/elseif parts, create pos
301 (ba_predicate_if(IFs,BAPreds,IDs,ElsePred)
302 -> create_negation(Test,NegTest),
303 safe_create_texpr(implication(NegTest,ElsePred),pred,BAPredElse),
304 conjunct_predicates([BAPredIf,BAPredElse],BA)
305 ; BA = BAPredIf).
306
307 ba_predicate_if_aux(IF,BAPred,ChangedIDs) :-
308 get_texpr_expr(IF,if_elsif(_,Body)),
309 before_after_predicate_no_equalities(Body,BAPred,ChangedIDs).
310
311 ba_predicate_sequence([Last],Predicate,ChangedIDs) :- !,
312 before_after_predicate_no_equalities(Last,Predicate,ChangedIDs).
313 ba_predicate_sequence([First|SomeMore],Predicate,ChangedIDs) :-
314 before_after_predicate_no_equalities(First,FirstPred,ChangesFirst),
315 find_typed_identifier_uses(FirstPred,TypedIdsOfFirst),
316 % get primed typed identifiers
317 include(is_primed_typed_identifier,TypedIdsOfFirst,PrimedTypedIdsOfFirst),
318 % rename them if they are already used in SomeMore
319 ba_predicate_sequence(SomeMore,SecondPred,FurtherChanges),
320 maplist(find_free_id_by_priming(SecondPred),PrimedTypedIdsOfFirst,UnusedPrimedTypedIds),
321 maplist(create_id_renaming,PrimedTypedIdsOfFirst,UnusedPrimedTypedIds,RenamingOfFirst),
322 rename_bt(FirstPred,RenamingOfFirst,FirstPredAfterReplacement),
323 % rename unprimed ids in SecondPred, which are written by FirstPred
324 maplist(remove_prime_typed_identifier,PrimedTypedIdsOfFirst,UnprimedTypedIds),
325 maplist(create_id_renaming,UnprimedTypedIds,UnusedPrimedTypedIds,RenamingOfSecond),
326 rename_bt(SecondPred,RenamingOfSecond,SecondPredAfterReplacement),
327
328 conjunct_predicates([FirstPredAfterReplacement,SecondPredAfterReplacement],FullPred),
329 % create exists for typed identifiers, which are primed more than once
330 include(is_primed_more_than_once,UnusedPrimedTypedIds,TwoOrMorePrimedTypedIds),
331 conjunction_to_list(FullPred,FullPredList),
332 split_list(contains_some_typed_id(TwoOrMorePrimedTypedIds),FullPredList,ExistsPredList,RemainingPredList),
333 conjunct_predicates(ExistsPredList,ExistsPred),
334 create_exists(TwoOrMorePrimedTypedIds,ExistsPred,Exists),
335 conjunct_predicates([Exists|RemainingPredList],Predicate),
336 append(ChangesFirst,FurtherChanges,ChangedIDs).
337
338
339 find_free_id_by_priming(Pred,TypedId,FreePrimedTypedId) :-
340 find_typed_identifier_uses(Pred,TypedIds),
341 (member(TypedId,TypedIds) ->
342 prime_typed_identifier(TypedId,PrimedTypedId),
343 find_free_id_by_priming(Pred,PrimedTypedId,FreePrimedTypedId)
344 ; FreePrimedTypedId = TypedId).
345
346 contains_some_typed_id(TypedIds,Pred) :-
347 some(contains_typed_id(Pred),TypedIds).
348
349 contains_typed_id(Pred,TypedId) :-
350 find_typed_identifier_uses(Pred,TypedIds),
351 member(TypedId,TypedIds).
352
353 prime_identifiers(TExprs,Primed) :-
354 maplist(prime_typed_identifier,TExprs,Primed).
355
356 is_primed_more_than_once(TExpr) :-
357 get_texpr_id(TExpr,ID),
358 remove_prime_id_atom(ID,ID2),
359 is_primed_id_atom(ID2).
360
361 create_id_renaming(Var,RenamedVar,rename(Id,RenamedId)) :-
362 get_texpr_id(Var,Id),
363 get_texpr_id(RenamedVar,RenamedId).
364
365