1 % Heinrich Heine Universitaet Duesseldorf
2 % (c) 2025-2026 Lehrstuhl fuer Softwaretechnik und Programmiersprachen,
3 % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html)
4
5
6 :- module(prover_utils,[member_hyps/2, equal_terms/2,
7 rewrite/4, with_ids/2, rewrite_pairwise/4, rewrite_pairwise_rev/4,
8 member_of/3, member_of_bin_op/3,
9 select_op/4, select_op/5,
10 op_to_list/3, list_to_op/3,
11 remove_duplicates_for_op/3, without_duplicates/2,
12 negate/2,
13 new_identifier/2, used_identifiers/2, used_identifiers_list/2, possible_identifier/1,
14 range_ids/3, new_identifiers/3, new_aux_identifier/2,
15 free_identifiers/2,
16 is_fun/4, is_rel/4, is_surj/3, is_inj/3,
17 is_natural_set/1, is_natural1_set/1, is_integer_set/1,
18 is_less_eq/3, is_less/3, is_equality/3, is_inequality/3,
19 comparison/1,
20 sym_unify/4, is_inter/3, is_minus/2, is_empty/2, is_negation/2,
21 of_integer_type/2, singleton_set/2,
22 split_composition/3,
23 type_expression/2, get_type_expression/2, is_deferred_or_enumerated_set/2,
24 get_typed_identifiers/2, get_typed_identifiers/3,
25 get_meta_info/3, update_meta_infos/4, add_meta_info/4, remove_meta_info/4,
26 translate_norm_expr_term/2, create_descr/3, create_descr/4]).
27
28
29 :- use_module(probsrc(module_information),[module_info/2]).
30 :- module_info(group,sequent_prover).
31 :- module_info(description,'This module provides hyp managament and other utilities on sequents and hyps').
32
33 :- use_module(library(lists)).
34 :- use_module(probsrc(tools),[ajoin/2, list_difference/3]).
35
36 member_hyps(Goal,Hyps) :-
37 (member(Goal,Hyps) -> true
38 ; equiv(Goal,G2), member(G2,Hyps) -> true), !.
39 member_hyps(Goal,Hyps) :-
40 ground(Goal),
41 member(G2,Hyps),
42 comparable(Goal,G2),
43 list_representation(Goal,L1),
44 list_representation(G2,L2),
45 equal_length(L1,L2),
46 stronger_list(L2,L1).
47
48
49 % replace by normalisation
50 equiv(equal(A,B),equal(B,A)).
51 equiv(not_equal(A,B),not_equal(B,A)).
52 equiv(greater(A,B),less(B,A)).
53 equiv(less(A,B),greater(B,A)).
54 equiv(greater_equal(A,B),less_equal(B,A)).
55 equiv(less_equal(A,B),greater_equal(B,A)).
56
57 % ----------------
58
59 % rewrite X to E
60 rewrite(X,Y,E,NewE) :- equal_terms(X,E),!, NewE=Y.
61 rewrite(_X,_Y,E,NewE) :- atomic(E),!, NewE=E.
62 rewrite(_X,_Y,'$'(E),NewE) :- atomic(E),!, NewE='$'(E).
63 rewrite(X,_,E,NewE) :- with_ids(E,Ids), member(X,Ids),!, NewE=E.
64 rewrite(X,Y,C,NewC) :- C=..[Op|Args],
65 l_rewrite(Args,X,Y,NewArgs),
66 NewC =.. [Op|NewArgs].
67
68 l_rewrite([],_,_,[]).
69 l_rewrite([H|T],X,Y,[RH|RT]) :- rewrite(X,Y,H,RH), l_rewrite(T,X,Y,RT).
70
71 with_ids(exists(Ids,_),Ids).
72 with_ids(event_b_comprehension_set(Ids,_,_),Ids).
73 with_ids(forall(Ids,_,_),Ids).
74 with_ids(quantified_union(Ids,_,_),Ids).
75 with_ids(quantified_intersection(Ids,_,_),Ids).
76
77
78 rewrite_pairwise_rev(Ids1,Ids2,P,NewP) :-
79 reverse(Ids1,RevIds1),
80 reverse(Ids2,RevIds2),
81 rewrite_pairwise(RevIds1,RevIds2,P,NewP).
82
83 rewrite_pairwise([],[],E,E).
84 rewrite_pairwise([X|TX],[Y|TY],E,Res) :-
85 rewrite(X,Y,E,NewE),
86 rewrite_pairwise(TX,TY,NewE,Res).
87
88 % ----------------
89
90 equal_terms(X,Y) :- nonvar(X),simple_term_to_unify(X), !, Y=X. % avoid normalising Y
91 equal_terms(X,Y) :- nonvar(Y),simple_term_to_unify(Y), !, X=Y. % ditto for X
92 equal_terms(X,X) :- !.
93 equal_terms(X,Y) :- % both must be nonvar; otherwise unification would have succeeded
94 (cannot_change_functor(X,F) -> functor(Y,F,_) ; cannot_change_functor(Y,F) -> functor(X,F,_) ; true),
95 ground(X), ground(Y),
96 list_representation(X,LX),
97 list_representation(Y,LY),
98 equal_op(LX,LY),
99 equal_length(LX,LY),
100 equal_lists(LX,LY).
101
102 % true if list_representation cannot change functor and no other functor can generate it
103 % useful to quickly check top-level functor before normalising full terms
104 % TODO: extend; basically only arithmetic operators are simplified, and can be changed into numbers
105 % TODO: not sure the exclude zero/one rules should be part of equal_terms? can Rodin replay those?
106 cannot_change_functor(implication(_,_),implication).
107 cannot_change_functor(equal(_,_),equal).
108 cannot_change_functor(member(_,_),member).
109 cannot_change_functor(negation(_),negation).
110 cannot_change_functor(truth,truth).
111 cannot_change_functor(C,F) :- comm_binop(C,F,_,_).
112
113 % simple terms where we can simply use Prolog unification
114 simple_term_to_unify('$'(_)).
115 %simple_term(Nr) :- integer(Nr). % numbers require evaluation of other part!
116
117 equal_lists(L1,L2) :- sort_list(L1,SL1), sort_list(L2,SL2), SL1 = SL2.
118
119 stronger_list(L1,L2) :- sort_list(L1,SL1), sort_list(L2,SL2), list_implies(SL1,SL2).
120
121 list_implies([],[]).
122 list_implies([H1|T1], [H2|T2]) :-
123 implies(H1,H2),
124 list_implies(T1,T2).
125
126 % a hypothesis "a > b" is a sufficient condition to discharge the goal "a >= b" with HYP
127 implies(X,X).
128 implies(c(L,equal),c(L,greater_equal)).
129 implies(c(L,equal),c(RL,greater_equal)) :- reverse(L,RL).
130 implies(c(L,greater),c(L,greater_equal)).
131 implies(c(L,greater),c(L,not_equal)).
132
133 comparable(G1,G2) :- functor(G1,T1,2), functor(G2,T2,2), comparison(T1), comparison(T2).
134 comparable(G1,G2) :- G1=..[F,P], G2=..[F,Q], !, comparable(P,Q).
135 comparable(G1,G2) :- functor(G1,F,_), functor(G2,F,_). % TODO: why is this req. weaker than in clause above for arity 1?
136
137 comparison(equal).
138 comparison(greater).
139 comparison(greater_equal).
140 comparison(less).
141 comparison(less_equal).
142 comparison(not_equal).
143
144 list_representation(A,B,OList,L3) :-
145 list_representation(A,OList,L1),
146 list_representation(B,[],L2),
147 append(L1,L2,L3).
148
149 list_representation(C,L) :- list_representation(C,[],L).
150 list_representation('$'(X),L,Res) :- !, Res=[X|L].
151 list_representation(less_equal(A,B),OList,Res) :- !, list_representation(B,A,OList,NList), Res=[c(NList,greater_equal)].
152 list_representation(greater_equal(A,B),OList,Res) :- !, list_representation(A,B,OList,NList), Res=[c(NList,greater_equal)].
153 list_representation(less(A,B),OList,Res) :- !, list_representation(B,A,OList,NList), Res=[c(NList,greater)].
154 list_representation(greater(A,B),OList,Res) :- !, list_representation(A,B,OList,NList), Res=[c(NList,greater)].
155 list_representation(minus(A,B),OList,NList) :- !,
156 collect_subtrahend(minus(A,B),Subtraction),
157 Subtraction = [Minuend, Subtrahend],
158 exclude_nr(Subtrahend, 0, NSubtrahend), % exclude(zero, Subtrahend, NSubtrahend),
159 (NSubtrahend == [] -> NList = [Minuend] ;
160 append(OList,[c([Minuend, NSubtrahend],minus)],NList)).
161 list_representation(div(A,B),OList,NList) :- !,
162 collect_divisor(div(A,B),Division),
163 Division = [Divident, Divisor],
164 exclude_nr(Divisor, 1, NDivisor), %exclude(one, Divisor, NDivisor),
165 (NDivisor == [] -> NList = [Divident] ;
166 append(OList,[c([Divident, NDivisor],div)],NList)).
167 list_representation(C,OList,Res) :-
168 comm_binop(C,F,A,B), !,
169 collect_components(A,B,OList,NList,F),
170 Res=[c(NList,F)].
171 list_representation(add(A,B),OList,Res) :- !,
172 collect_components(A,B,OList,NList,add),
173 exclude_nr(NList,0,NList2), %exclude(zero, NList, NList2),
174 (NList2 == [] -> Res = [0] ;
175 NList2 \= [_]-> Res = [c(NList2,add)] ;
176 Res = NList2).
177 list_representation(multiplication(A,B),OList,Res) :- !,
178 collect_components(A,B,OList,NList,multiplication),
179 exclude_nr(NList,1,NList2), %exclude(one, NList, NList2),
180 (member(0, NList2) -> Res = [0] ;
181 NList2 == [] -> Res = [1] ;
182 NList2 \= [_]-> Res = [c(NList2,multiplication)] ;
183 Res = NList2).
184 list_representation(set_extension(A),OList,Res) :- !,
185 list_representation_of_list(A,OList,NList), sort(NList,S), Res=[c(S,set_extension)].
186 list_representation([A|T],OList,Res) :- !, list_representation_of_list([A|T],OList,NList), Res=[c(NList,list)].
187 list_representation(C,OList,Res) :- C=..[F,A], !, list_representation(A,OList,NList), Res=[c(NList,F)].
188 list_representation(C,OList,Res) :-
189 C=..[F,A,B],!,
190 list_representation(A,B,OList,NList), Res=[c(NList,F)].
191 list_representation(X,L,[X|L]) :- atomic(X).
192
193 comm_binop(conjunct(A,B),conjunct,A,B).
194 comm_binop(disjunct(A,B),disjunct,A,B).
195 comm_binop(intersection(A,B),intersection,A,B).
196 comm_binop(union(A,B),union,A,B).
197
198 list_representation_of_list([],OList,OList).
199 list_representation_of_list([A|T],OList,NList) :- list_representation(A,OList,L1), list_representation_of_list(T,[],L2),append(L1,L2,NList).
200
201 one(X) :- X is 1.
202 zero(X) :- X is 0.
203 exclude_nr([],_,[]).
204 exclude_nr([H|T],Nr,Res) :-
205 (H==Nr -> exclude_nr(T,Nr,Res) ; Res=[H|TR], exclude_nr(T,Nr,TR)).
206
207 collect_components(A,B,OList,NList,T) :-
208 collect_component(A,OList,L1,T),
209 collect_component(B,L1,NList,T).
210
211 collect_component('$'(X),OList,NList,_) :- !,
212 append(OList,[X],NList).
213 collect_component(X,OList,NList,_) :-
214 atomic(X),!,
215 append(OList,[X],NList).
216 collect_component(C,OList,NList,T) :-
217 C=..[T,A,B],!,
218 collect_components(A,B,OList,NList,T).
219 collect_component(X,OList,NList,_) :-
220 list_representation(X,[],L1),
221 append(OList,L1,NList).
222
223 collect_subtrahend(minus(A, B), [LA, Sub]) :-
224 A \= minus(_,_), !,
225 list_representation(A,[LA]),
226 (B = 0 -> Sub = [] ;
227 list_representation(B,[LB]), Sub = [LB]).
228 collect_subtrahend(minus(A, B), [Minuend, NSubtrahends]) :-
229 collect_subtrahend(A, [Minuend, Subtrahends]),
230 list_representation(B,LB),
231 append(Subtrahends, LB, NSubtrahends).
232
233 collect_divisor(div(A, B), [LA, Div]) :-
234 A \= div(_,_), !,
235 list_representation(A,[LA]),
236 (B = 1 -> Div = [] ;
237 list_representation(B,[LB]), Div = [LB]).
238 collect_divisor(div(A, B), [Divident, NDivisors]) :-
239 collect_divisor(A, [Divident, Divisors]),
240 list_representation(B,LB),
241 append(Divisors, LB, NDivisors).
242
243 :- use_module(library(samsort)).
244
245 sort_list(L,R) :- sort_components(L,S), samsort(S,R).
246 sort_components([],[]).
247 sort_components([c(L,T)|Rest], Res) :-
248 commutative_op(T), !,
249 sort_list(L,SL),
250 sort_components(Rest,R),
251 Res=[c(SL,T)|R].
252 sort_components([c(L,T)|Rest], Res) :- !, % non-commutative
253 sort_components(L,L2),
254 sort_components(Rest,R),
255 Res=[c(L2,T)|R].
256 % sort list of subtrahends or divisors
257 sort_components([E|Rest], [E|R]) :- atomic(E), !, sort_components(Rest,R).
258 sort_components([E|Rest], [F|R]) :- sort_list(E,F), sort_components(Rest,R).
259
260 commutative_op(disjunct). commutative_op(conjunct). commutative_op(equivalence).
261 commutative_op(union). commutative_op(intersection).
262 commutative_op(add). commutative_op(multiplication).
263 commutative_op(equal). commutative_op(not_equal).
264 commutative_op(negation). commutative_op(unary_minus). % these are unary ?!
265 commutative_op(set_extension). commutative_op(list).
266
267
268 equal_op(L1,L2) :- L1 = [c(_,T1)], L2 = [c(_,T2)], !, T1 = T2.
269 equal_op([E1],[E2]) :- E1 \= [c(_,_)], E2 \= [c(_,_)].
270
271 equal_length(L1,L2) :- L1 = [c(A1,_)], L2 = [c(A2,_)], !, same_length(A1, A2).
272 equal_length([_],[_]).
273
274
275 % -------------------------
276
277
278 % check if X is either equal to Term or is a sub-term, traversing all binary operators Op
279 member_of(Op,X,Term) :- functor(Term,Op,2), !,
280 (arg(1,Term,A),member_of(Op,X,A) ; arg(2,Term,B), member_of(Op,X,B)).
281 % TODO: this will not find P if P uses top-level functor Op itself! Review all uses and see if this is ok
282 member_of(_,P,P).
283
284 % difference to member_of: this requires top-level of Term to be binary operator
285 member_of_bin_op(Op,X,Term) :- functor(Term,Op,2), !,
286 (arg(1,Term,A),member_of(Op,X,A) ; arg(2,Term,B), member_of(Op,X,B)).
287
288 % select and remove (first occurrence of) X:
289 select_op(X,C,Rest,Op) :- C=..[Op,A,B],
290 (select_op(X,A,RA,Op), conjoin4(RA,B,Rest,Op)
291 ;
292 select_op(X,B,RB,Op), conjoin4(A,RB,Rest,Op)), !.
293 select_op(X,X,E,Op) :- neutral_element(Op,E).
294 select_op(X,Y,E,Op) :- neutral_element(Op,E), equal_terms(X,Y).
295
296 % replace (first occurrence of) X by Z:
297 select_op(X,C,Z,New,Op) :- C=..[Op,A,B],
298 (select_op(X,A,Z,RA,Op), conjoin4(RA,B,New,Op) ;
299 select_op(X,B,Z,RB,Op), conjoin4(A,RB,New,Op)), !.
300 select_op(X,X,Z,Z,_) :- !.
301 select_op(X,Y,Z,Z,_) :- equal_terms(X,Y).
302
303 conjoin4(E,X,R,Op) :- neutral_element(Op,E), !, R=X.
304 conjoin4(X,E,R,Op) :- neutral_element(Op,E), !, R=X.
305 conjoin4(X,Y,C,Op) :- C=..[Op,X,Y].
306
307 neutral_element(conjunct,true) :- !.
308 neutral_element(disjunct,false) :- !.
309 neutral_element(add,0) :- !.
310 neutral_element(multiplication,1) :- !.
311 neutral_element(_,placeholder).
312
313 % -------------------------
314
315 remove_duplicates_for_op(C,Res,Op) :-
316 functor(C,Op,_), % ensure that we have the desired functor as top-level
317 op_to_list(C,List,Op),
318 without_duplicates(List,ResL),
319 list_to_op(ResL,Res,Op).
320
321 without_duplicates(L,Res) :- without_duplicates(L,[],Res).
322
323 without_duplicates([],List,List).
324 without_duplicates([E|R],Filtered,Res) :-
325 member(F,Filtered),
326 equal_terms(E,F),!,
327 without_duplicates(R,Filtered,Res).
328 without_duplicates([E|R],Filtered, Res) :-
329 \+ member(E,Filtered),
330 append(Filtered,[E],New),
331 without_duplicates(R,New,Res).
332
333
334 op_to_list(Term,NList,Op) :-
335 op_to_list(Term,[],NList,Op).
336 op_to_list(Term,OList,NList,Op) :-
337 Term=..[Op,A,B],!,
338 op_to_list(B,OList,L1,Op),
339 op_to_list(A,L1,NList,Op).
340 op_to_list(Term,L,[Term|L],_). % Note: if L=[] then we did not have Op as top-level functor!
341
342 list_to_op([A],Res,_) :- !, Res=A.
343 list_to_op([A,B|L],Res,Op) :- C=..[Op,A,B], list_to_op(L,C,Res,Op).
344 list_to_op([],C,C,_).
345 list_to_op([X|T],C,Res,Op) :- NC=..[Op,C,X], list_to_op(T,NC,Res,Op).
346
347 % ------------------
348
349 negate(truth,Res) :- !, Res=falsity.
350 negate(falsity,Res) :- !, Res=truth.
351 negate(equal(X,Y),R) :- !, R=not_equal(X,Y).
352 negate(not_equal(X,Y),R) :- !, R=equal(X,Y).
353 negate(greater(X,Y),R) :- !, R=less_equal(X,Y).
354 negate(less(X,Y),R) :- !, R=greater_equal(X,Y).
355 negate(greater_equal(X,Y),R) :- !, R=less(X,Y).
356 negate(less_equal(X,Y),R) :- !, R=greater(X,Y).
357 negate(disjunct(X,Y),R) :- !, R=conjunct(NX,NY), negate(X,NX), negate(Y,NY).
358 negate(conjunct(X,Y),R) :- !, R=disjunct(NX,NY), negate(X,NX), negate(Y,NY).
359 negate(implication(X,Y),R) :- !, R=conjunct(X,NY), negate(Y,NY).
360 negate(negation(X),R) :- !, R=X.
361 negate(P,negation(P)).
362
363 % ------------------------
364
365
366 new_identifier(Expr,I) :-
367 used_identifiers(Expr,L),
368 possible_identifier(X),
369 I = '$'(X),
370 \+ member(I,L),!.
371
372 % -------------
373
374 used_identifiers_list(List,UsedIds) :-
375 used_identifiers(List,AllIds),
376 sort(AllIds,UsedIds).
377
378 used_identifiers(Term,AllIds) :- used_identifiers(Term,AllIds,[]).
379
380 used_identifiers(Term) --> {atomic(Term)}, !, [].
381 used_identifiers(Term) --> {Term = '$'(E), atomic(E)}, !, [Term].
382 used_identifiers(C) -->
383 {C =.. [_|Args]},
384 l_used_identifiers(Args).
385
386 l_used_identifiers([]) --> [].
387 l_used_identifiers([H|T]) --> used_identifiers(H), l_used_identifiers(T).
388
389 % -------------
390
391 free_identifiers(Term,AllIds) :- free_identifiers(Term,AllIds,[]).
392
393 free_identifiers(exists(Ids,P),Res1,Res2) :- !,
394 free_identifiers(P,Free), % TODO: pass FreeImp as parameter and filter
395 list_difference(Free,Ids,Res),
396 append(Res,Res1,Res2).
397 free_identifiers(Term,Res2,Res1) :-
398 (Term = forall(Ids,P,E)
399 ; Term = event_b_comprehension_set(Ids,E,P)
400 ; Term = quantified_intersection(Ids,P,E)
401 ; Term = quantified_union(Ids,P,E)), !,
402 free_identifiers(implication(P,E),FreeImp), % TODO: pass FreeImp as parameter and filter
403 list_difference(FreeImp,Ids,Res),
404 append(Res,Res2,Res1).
405 free_identifiers(Term) --> {atomic(Term)}, !, [].
406 free_identifiers(Term) --> {Term = '$'(E), atomic(E)}, !, [Term].
407 free_identifiers(C) -->
408 {C =.. [_|Args]},
409 l_free_identifiers(Args).
410
411 l_free_identifiers([]) --> [].
412 l_free_identifiers([H|T]) --> free_identifiers(H), l_free_identifiers(T).
413
414 % -------------
415
416 identifier(x).
417 identifier(y).
418 identifier(z).
419
420 possible_identifier(Z) :- identifier(Z).
421 possible_identifier(Z) :- identifier(X), identifier(Y), atom_concat(X,Y,Z).
422
423 new_identifiers(Expr,1,[Id]) :- !, new_identifier(Expr,Id).
424 new_identifiers(Expr,Nr,Ids) :- used_identifiers(Expr,L), possible_identifier(X), I = '$'(X), \+ member(I,L), !, range_ids(X,Nr,Ids).
425
426 range_ids(X,Nr,L) :- range(X,1,Nr,L).
427 range(X,I,I,['$'(XI)]) :- atom_int_concat(X,I,XI).
428 range(X,I,K,['$'(XI)|L]) :- I < K, I1 is I + 1, atom_int_concat(X,I,XI), range(X,I1,K,L).
429
430 atom_int_concat(X,I,XI) :-
431 atom_codes(X,CX),
432 number_codes(I,CI),
433 append(CX,CI,COut),
434 atom_codes(XI,COut).
435
436 new_aux_identifier(IdsTypes,X) :-
437 possible_identifier(X),
438 \+ member(b(identifier(X),_,_),IdsTypes),!.
439
440 % -------------------------
441
442 is_fun(partial_function(DOM,RAN),partial,DOM,RAN).
443 is_fun(partial_injection(DOM,RAN),partial,DOM,RAN).
444 is_fun(partial_surjection(DOM,RAN),partial,DOM,RAN).
445 is_fun(partial_bijection(DOM,RAN),partial,DOM,RAN).
446 is_fun(total_function(DOM,RAN),total,DOM,RAN).
447 is_fun(total_injection(DOM,RAN),total,DOM,RAN).
448 is_fun(total_surjection(DOM,RAN),total,DOM,RAN).
449 is_fun(total_bijection(DOM,RAN),total,DOM,RAN).
450
451 is_rel(F,Type,DOM,RAN) :- is_fun(F,Type,DOM,RAN).
452 is_rel(relations(DOM,RAN),partial,DOM,RAN).
453 is_rel(total_relation(DOM,RAN),total,DOM,RAN).
454 is_rel(surjection_relation(DOM,RAN),partial,DOM,RAN).
455 is_rel(total_surjection_relation(DOM,RAN),total,DOM,RAN).
456
457 is_surj(total_bijection(DOM,RAN),DOM,RAN).
458 is_surj(total_surjection(DOM,RAN),DOM,RAN).
459 is_surj(partial_surjection(DOM,RAN),DOM,RAN).
460 is_surj(surjection_relation(DOM,RAN),DOM,RAN).
461 is_surj(total_surjection_relation(DOM,RAN),DOM,RAN).
462
463 is_inj(partial_injection(DOM,RAN),DOM,RAN).
464 is_inj(partial_bijection(DOM,RAN),DOM,RAN).
465 is_inj(total_injection(DOM,RAN),DOM,RAN).
466 is_inj(total_bijection(DOM,RAN),DOM,RAN).
467
468
469 is_natural_set(natural_set).
470 is_natural_set('NATURAL').
471
472 is_natural1_set(natural1_set).
473 is_natural1_set('NATURAL1').
474
475 is_integer_set(integer_set).
476 is_integer_set('INTEGER').
477
478 is_less_eq(less_equal(P,Q),P,Q).
479 is_less_eq(greater_equal(Q,P),P,Q).
480
481 is_less(less(P,Q),P,Q).
482 is_less(greater(Q,P),P,Q).
483
484 is_equality(equal(A,B),X,Y) :- ((X,Y) = (A,B) ; (X,Y) = (B,A)).
485
486 % check if we have an inequality between two terms
487 is_inequality(negation(Eq),X,Y) :- is_equality(Eq,X,Y).
488 is_inequality(not_equal(A,B),X,Y) :- ((X,Y) = (A,B) ; (X,Y) = (B,A)).
489
490 %is_equivalence(equivalence(A,B),A,B).
491 %is_equivalence(equivalence(B,A),A,B).
492
493
494 % symmetric / commutative unification; useful for commutative operators
495 sym_unify(A,B,A,B).
496 sym_unify(A,B,B,A).
497
498 is_inter(intersection(A,B),A,B). % TODO: extend to nested inter
499 is_inter(intersection(B,A),A,B).
500
501 is_minus(NE,E) :- number(NE), NE < 0, E is abs(NE) ; NE = unary_minus(E).
502
503 is_empty(Expr,Term) :- is_equality(Expr,Term,empty_set).
504 is_empty(Expr,Term) :- Expr = subset(Term,empty_set).
505
506 is_negation(Q,negation(P)) :- equal_terms(P,Q).
507
508 of_integer_type('$'(E),Info) :-
509 atomic(E),
510 of_integer_type(E,Info).
511 of_integer_type(E,Info) :-
512 get_meta_info(ids_types,Info,STypes),
513 member(b(identifier(E),integer,_),STypes).
514
515 singleton_set(set_extension([X]),X).
516
517
518 split_composition(Comp,LComp,RComp) :-
519 Comp = composition(_,_),
520 op_to_list(Comp,List,composition),
521 append(L,R,List),
522 list_to_op(L,LComp,composition),
523 list_to_op(R,RComp,composition).
524
525 % ----------------------------
526
527 % check if something is a pure type expression
528 type_expression(bool_set,_).
529 type_expression(Z,_) :- is_integer_set(Z).
530 type_expression(S,Info) :- is_deferred_or_enumerated_set(S,Info).
531 type_expression(pow_subset(Ty),Info) :- type_expression(Ty,Info).
532 type_expression(cartesian_product(Ty1,Ty2),Info) :- type_expression(Ty1,Info), type_expression(Ty2,Info).
533 % there are more type expressions not in Event-B:
534 type_expression(string_set,_).
535 type_expression(real_set,_).
536 type_expression(typeset,_).
537
538 get_type_expression(integer,'INTEGER').
539 get_type_expression(boolean,bool_set).
540 get_type_expression(set(S),pow_subset(T)) :- get_type_expression(S,T).
541 get_type_expression(couple(A,B),cartesian_product(S,T)) :- get_type_expression(A,S), get_type_expression(B,T).
542
543 % ------------------------
544
545 get_typed_identifiers(NormExpr,List) :- get_typed_identifiers(NormExpr,[],List).
546
547 get_typed_identifiers(NormExpr,Scope,List) :-
548 convert_norm_expr_to_raw(NormExpr,ParsedRaw),
549 Quantifier = forall,
550 bmachine:b_type_open_predicate(Quantifier,ParsedRaw,Scope,TypedPred,[]), !,
551 (TypedPred = b(forall(List0,_,_),_,_) -> List=List0 ; List=[]).
552 % already known IDs from scope are ignored, no forall is generated if there are no new IDs
553 get_typed_identifiers(NormExpr,_,List) :-
554 used_identifiers(NormExpr,Ids),
555 maplist(any_type,Ids,List).
556
557 any_type('$'(X),b(identifier(X),any,[])).
558
559 % ------------------------
560
561 is_deferred_or_enumerated_set('$'(Set),Info) :-
562 get_meta_info(rawsets,Info,RawSets), % also covers enumerated sets in Event-B; TODO: adapt for classical B??
563 member(deferred_set(_,Set),RawSets).
564
565 get_meta_info(Key,Info,Content) :- El=..[Key,Content], memberchk(El,Info), !.
566 get_meta_info(_,_,[]).
567
568 update_meta_infos(Key,Info,Values,Info1) :-
569 get_meta_info(Key,Info,Content),
570 Content \= [], !,
571 Old=..[Key,Content],
572 New=..[Key,Values],
573 select(Old,Info,New,Info1).
574 update_meta_infos(Key,Info,Values,[El|Info]) :- El=..[Key,Values].
575
576 add_meta_info(Key,Info,Value,Info1) :- add_meta_infos(Key,Info,[Value],Info1).
577
578 add_meta_infos(Key,Info,Values,Info1) :-
579 get_meta_info(Key,Info,Content),
580 Content \= [], !,
581 Old=..[Key,Content],
582 append(Values,Content,NewContent),
583 New=..[Key,NewContent],
584 select(Old,Info,New,Info1).
585 add_meta_infos(Key,Info,Values,[El|Info]) :- El=..[Key,Values].
586
587 remove_meta_info(Key,Info,Value,Info1) :-
588 get_meta_info(Key,Info,Content),
589 Old=..[Key,Content],
590 select(Value,Content,Content0),
591 New=..[Key,Content0],
592 select(Old,Info,New,Info1).
593
594
595 % ----------------------------
596
597 :- use_module(probsrc(translate),[with_translation_mode/2]).
598 :- use_module(wdsrc(well_def_hyps),[convert_norm_expr_to_raw/2,translate_norm_expr_with_limit/3]).
599 translate_norm_expr_term(Term,Str) :-
600 catch(with_translation_mode(unicode,translate_norm_expr_with_limit(Term,300,Str)),Exc,
601 (format(user_output,'Cannot translate ~w due to ~w~n',[Term,Exc]),Str='???')).
602
603
604 create_descr(Rule,T,Descr) :- translate_norm_expr_term(T,TS),
605 ajoin([Rule,' (',TS,')'],Descr).
606 create_descr(Rule,S,T,Descr) :- translate_norm_expr_term(T,TS),
607 ajoin([Rule,' (',S,',',TS,')'],Descr).