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(bsyntaxtree,
6 [is_texpr/1, % checks if the given argument is a typed expression
7
8 get_texpr_expr/2, % get the expression part of a typed expression
9 get_texpr_type/2, % get the type of a typed expression
10 get_texpr_info/2, % get the list of information of a typed expression
11 get_texpr_id/2, % get the id of a typed identifier, fails if it's not an identifier
12 def_get_texpr_id/2, % same as above, but raises error if arg1 is not an identifier
13 def_get_texpr_ids/2, % maplist of the above, i.e., translate a typed id list into a plain list of id names
14 create_typed_id/3, % create a typed identifier
15 create_typed_ids/3, % create a list of typed identifiers from list of names and types
16 same_id/3, % true if two typed identifiers have the same id
17 same_ids/2, % true if two lists of typed identifiers have the same ids
18 same_ids_and_types/2, % also check types
19 split_names_and_types/3, % split list of typed ids into ids and types
20 get_texpr_exprs/2, % list variant of the above
21 get_texpr_types/2, % list variant of the above
22 get_texpr_infos/2, % list variant of the above
23 get_texpr_ids/2, % list variant of the above
24 get_texpr_pos/2, % get the position of a typed expression
25 get_texpr_pos_infos/2, % the a list containing the position infos, sublist of get_texpr_infos
26 extract_pos_infos/2, % get the position info sub list of an info list
27 copy_pos_infos/3, % copy position infos from one typed expression to another
28 delete_pos_info/2, % delete position info from an info list
29 propagate_pos_info_if_useful/3, % propagate position info from second list if useful
30 merge_info/3, % merge two information lists as well as possible
31 update_infos/3, % provide updates to an existing info list
32 get_info_pos/2, % get the position directly from info field
33 contains_info_pos/1, % true if info field contains position infos
34
35 same_texpr/2, % check if two typed expressions are equal modulo Info fields
36 different_texpr_values/2, % check if two type expressions are WD and definitely denote different values
37
38 create_texpr/4, % creates a typed expression by giving expression, type and infos
39 add_texpr_infos/3, % adds some more information to a typed expression at front
40 add_texpr_info_if_new/3, % adds one info field to typed B expression info list at front if it is new
41 add_texpr_infos_if_new/3, % ditto but list of infos can be added
42 add_info_if_new/3, % adds to info list
43 add_infos_if_new/3, % same for list of info items
44 safe_create_texpr/3, % a version of create_texpr which extracts wd-info from sub-expressionssafe_create_texpr
45 safe_create_texpr/4,
46 texpr_contains_wd_condition/1,
47 sub_expression_contains_wd_condition/1, % utility to check if sub-expression contains wd condition
48
49 get_rodin_name/2, get_rodin_model_name/2,
50 is_rodin_label_info/1,
51 get_texpr_label/2, get_texpr_labels/2,
52 get_info_labels/2, select_info_labels/3,
53 add_labels_to_texpr/3,
54 get_texpr_description/2, % get @desc pragma for typed expression
55 add_texpr_description/3, % add an additional description by hand
56 info_has_ignore_pragma/1, % check if an info list has an ignore pragma
57 predicate_has_ignore_pragma/1, % ditto for the info list of a predicate
58 always_well_defined/1, always_well_defined_or_disprover_mode/1,
59 always_well_defined_or_wd_reorderings_allowed/1,
60 always_well_defined_or_wd_improvements_allowed/1,
61 finite_wd_set_value/1, finite_set_or_disprover_mode/1,
62 is_truth/1, is_falsity/1,
63 conjunct_predicates/2,
64 conjunct_predicates_with_pos_info/3, conjunct_predicates_with_pos_info/2,
65 is_a_conjunct/3, is_a_conjunct_without_label/3, decompose_conjunct/3,
66 is_a_disjunct/3, is_an_implication/3, is_an_equivalence/3, is_a_negation/2,
67 conjunction_to_list/2,
68 conjunction_to_list_with_rodin_labels/2, % a variation which propagates labels down to conjuncts
69 member_in_conjunction/2, select_member_in_conjunction/3,
70 flatten_conjunctions/2,
71 size_of_conjunction/2,
72 member_in_conjunction_cse/3,
73 disjunct_predicates/2,
74 disjunct_predicates_with_pos_info/3,
75 disjunction_to_list/2,
76 is_a_disjunct_or_implication/4,
77 is_a_conjunct_or_neg_disj/3,
78
79 predicate_components/2, % split a predicate into components which use distinct identifiers
80 predicate_components_in_scope/3, % ditto with an optional list of local variables
81 predicate_components_with_restriction/4,
82 predicate_identifiers/2, predicate_identifiers_in_scope/3,
83
84 project_predicate_on_identifiers/5,
85
86 find_identifier_uses_top_level/2, % not including global sets and constants
87 find_identifier_uses/3, find_identifier_uses_if_necessary/3,
88 find_identifier_uses_l/3,
89 find_typed_identifier_uses/3,
90 find_typed_identifier_uses/2, % not including global sets and constants
91 find_typed_identifier_uses_l/3,
92 find_identifier_uses_for_quantifier_body/3,
93 get_global_identifiers/1, get_global_identifiers/2,
94 occurs_in_expr/2, some_id_occurs_in_expr/2,
95 single_usage_identifier/3,
96 update_used_ids/3,
97 check_computed_used_ids/2,
98
99 create_exists/3, create_or_merge_exists/3,
100 create_exists_or_let_predicate/3,
101 create_exists_opt_liftable/3,
102 create_exists_opt/3, create_exists_opt/4, create_exists_opt/5,
103 not_generated_exists_paras/1,
104 create_forall/3,
105 create_negation/2, is_negation_of/2, get_negated_operator_expr/2,
106 create_implication/3,
107 create_equivalence/3,
108 is_equality/3,
109 create_equality/3, split_equality/3, get_texpr_couple/3,
110 create_couple/3, create_couple/2, nested_couple_to_list/2,
111 create_comprehension_set/4,
112 is_eventb_comprehension_set/4, is_eventb_comprehension_set/6,
113 singleton_set_extension/2,
114 is_membership/3, is_membership_or_equality/3,
115 get_lambda_equality/4,
116 is_pow_subset/2, is_pow1_subset/2,
117
118 detect_global_predicates/4,
119
120 definitely_not_empty_set/1, definitely_empty_set/1, definitely_not_empty_finite_value/1,
121 get_integer/2,
122 get_interval/3,
123
124 replace_id_by_expr/4,
125 replace_id_by_expr_with_count/5, % also count number of replacements
126 replace_ids_by_exprs/4,
127 remove_used_id_from_info/3, % remove an id from used_id info field if it exists
128 remove_used_ids_from_info/3, % remove list of ids (order of args different !)
129
130 rename_bt/3, % a simplified version of replace_ids_by_exprs, which assumes target of renamings are variables
131 rename_bt_l/3,
132 remove_bt/4,
133 syntaxtransformation/5,
134 syntaxtransformation_det/5, % faster, non-backtracking version
135 syntaxtransformation_for_renaming/5,
136
137 map_over_bexpr/2, map_over_typed_bexpr/2, map_over_typed_bexpr/3,
138 map_over_typed_bexpr_with_names/2,
139 map_over_bexpr_top_down_acc/3, map_over_typed_bexpr_top_down_acc/3,
140 reduce_over_bexpr/4,
141 transform_bexpr/3, % transform a typed B expression bottom-up
142 transform_bexpr_with_scoping/3, % ditto, but we also provide info about local ids
143 transform_bexpr_td_with_scoping/3, % top-down with scoping
144 transform_bexpr_with_bup_accs/5, transform_bexpr_with_acc/5,
145 non_det_transform_bexpr_with_acc/5, % can be used to generate several transformed expressions
146 uses_implementable_integers/1,
147 min_max_integer_value_used/3, min_max_integer_value_used/5,
148 syntaxtraversion/6,
149 safe_syntaxelement/5,
150 safe_syntaxelement_det/5, % a deterministic, non-backtracking version
151 is_subst_syntaxelement/1,
152 is_syntax_constant/1,
153
154 expand_all_lets/2,
155
156 remove_all_infos/2, extract_info/2, extract_info/3, extract_info_wo_used_ids/2,
157 bsyntax_pattern/2,
158
159 remove_all_infos_and_ground/2,
160
161 check_if_typed_predicate/1,
162 check_if_typed_expression/1,
163 check_if_typed_substitution/1,
164
165 strip_and_norm_ast/2,
166 same_norm_texpr/2,
167 get_texpr_functor/3,
168
169 is_set_type/2, get_set_type/2, get_texpr_set_type/2,
170 is_just_type/1, is_just_type/2,
171
172 create_recursive_compset/6,
173 unique_typed_id/3,
174 mark_bexpr_as_symbolic/2,
175
176 identifier_sub_ast/3, exchange_ast_position/5,
177
178 has_declared_identifier/2, add_declaration_for_identifier/3,
179 check_ast/1, check_ast/2,
180 repair_used_ids/3,
181 print_ast/1,
182 rewrite_if_then_else_expr_to_b/2,
183 normalise_bexpr_for_ml/2
184 ]).
185
186 % meta_predicate annotations should appear before loading any code:
187
188 :- meta_predicate map_over_full_bexpr_no_fail(1,?).
189
190 :- meta_predicate map_over_bexpr(1,?).
191 :- meta_predicate map_over_typed_bexpr(1,?).
192 :- meta_predicate map_over_typed_bexpr(2,?,?).
193 :- meta_predicate map_over_bexpr_top_down_acc(3,?,?).
194 :- meta_predicate map_over_typed_bexpr_top_down_acc(3,?,?).
195
196 :- meta_predicate reduce_over_bexpr(3,?,?,?).
197 :- meta_predicate transform_bexpr(2,?,?).
198 :- meta_predicate l_transform_bexpr(?,2,?).
199 :- meta_predicate transform_bexpr_with_scoping(3,?,?).
200 :- meta_predicate transform_bexpr_td_with_scoping(3,?,?).
201 :- meta_predicate transform_bexpr_with_scoping2(3,?,?,?).
202 :- meta_predicate l_transform_bexpr_with_scoping(?,3,?,?).
203 :- meta_predicate transform_bexpr_with_bup_accs(4,?,?,?,?).
204 :- meta_predicate l_transform_bexpr_with_bup_accs(?,4,?,?,?).
205 :- meta_predicate transform_bexpr_with_acc(4,?,?,?,?).
206 :- meta_predicate l_transform_bexpr_with_acc(?,4,?,?,?).
207 :- meta_predicate non_det_transform_bexpr_with_acc(4,?,?,?,?).
208 :- meta_predicate l_nd_transform_bexpr_with_acc(?,4,?,?,?).
209
210 % -----------
211
212
213 :- use_module(tools).
214
215 :- use_module(module_information,[module_info/2]).
216 :- module_info(group,typechecker).
217 :- module_info(description,'This module provides operations on the type-checked AST.').
218
219 :- use_module(library(lists)).
220 :- use_module(library(ordsets)).
221 :- use_module(library(avl)).
222 :- use_module(library(terms)).
223
224 :- use_module(self_check).
225 :- use_module(error_manager).
226 :- use_module(translate,[print_bexpr/1,translate_bexpression/2]).
227 :- use_module(gensym,[gensym/2]).
228 :- use_module(preferences,[get_preference/2,preference/2]).
229 :- use_module(debug,[debug_mode/1,debug_format/3]).
230
231 :- use_module(typing_tools,[is_finite_type_in_context/2,normalize_type/2]).
232 :- use_module(tools_lists,[convlist_max/4]).
233
234 :- set_prolog_flag(double_quotes, codes).
235
236 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
237 % basic access to enriched syntax tree
238
239 is_texpr(b(_,_,_)).
240
241 get_texpr_expr(b(Name,_,_),R) :- !,R=Name.
242 get_texpr_expr(E,_) :- add_error_fail(get_texpr_expr,'B Expression not properly wrapped: ',E).
243
244 get_texpr_type(b(_,Type,_),R) :- !, R=Type.
245 get_texpr_type(E,_) :- add_error_fail(get_texpr_type,'B Expression not properly wrapped: ',E).
246 get_texpr_info(b(_,_,Info),R) :- !, R=Info.
247 get_texpr_info(E,_) :- add_error_fail(get_texpr_info,'B Expression not properly wrapped: ',E).
248
249 %! get_texpr_id(+Texpr,-Id)
250 get_texpr_id(b(N,_,_),Id) :- !, N=identifier(Id).
251 get_texpr_id(E,_) :- add_error_fail(get_texpr_id,'B Expression not properly wrapped: ',E).
252 /* same as above: but must succeed */
253 def_get_texpr_id(b(identifier(Id),_,_),R) :- !,R=Id.
254 def_get_texpr_id(b(E,_,_),_) :- !,
255 add_error_fail(def_get_texpr_id,'Could not extract identifier from typed expression: ',E).
256 def_get_texpr_id(ID,_) :- add_error_fail(def_get_texpr_id,'Could not extract identifier, not properly wrapped: ',ID).
257
258 % translate a list of ids with the b/3 wrapper into a plain id list; throw error if not an identifier
259 % used to also be called get_texpr_id_names
260 def_get_texpr_ids(L,Ids) :- maplist(def_get_texpr_id,L,Ids).
261
262 create_typed_id(IDName,Type,b(identifier(IDName),Type,[])).
263
264 create_typed_ids([],[],[]).
265 create_typed_ids([ID|TI],[Type|TT],[TID| TRes]) :-
266 create_typed_id(ID,Type,TID),
267 create_typed_ids(TI,TT,TRes).
268
269 same_id(X,Y,ID) :- get_texpr_id(X,ID), get_texpr_id(Y,ID).
270
271 same_ids([],[]).
272 same_ids([X|Xs],[Y|Ys]) :- same_id(X,Y,_), same_ids(Xs,Ys).
273
274 % check if two lists of identifiers have the same name and types
275 same_ids_and_types([],[]).
276 same_ids_and_types([b(identifier(Id),T1,_)|Xs],[b(identifier(Id),T2,_)|Ys]) :- unify_types_strict(T1,T2),
277 same_ids_and_types(Xs,Ys).
278
279 % split a list of typed identifiers into atomic ids and types
280 split_names_and_types([],N,T) :- !, N=[], T=[].
281 split_names_and_types([Identifier|IdRest],[Name|NRest],[Type|TRest]) :- !,
282 def_get_texpr_id(Identifier,Name),
283 get_texpr_type(Identifier,Type),
284 split_names_and_types(IdRest,NRest,TRest).
285 split_names_and_types(TIDS,N,R) :-
286 add_internal_error('Illegal call to:',split_names_and_types(TIDS,N,R)),fail.
287
288
289
290 % check if two wrapped expressions are equal (modulo associated Info, e.g. source loc info)
291 same_texpr(b(E1,Type,_),b(E2,Type,_)) :- % should we do a == check first ?? probably not as it may traverse the entire structure (see email exchange with SICStus 28.1.2015)
292 same_functor(E1,E2),
293 safe_syntaxelement_det(E1,Subs1,_Names1,_List1,Constant),
294 safe_syntaxelement_det(E2,Subs2,_Names2,_List2,Constant2),
295 Constant==Constant2, % in case we have values with variables inside !
296 same_sub_expressions(Subs1,Subs2).
297
298 same_sub_expressions([],[]).
299 same_sub_expressions([H1|T1],[H2|T2]) :- same_texpr(H1,H2), same_sub_expressions(T1,T2).
300
301 % check if two wrapped expressions definitely denote a different value (and are well-defined)
302 % only detects certain cases !
303 different_texpr_values(b(E1,Type,I1),b(E2,Type,I2)) :-
304 different_value(E1,E2,CheckWD),
305 (CheckWD=false -> true
306 ; always_well_defined_or_wd_improvements_allowed(b(E1,Type,I1)),
307 always_well_defined_or_wd_improvements_allowed(b(E2,Type,I2))).
308 different_value(boolean_false,boolean_true,false) :- !.
309 different_value(boolean_true,boolean_false,false) :- !.
310 different_value(integer(X),IY,false) :- get_integer_aux(IY,Y),!, X\=Y.
311 different_value(string(X),string(Y),false) :- !, X\=Y.
312 different_value(value(VX),Y,false) :- !, different_val_from(VX,Y).
313 different_value(empty_set,S,check_wd) :- !, non_empty_set(S).
314 different_value(S,empty_set,check_wd) :- !, non_empty_set(S).
315 % should we compare two set_extensions ? couples ? records ? reals?
316
317 different_val_from(Var,_) :- var(Var),!,fail.
318 different_val_from(int(X),IY) :- integer(X), get_integer_aux(IY,Y), X\=Y.
319 different_val_from(fd(X,Gs),value(FY)) :- nonvar(X), nonvar(FY), FY=fd(Y,Gs), nonvar(Y), X\=Y.
320 different_val_from(pred_false,boolean_true).
321 different_val_from(pred_false,value(BY)) :- BY==pred_true.
322 different_val_from(pred_true,boolean_false).
323 different_val_from(pred_true,value(BY)) :- BY==pred_false.
324 different_val_from(string(X),string(Y)) :- !, X\=Y.
325 different_val_from(string(X),value(VY)) :- nonvar(VY), VY=string(Y), nonvar(Y), !, X\=Y.
326 different_val_from(avl_set(node(_,_,_,_,_)),empty_set).
327
328 non_empty_set(set_extension([_|_])).
329 non_empty_set(sequence_extension([_|_])).
330
331
332 get_texpr_exprs([],[]).
333 get_texpr_exprs([E|Rest],[N|NRest]) :- get_texpr_expr(E,N),get_texpr_exprs(Rest,NRest).
334 get_texpr_exprs(b(E,_,_),Res) :- add_internal_error('Illegal call:',get_texpr_infos(b(E,_,_),Res)), Res=[E].
335 get_texpr_types([],[]).
336 get_texpr_types([E|Rest],[T|TRest]) :- get_texpr_type(E,T),get_texpr_types(Rest,TRest).
337 get_texpr_types(b(_,T,_),Res) :- add_internal_error('Illegal call:',get_texpr_infos(b(_,T,_),Res)), Res=[T].
338 get_texpr_infos([],[]).
339 get_texpr_infos([E|Rest],[I|IRest]) :- get_texpr_info(E,I),get_texpr_infos(Rest,IRest).
340 get_texpr_infos(b(_,_,I),Res) :- add_internal_error('Illegal call:',get_texpr_infos(b(_,_,I),Res)), Res=[I].
341 get_texpr_ids([],[]).
342 get_texpr_ids([E|Rest],[I|IRest]) :- get_texpr_id(E,I),get_texpr_ids(Rest,IRest).
343
344 get_texpr_pos(TExpr,Pos) :-
345 get_texpr_info(TExpr,Infos),
346 ? ( member(nodeid(Pos1),Infos) -> !,Pos=Pos1
347 ; Pos = none).
348
349 get_texpr_pos_infos(b(_,_,Infos),PosInfos) :- extract_pos_infos(Infos,PosInfos).
350
351 % similar to get_texpr_pos, but returns sub-list of infos relating to position
352 extract_pos_infos(Infos,InfoRes) :-
353 ? ( member(nodeid(Pos1),Infos) -> !,InfoRes=[nodeid(Pos1)]
354 ; InfoRes = []).
355
356 % copy position info from first arg to second argument
357 copy_pos_infos(b(_,_,Infos1),Arg2,Res) :-
358 member(nodeid(Pos1),Infos1),!,
359 Arg2 = b(E,T,Infos2), Res = b(E,T,Infos3),
360 delete_pos_info(Infos2,Infos2d),
361 Infos3 = [nodeid(Pos1)|Infos2d].
362 copy_pos_infos(_,TE,TE).
363
364 delete_pos_info(Infos1,Infos2) :-
365 ? select(nodeid(_),Infos1,D),!, Infos2=D.
366 %delete(Infos1,nodeid(_),Infos2).
367 delete_pos_info(I,I).
368
369 % propagate position info from second list to first one if it has better position info
370 propagate_pos_info_if_useful(Infos,AuxInfos,NewInfos) :-
371 member(nodeid(Pos2),AuxInfos),
372 \+ derived_pos(Pos2),!, % potentially useful position info to propagate
373 ? (select(nodeid(Pos1),Infos,Infos2)
374 -> (derived_pos(Pos1)
375 -> NewInfos = [nodeid(Pos2)|Infos2] % we have better position info now
376 ; NewInfos = Infos % we already have a position info
377 )
378 ; NewInfos = [nodeid(Pos2)|Infos]
379 ).
380 propagate_pos_info_if_useful(Infos,_,Infos).
381
382 % derived position; not precise instrinsic label at top-level
383 derived_pos(rodin_derived_context_pos(_,_,_)).
384
385
386 get_info_pos(Infos,Pos) :- (member(nodeid(Pos1),Infos) -> Pos=Pos1 ; Pos=none).
387 contains_info_pos(Infos) :- (member(nodeid(NI),Infos) -> NI \= none).
388
389 create_texpr(Expr,Type,Info,b(Expr,Type,Info)).
390
391 add_texpr_infos(b(Expr,Type,Old),Infos,b(Expr,Type,New)) :- !,
392 append(Infos,Old,New).
393 add_texpr_infos(Other,Infos,Res) :-
394 add_internal_error('Illegal call, not BExpr:',add_texpr_infos(Other,Infos,Res)),fail.
395
396 add_texpr_info_if_new(b(Expr,Type,Old),Info,b(Expr,Type,New)) :- !,
397 add_info_if_new(Old,Info,New).
398 add_texpr_info_if_new(Other,Infos,Res) :-
399 add_internal_error('Illegal call, not BExpr:',add_texpr_info_if_new(Other,Infos,Res)),fail.
400 % add multiple infos:
401 add_texpr_infos_if_new(b(Expr,Type,Old),Infos,b(Expr,Type,New)) :-
402 add_infos_if_new(Infos,Old,New).
403
404 % add to info list:
405 add_info_if_new(Old,Info,New) :-
406 (member(Info,Old) -> New=Old ; New = [Info|Old]).
407
408 add_infos_if_new([]) --> [].
409 add_infos_if_new([Info|T]) --> add_info(Info), add_infos_if_new(T).
410 add_info(Info,Old,New) :-
411 ? (member(Info,Old) -> New=Old ; New = [Info|Old]).
412
413
414 % try and extract the Rodin name of a predicate or expression
415 get_rodin_name(Expression,Name) :- get_texpr_pos(Expression,rodinpos(Name,_)), Name \= [].
416 get_rodin_name(Expression,Name) :- get_texpr_pos(Expression,rodinpos(_Model,Name,_)), Name \= []. % new rodinpos
417
418 get_rodin_model_name(Expression,Model) :-
419 get_texpr_pos(Expression,rodinpos(Model,Name,_)), Name \= []. % new rodinpos
420 % Note: only precise position label, not rodin_derived_context_pos
421
422 % try and extract the Rodin name or label pragma of a predicate or expression
423 get_texpr_labels(TExpr,Label) :-
424 get_texpr_info(TExpr,Infos),
425 ? member(I,Infos), info_label(I,Label).
426 get_info_labels(Infos,LabelList) :-
427 ? member(I,Infos), info_label(I,LabelList).
428 select_info_labels(LabelList,Infos,Rest) :-
429 select(I,Infos,Rest), info_label(I,LabelList).
430 info_label(nodeid(NodeID),[Name]) :- nodeid_info_label(NodeID,Name).
431 info_label(label(LabelList),LabelList).
432
433 nodeid_info_label(rodinpos(Name,_),Name) :- Name \= [].
434 nodeid_info_label(rodinpos(Model,Name,_),FullName) :- Name \= [], % new rodinpos
435 ajoin([Model,':',Name], FullName). % TO DO: if only one level; don't do this
436 % TODO: provide separate way to access this derived information:
437 %nodeid_info_label(rodin_derived_context_pos(Model,Context,Label),FullName) :-
438 % ajoin([Model,'.',Context,':',Label], FullName).
439
440
441 add_labels_to_texpr(E,[],R) :- !, R=E. % no labels to add
442 add_labels_to_texpr(b(E,T,I),Labels,b(E,T,NewI)) :-
443 (select(label(OldList),I,Rest)
444 -> append(Labels,OldList,NewList), NewI=[label(NewList)|Rest]
445 % TO DO: what if we have Rodin labels
446 ; NewI = [label(Labels)|I]
447 ).
448
449 get_texpr_label(TExpr,Label) :- get_texpr_labels(TExpr,Labels), member(Label,Labels).
450
451 get_texpr_description(TExpr,Description) :-
452 get_texpr_info(TExpr,Infos),
453 memberchk(description(Description),Infos).
454
455 add_texpr_description(b(E,T,I),Description,b(E,T,[description(Description)|I])) :-
456 (atom(Description) -> true ;
457 add_error(add_texpr_description,'Non-atomic description:',Description)).
458
459 % check if an info list has an ignore pragma
460 info_has_ignore_pragma(Infos) :-
461 member(description('prob-ignore'),Infos).
462 % detect_prob_ignore ast_cleanup rule also generates this description annotation
463
464 predicate_has_ignore_pragma(b(_E,pred,I)) :-
465 %add_message(check_prob_ignore,'Pred: ',b(_E,pred,I),I),
466 info_has_ignore_pragma(I).
467
468 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
469
470 :- assert_must_succeed( (E = "1/2",
471 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
472 Type==integer, Err==none, always_well_defined(ET) ) ).
473 :- assert_must_succeed( (E = "3 mod 2",
474 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
475 Type==integer, Err==none, always_well_defined(ET) ) ).
476 :- assert_must_succeed( (E = "1/0",
477 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
478 Type==integer, Err==none, \+ always_well_defined(ET) ) ).
479 :- assert_must_succeed( (E = "2*(3 mod card({}))",
480 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
481 Type==integer, Err==none, \+ always_well_defined(ET) ) ).
482 :- assert_must_succeed( (E = "1/(2+1-3)",
483 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
484 Type==integer, Err==none, \+ always_well_defined(ET) ) ).
485 :- assert_must_succeed( (E = "max({1,2,3,0})",
486 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
487 Type==integer, Err==none, always_well_defined(ET) ) ).
488 :- assert_must_succeed( (E = "min({1,2,3,0})",
489 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
490 Type==integer, Err==none, always_well_defined(ET) ) ).
491 :- assert_must_succeed( (E = "min({1,2,3,0}-(0..4))",
492 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
493 Type==integer, Err==none, \+ always_well_defined(ET) ) ).
494 :- assert_must_succeed( (E = "2+max({1,2,3, 1/0})",
495 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
496 Type==integer, Err==none,\+ always_well_defined(ET) ) ).
497 :- assert_must_succeed( (E = "2-card({1,2,3})",
498 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
499 Type==integer, Err==none, always_well_defined(ET) ) ).
500 :- assert_must_succeed( (E = "2-card({1,2,3, 1/0})",
501 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
502 Type==integer, Err==none,\+ always_well_defined(ET) ) ).
503 :- assert_must_succeed( (E = "bool(2-size([1,2,3, 1/0])=3)",
504 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
505 Type==boolean, Err==none, \+ always_well_defined(ET) ) ).
506 :- assert_must_succeed( (E = "bool(2-size([1,2,3, 1/2, 3 mod 2, 3**2])=size([]))",
507 bmachine:b_parse_machine_expression_from_codes(E,ET,Type,false,Err),
508 Type==boolean, Err==none, always_well_defined(ET) ) ).
509
510 always_well_defined_or_wd_reorderings_allowed(BE) :- % allow re-ordering to improve Left-to-right WD
511 (preferences:preference(disprover_mode,true) -> true % we can assume all calls are well-defined
512 ; preferences:preference(allow_improving_wd_mode,true) -> true
513 ; preferences:preference(data_validation_mode,true) -> true
514 ; always_well_defined_or_discharged(BE)).
515 always_well_defined_or_wd_improvements_allowed(BE) :- % allow to remove useless calls which could be non-WD
516 % example #x(x = f(...)) -> btrue or f[{}] --> {}
517 always_well_defined_or_wd_reorderings_allowed(BE). % we currently use the same definition
518 always_well_defined_or_disprover_mode(BE) :-
519 (preferences:preference(disprover_mode,true) -> true % we can assume all calls are well-defined
520 ; always_well_defined_or_discharged(BE)).
521
522 always_well_defined_or_discharged(b(E,_,Infos)) :- !,
523 (nonmember(contains_wd_condition,Infos) -> true
524 ; always_wd(E) -> true % some special rules
525 ; member(discharged_wd_po,Infos) -> true
526 %; nl, functor(E,F,N), F \= function, print(non_wd(F,N)),nl,nl,fail
527 ).
528 always_well_defined_or_discharged(E) :-
529 add_error_fail(always_well_defined,'Illegal call: ',always_well_defined_or_discharged(E)).
530
531 % should ensure that there is no failure and no error raised
532 always_well_defined(b(E,_,Infos)) :- !,
533 (nonmember(contains_wd_condition,Infos) -> true
534 ; always_wd(E) -> true % some special rules
535 %; nl, functor(E,F,N), F \= function, print(non_wd(F,N)),nl,nl,fail
536 ).
537 always_well_defined(E) :- add_error_fail(always_well_defined,'Illegal call: ',always_well_defined(E)).
538
539
540 :- assert_must_succeed( always_wd(div( b(integer(2),integer,[]), b(integer(2),integer,[]) )) ).
541 :- assert_must_fail( always_wd(div( b(integer(2),integer,[]), b(integer(0),integer,[]) )) ).
542 :- assert_must_succeed( always_wd(modulo( b(integer(2),integer,[]), b(integer(2),integer,[]) )) ).
543 :- assert_must_fail( always_wd(modulo( b(integer(2),integer,[]), b(integer(0),integer,[]) )) ).
544 :- assert_must_fail( always_wd(modulo( b(integer(2),integer,[]), b(integer(-2),integer,[]) )) ).
545 :- assert_must_fail( always_wd(modulo( b(integer(-1),integer,[]), b(integer(2),integer,[]) )) ).
546 :- assert_must_succeed( always_wd(power_of( b(integer(2),integer,[]), b(integer(3),integer,[]) )) ).
547 :- assert_must_succeed( always_wd(power_of( b(integer(2),integer,[]), b(integer(0),integer,[]) )) ).
548 :- assert_must_fail( always_wd(power_of( b(integer(2),integer,[]), b(integer(-1),integer,[]) )) ).
549
550 % catch cases where the construct is currently so instantiated that we can determine that it is well-defined
551 % can happen e.g. during closure compilation
552 :- use_module(custom_explicit_sets,[check_unique_in_domain_of_avlset/2]).
553 :- use_module(kernel_tools,[ground_value/1]).
554 always_wd(power_of(X,Y)) :- get_integer(Y,Val), Val>=0,
555 (eventb_mode -> get_integer(X,ValX), ValX >=0
556 ; always_well_defined(X)).
557 always_wd(div(X,Y)) :- get_integer(Y,Val), Val\=0, always_well_defined(X).
558 always_wd(modulo(X,Y)) :- get_integer(Y,Val), Val>0, % Z Live allows negative numbers here it seems, cf modulo2
559 (z_or_tla_minor_mode -> true % in Z, TLA we can have negative numbers here
560 ; get_integer(X,ValX), ValX>=0).
561 always_wd(function(X,Y)) :- nonvar(X),
562 X= b(value(AVLSET),_,_), nonvar(AVLSET), AVLSET=avl_set(AVL),
563 always_wd_avl_function(AVL,Y).
564 always_wd(min(X)) :- non_empty_finite_wd_set_value(X).
565 always_wd(max(X)) :- non_empty_finite_wd_set_value(X).
566 always_wd(card(X)) :- finite_wd_set_value(X).
567 always_wd(size(X)) :- finite_wd_seq_value(X).
568 always_wd(first(X)) :- non_empty_wd_seq_value(X).
569 always_wd(front(X)) :- non_empty_wd_seq_value(X).
570 always_wd(last(X)) :- non_empty_wd_seq_value(X).
571 always_wd(tail(X)) :- non_empty_wd_seq_value(X). % TO DO: add restrict_front, restrict_tail ?
572 always_wd(general_intersection(X)) :- non_empty_finite_wd_set_value(X).
573 always_wd(value(_)). % we have already computed the value and will raise WD error; to be 100 % safe we could restrict this to ground values
574 % other candidates: size(_), first(_) last(_) tail(_) front(_) restrict_front(_,_) restrict_tail(_,_) rel_iterate(_,_)
575 always_wd(typeset).
576 % operators that are always wd on their own:
577 always_wd(record_field(RecEx,FieldName)) :- ground(FieldName),
578 always_well_defined(RecEx).
579 always_wd(unary_minus(A)) :- always_well_defined(A).
580 always_wd(unary_minus_real(A)) :- always_well_defined(A).
581 always_wd(first_of_pair(A)) :- always_well_defined(A).
582 always_wd(add(A,B)) :- always_well_defined(A),always_well_defined(B).
583 always_wd(add_real(A,B)) :- always_well_defined(A),always_well_defined(B).
584 always_wd(minus(A,B)) :- always_well_defined(A),always_well_defined(B).
585 always_wd(minus_real(A,B)) :- always_well_defined(A),always_well_defined(B).
586 always_wd(multiplication(A,B)) :- always_well_defined(A),always_well_defined(B).
587 always_wd(multiplication_real(A,B)) :- always_well_defined(A),always_well_defined(B).
588 always_wd(equal(A,B)) :- always_well_defined(A),always_well_defined(B).
589 always_wd(not_equal(A,B)) :- always_well_defined(A),always_well_defined(B).
590 always_wd(less_equal(A,B)) :- always_well_defined(A),always_well_defined(B).
591 always_wd(less_equal_real(A,B)) :- always_well_defined(A),always_well_defined(B).
592 always_wd(greater_equal(A,B)) :- always_well_defined(A),always_well_defined(B).
593 always_wd(less(A,B)) :- always_well_defined(A),always_well_defined(B).
594 always_wd(less_real(A,B)) :- always_well_defined(A),always_well_defined(B).
595 always_wd(greater(A,B)) :- always_well_defined(A),always_well_defined(B).
596 always_wd(couple(A,B)) :- always_well_defined(A),always_well_defined(B).
597 % TO DO: add more/all other operators ?
598
599 always_wd_avl_function(AVL,Y) :- nonvar(Y), Y= b(value(Val),_,_),
600 ground_value(Val), !,
601 % Warning: this does not check that the whole AVL is a function; just this particular lookup is ok
602 check_unique_in_domain_of_avlset(Val,AVL). % ,print(ok),nl.
603 always_wd_avl_function(AVL,Y) :- always_well_defined(Y),
604 custom_explicit_sets:quick_definitely_maximal_total_function_avl(AVL).
605
606 % non empty set with WD elements
607 non_empty_finite_wd_set_value(b(E,_,_)) :- non_empty_fin_wd_set2(E).
608 non_empty_fin_wd_set2(bool_set).
609 non_empty_fin_wd_set2(value(X)) :- definitely_not_empty_finite_value(X).
610 non_empty_fin_wd_set2(set_extension(S)) :- l_always_well_defined(S). % the set_extension could contain wd_errors !!
611 non_empty_fin_wd_set2(sequence_extension(S)) :- l_always_well_defined(S). % ditto
612 non_empty_fin_wd_set2(interval(A,B)) :- get_integer(A,IA), get_integer(B,IB), IA =< IB.
613 % see not_empty_set_aux
614 definitely_not_empty_finite_value(X) :- var(X),!,fail.
615 definitely_not_empty_finite_value(avl_set(_)).
616 definitely_not_empty_finite_value([_|_]).
617 definitely_not_empty_finite_value(closure(P,T,B)) :-
618 custom_explicit_sets:is_interval_closure(P,T,B,LOW,UP), integer(LOW),integer(UP), LOW =< UP.
619 % TODO: pow_subset of finite values
620
621 non_empty_wd_seq_value(b(E,_,_)) :- non_empty_seq2(E).
622 non_empty_seq2(value(X)) :- definitely_not_empty_seq(X).
623 non_empty_seq2(sequence_extension(S)) :- l_always_well_defined(S), S=[_|_].
624
625 definitely_not_empty_seq(X) :- var(X),!,fail.
626 definitely_not_empty_seq(avl_set(A)) :- custom_explicit_sets:is_avl_sequence(A).
627 definitely_not_empty_seq([El1|T]) :- T==[],nonvar(El1), El1=(IDX,_), IDX==int(1). % TO DO: add more cases ?
628
629
630 finite_set_or_disprover_mode(Set) :-
631 (preferences:preference(disprover_mode,true) -> true % we can assume all calls are well-defined
632 ; finite_wd_set_value(Set)).
633
634 :- use_module(typing_tools,[is_provably_finite_type/1]).
635 % we could also use is_finite_type_in_context to allow deferred sets to be counted as finite
636 finite_wd_set_value(b(E,T,_)) :- !, (finite_set2(E) -> true ; is_provably_finite_type(T)).
637 finite_wd_set_value(E) :- add_internal_error('Not a BExpr: ',E),fail.
638 finite_set2(empty_set).
639 finite_set2(empty_sequence).
640 finite_set2(value(X)) :- X==[] -> true ; definitely_not_empty_finite_value(X).
641 finite_set2(set_extension(S)) :- l_always_well_defined(S). % the set_extension could contain wd_errors !!
642 finite_set2(sequence_extension(S)) :- l_always_well_defined(S). % ditto
643
644 finite_wd_seq_value(b(E,_,_)) :- finite_seq2(E).
645 finite_seq2(empty_set).
646 finite_seq2(empty_sequence).
647 finite_seq2(value(X)) :- finite_seq_value(X).
648 finite_seq2(sequence_extension(S)) :- l_always_well_defined(S).
649
650 finite_seq_value(X) :- var(X),!,fail.
651 finite_seq_value([]).
652 finite_seq_value(avl_set(A)) :- custom_explicit_sets:is_avl_sequence(A).
653 % it could be expensive to check if non empty list is a B sequence ??
654
655 l_always_well_defined([]).
656 l_always_well_defined([H|T]) :- always_well_defined(H), l_always_well_defined(T).
657
658 is_truth(b(F,pred,_)) :- is_truth_aux(F).
659 is_truth_aux(truth).
660 is_truth_aux(value(V)) :- V==pred_true. % can occur in CSE mode
661
662 is_falsity(b(F,pred,_)) :- is_falsity_aux(F).
663 is_falsity_aux(falsity).
664 is_falsity_aux(value(V)) :- V==pred_false. % can occur in CSE mode
665
666 % conjunction of a list of predicates
667 % NOTE: bsyntaxtree:conjunct_predicates([P1,P2,P3],R). --> generates R = b(conjunct(b(conjunct(P1,P2),pred,[]),P3),pred,[])
668 conjunct_predicates(V,R) :- var(V),!, add_internal_error('Variable conjunction list: ',conjunct_predicates(V,R)),fail.
669 conjunct_predicates([],b(truth,pred,[])).
670 conjunct_predicates([P|Rest],Result) :- conjunct2(Rest,P,Result).
671 conjunct2([],P,P).
672 conjunct2([Q|Rest],P,Result) :- conjunct3(P,Q,R), conjunct2(Rest,R,Result).
673 conjunct3(b(truth,_,_),P,P) :- !.
674 conjunct3(P,b(truth,_,_),P) :- !.
675 conjunct3(A,B,b(conjunct(A,B),pred,NewInfo)) :- extract_info(A,B,NewInfo).
676
677 % disjunction of a list of predicates
678 disjunct_predicates([],b(falsity,pred,[])).
679 disjunct_predicates([P|Rest],Result) :- disjunct2(Rest,P,Result).
680 disjunct2([],P,P).
681 disjunct2([Q|Rest],P,Result) :- disjunct3(P,Q,R), disjunct2(Rest,R,Result).
682 disjunct3(b(falsity,_,_),P,R) :- !, R=P.
683 disjunct3(b(truth,T,I),_,R) :- !, R=b(truth,T,I).
684 disjunct3(P,b(falsity,_,_),R) :- !, R=P.
685 disjunct3(_,b(truth,T,I),R) :- !, R=b(truth,T,I).
686 disjunct3(A,B,b(disjunct(A,B),pred,NewInfo)) :- extract_info(A,B,NewInfo).
687
688 % conjunct two predicates and try and construct position information
689 conjunct_predicates_with_pos_info(A,B,AB) :- is_truth(B),!, AB=A.
690 conjunct_predicates_with_pos_info(A,B,AB) :- is_truth(A),!, AB=B.
691 conjunct_predicates_with_pos_info(A,B,AB) :-
692 conjunct_predicates([A,B],AB0), % this may contain position info if B is truth; hence we do check above
693 (try_get_merged_position_info(A,B,ABI)
694 -> add_texpr_infos(AB0,[ABI],AB) %,print(abi(ABI)),nl
695 ; AB=AB0).
696
697 % disjunct two predicates and try and construct position information
698 disjunct_predicates_with_pos_info(A,B,AB) :-
699 disjunct_predicates([A,B],AB0),
700 (try_get_merged_position_info(A,B,ABI)
701 -> add_texpr_infos(AB0,[ABI],AB) %,print(abi(ABI)),nl
702 ; AB=AB0).
703
704 try_get_merged_position_info(b(_,_,I1),b(_,_,I2),PosInfo) :-
705 (try_get_merged_position_info_aux(I1,I2,MergedInfo) -> PosInfo = MergedInfo
706 ? ; get_non_label_posinfo(Pos1,I1) -> PosInfo=nodeid(Pos1)
707 ? ; get_non_label_posinfo(Pos2,I2) -> PosInfo=nodeid(Pos2)
708 ).
709 try_get_merged_position_info_aux(I1,I2,nodeid(pos(C,Filenumber,Srow,Scol,Erow,Ecol))) :-
710 member(nodeid(pos(C1,Filenumber,Srow1,Scol1,Erow1,Ecol1)),I1),
711 (number(C1),number(Srow1),number(Scol1),number(Erow1),number(Ecol1)
712 -> true ; add_internal_error('Info field 1 not yet instantiated: ',try_get_merged_position_info(I1)),fail),
713 !,
714 member(nodeid(pos(C2,Filenumber,Srow2,Scol2,Erow2,Ecol2)),I2),
715 (number(C2),number(Srow2),number(Scol2),number(Erow2),number(Ecol2)
716 -> true ; add_internal_error('Info field 2 not yet instantiated: ',try_get_merged_position_info(I2)),fail),
717 !,
718 % merge position info if in same file
719 (C1 =< C2 -> C=C1, Srow=Srow1,Scol=Scol1 ; C=C2, Srow=Srow2,Scol=Scol2),
720 ((Erow1 > Erow2 ; Erow1=Erow2, Ecol1 >= Ecol2)
721 -> Erow =Erow1, Ecol=Ecol1
722 ; Erow =Erow2, Ecol=Ecol2).
723
724 % get position info which is not a label; label info should not be propagated to outer conjuncts/disjuncts/...
725 ?get_non_label_posinfo(Pos,Infos) :- member(nodeid(Pos),Infos),
726 \+ functor(Pos,rodinpos,_).
727
728 ?get_texpr_non_label_posinfo(b(_,_,Infos),nodeid(Pos)) :- get_non_label_posinfo(Pos,Infos).
729
730 % conjunct list of predicates and try and construct position information
731 conjunct_predicates_with_pos_info([H|T],Res) :- is_truth(H),!,
732 (T=[] -> Res = H ; conjunct_predicates_with_pos_info(T,Res)).
733 conjunct_predicates_with_pos_info([H|T],Res) :-
734 last_non_truth(T,none,Last), % the truth elements will be removed and are not relevant; get last relevant predicate
735 Last \= none,
736 try_get_merged_position_info(H,Last,MergedPosInfo), % try and merge position of first and last element
737 !,
738 conjunct_predicates([H|T],Res0),
739 add_texpr_infos(Res0,[MergedPosInfo],Res). % Res0 should have no nodeid field
740 conjunct_predicates_with_pos_info(L,Res) :- conjunct_predicates(L,Res).
741
742 :- assert_must_succeed((bsyntaxtree:last_non_truth([a,b,c],none,L),L==c)).
743 :- assert_must_succeed((bsyntaxtree:last_non_truth([a,b,c,b(truth,pred,[])],none,L),L==c)).
744
745 % get last non-truth element and filter out all truth elements
746 last_non_truth([],Acc,Acc).
747 last_non_truth([H|T],NonTruth,Last) :- is_truth(H),!, last_non_truth(T,NonTruth,Last).
748 last_non_truth([H|T],_,Last) :- last_non_truth(T,H,Last).
749
750
751 texpr_contains_wd_condition(b(_,_,Info)) :- !, memberchk(contains_wd_condition,Info).
752 texpr_contains_wd_condition(E) :- add_internal_error('Not a texpr: ',texpr_contains_wd_condition(E)).
753
754 % a version of create_texpr which collects automatically important infos from sub-expressions
755 safe_create_texpr(Expr,Type,b(Expr,Type,Info)) :- %
756 ? (sub_expression_contains_wd_condition(Expr) -> Info = [contains_wd_condition] ; Info=[]).
757
758 safe_create_texpr(Expr,Type,Info,b(Expr,Type,FullInfo)) :- %
759 ? ((sub_expression_contains_wd_condition(Expr), nonmember(contains_wd_condition, Info)) -> FullInfo = [contains_wd_condition|Info] ; FullInfo=Info).
760
761 ?sub_expression_contains_wd_condition(Expr) :- sub_expression_contains_wd_condition(Expr,_).
762 sub_expression_contains_wd_condition(Expr,Sub) :-
763 safe_syntaxelement_det(Expr,Subs,_Names,_L,_C),
764 ? member(b(Sub,_,Infos),Subs),
765 (var(Infos)
766 -> add_internal_error('Typed expression not sufficiently instantiated (variable Infos): ',sub_expression_contains_wd_condition(Expr)),
767 fail
768 ; memberchk(contains_wd_condition,Infos)).
769
770 % provide updated infos (e.g., reads(...)) and remove any old info fields with same functor
771 update_infos([],Infos,Infos).
772 update_infos([Update|T],OldInfos,NewInfos) :-
773 functor(Update,F,N),
774 functor(Old,F,N),
775 delete(OldInfos,Old,OldInfos1),
776 update_infos(T,[Update|OldInfos1],NewInfos).
777
778 % merge two info lists and try to reconcile position information:
779 merge_info(Info1,Info2,Res) :-
780 merge_imp_info2(Info2,Info1,NewInfo),
781 (try_get_merged_position_info_aux(Info1,Info2,NewPos)
782 -> delete_pos_info(NewInfo,NI2),
783 Res = [NewPos|NI2]
784 ; Res = NewInfo).
785
786 % extract important info but without used_ids:
787 extract_info_wo_used_ids(b(_,_,Info1),Info) :-
788 extract_pos_infos(Info1,PosInfos),
789 extract_just_important_info_aux(Info1,[],I1),
790 append(PosInfos,I1,Info).
791 extract_info_wo_used_ids_and_pos(b(_,_,Info1),b(_,_,Info2),Info) :-
792 extract_just_important_info_aux(Info1,[],I1),
793 extract_just_important_info_aux(Info2,I1,Info).
794
795 % extract important info from one sub-expression:
796 extract_info(b(_,_,Info1),NewInfo) :-
797 extract_imp_info1(Info1,I1),!, NewInfo = I1.
798 extract_info(A,R) :-
799 add_internal_error('Could not extract info: ',extract_info(A,R)),
800 R=[].
801 % extract imortant info fields from two (sub-)expressions
802 extract_info(b(_,_,Info1),b(_,_,Info2),NewInfo) :-
803 ? merge_imp_info2(Info1,Info2,II),!, NewInfo = II.
804 %:- use_module(library(ordsets),[ord_intersection/3]).
805 % ord_intersection(Info1,Info2,NewInfo),!.
806 % TO DO: should we merge nodeid position information !?
807 extract_info(A,B,R) :- add_internal_error('Could not extract info: ',extract_info(A,B,R)),
808 R=[].
809
810 % extract important info and used_ids
811 extract_imp_info1([],[]).
812 extract_imp_info1([H|T],Res) :-
813 ((important_info(H); H=used_ids(_)) -> Res=[H|ET], extract_imp_info1(T,ET)
814 ; extract_imp_info1(T,Res)
815 ).
816
817 % extract and merge important info and try to merge used_ids from two info lists
818 merge_imp_info2(Info1,Info2,ResInfos) :-
819 extract_imp_info1(Info1,I1),
820 ? extract_imp_info1(Info2,I2),
821 merge_aux(I1,I2,ResInfos).
822
823 merge_aux([],I2,Res) :- !, delete(I2,used_ids(_),Res). % used_ids not valid for new construct
824 merge_aux(I1,[],Res) :- !, delete(I1,used_ids(_),Res). % ditto
825 merge_aux(I1,I2,ResInfos) :-
826 ? (select(used_ids(Ids1),I1,II1)
827 ? -> (select(used_ids(Ids2),I2,II2)
828 -> ord_union(Ids1,Ids2,Ids3),
829 append(II1,[used_ids(Ids3)|II2],II)
830 ; append(II1,I2,II)
831 )
832 ; delete(I2,used_ids(_),II2),
833 append(I1,II2,II)
834 ),
835 sort(II,ResInfos). % TO DO: sort sublists ? and use ord_union?
836
837 important_info(contains_wd_condition).
838 important_info(prob_annotation(_)).
839 important_info(allow_to_lift_exists).
840 important_info(removed_typing).
841 %important_info(lambda_result(_)). % should probably not be copied
842
843 % variation of above which does not extract and merge used_ids:
844 extract_just_important_info_aux([],Acc,Acc).
845 extract_just_important_info_aux([H|T],Acc,Res) :-
846 ? (important_info(H), \+ member(H,Acc) -> extract_just_important_info_aux(T,[H|Acc],Res)
847 ; extract_just_important_info_aux(T,Acc,Res)).
848
849
850 is_a_conjunct(b(conjunct(A,B),pred,_),A,B).
851 % use is_a_conjunct_without_label if you want to avoid decomposing conjunction associated with a single label
852 is_a_conjunct_without_label(b(conjunct(A,B),pred,I),A,B) :- \+ get_info_labels(I,_).
853 % use decompose conjunct if you want to propagate labels down to the conjuncts
854 decompose_conjunct(b(conjunct(A,B),pred,I),ResA,ResB) :-
855 (get_info_labels(I,Labels)
856 -> add_labels_to_texpr(A,Labels,ResA), add_labels_to_texpr(B,Labels,ResB)
857 ; ResA=A, ResB=B).
858
859 size_of_conjunction(C,Size) :- size_of_conjunction(C,0,Size).
860 size_of_conjunction(C,Acc,Res) :- is_a_conjunct(C,A,B),!,
861 size_of_conjunction(B,Acc,A1),
862 size_of_conjunction(A,A1,Res).
863 size_of_conjunction(_,Acc,Size) :- Size is Acc+1.
864
865 conjunction_to_list(C,L) :- var(C),!,
866 add_error_fail(conjunction_to_list,'Internal error: var :',conjunction_to_list(C,L)).
867 conjunction_to_list(C,List) :-
868 conjunction_to_list2(C,List,[]).
869 conjunction_to_list2(X,I,O) :- X=b(E,_,_),
870 (E=conjunct(LHS,RHS) -> conjunction_to_list2(LHS,I,Inter),
871 conjunction_to_list2(RHS,Inter,O)
872 ; E = truth -> I=O
873 ; I = [X|O]).
874
875 % a variation of conjunction_to_list which propagates Rodin and pragma label infos down
876 % important for proof info; maybe we should only propagate Rodin labels ?
877 conjunction_to_list_with_rodin_labels(C,L) :- var(C),!,
878 add_error_fail(conjunction_to_list,'Internal error: var :',conjunction_to_list_with_rodin_labels(C,L)).
879 conjunction_to_list_with_rodin_labels(C,List) :-
880 conjunction_to_list_with_labels2(C,List,[]).
881 conjunction_to_list_with_labels2(b(conjunct(A,B),pred,Infos),I,O) :- !,
882 copy_rodin_label(Infos,A,B,LHS,RHS),
883 conjunction_to_list_with_labels2(LHS,I,Inter),
884 conjunction_to_list_with_labels2(RHS,Inter,O).
885 conjunction_to_list_with_labels2(X,I,O) :- X=b(E,_,_),
886 ( E = truth -> I=O
887 ; I = [X|O]).
888
889
890 ?copy_rodin_label(Infos,A,B,NewA,NewB) :- member(Pos,Infos), is_rodin_label_info(Pos),!,
891 add_rodin_label_info(A,Pos,NewA),
892 add_rodin_label_info(B,Pos,NewB).
893 copy_rodin_label(_,A,B,A,B).
894
895 add_rodin_label_info(b(E,T,I),Pos,b(E,T,I2)) :-
896 (member(Pos,I), is_rodin_label_info(Pos) -> I2=I
897 ; I2 = [Pos|I]).
898
899 is_rodin_label_info(nodeid(Pos)) :- functor(Pos,rodinpos,_).
900
901
902 flatten_conjunctions(List,FlattenedList) :- flatten_conj_aux(List,FlattenedList,[]).
903 flatten_conj_aux([]) --> !, [].
904 flatten_conj_aux([H|T]) --> !, flatten_conj_aux(H),flatten_conj_aux(T).
905 flatten_conj_aux(C) --> {is_a_conjunct(C,LHS,RHS)},
906 !,
907 flatten_conj_aux(LHS), flatten_conj_aux(RHS).
908 flatten_conj_aux(Truth) --> {is_truth(Truth)},!,[].
909 flatten_conj_aux(C) --> [C].
910
911 member_in_conjunction(M,Conj) :- is_a_conjunct(Conj,LHS,RHS),!,
912 ? (member_in_conjunction(M,LHS) ; member_in_conjunction(M,RHS)).
913 member_in_conjunction(M,M).
914
915 % a version of member_in_conjunction which can deal with lazy_let_pred :
916 % member_in_conjunction_cse(FullConjunctWithLets,InnerConjunctNotALet, Conjunction)
917 member_in_conjunction_cse(M,InnerConj,Conj) :- is_a_conjunct(Conj,LHS,RHS),!,
918 (member_in_conjunction_cse(M,InnerConj,LHS) ; member_in_conjunction_cse(M,InnerConj,RHS)).
919 member_in_conjunction_cse(Conj,InnerConj,b(lazy_let_pred(ID,Share,Body),pred,Info)) :-
920 Conj = b(lazy_let_pred(ID,Share,BConj),pred,Info),!,
921 member_in_conjunction_cse(BConj,InnerConj,Body).
922 member_in_conjunction_cse(M,M,M).
923
924 % not terribly efficient way to select and remove a conjunct from a predicate
925 select_member_in_conjunction(M,Conj,Rest) :- is_a_conjunct(Conj,LHS,RHS),!,
926 ? (select_member_in_conjunction(M,LHS,RL), conjunct_predicates([RL,RHS],Rest)
927 ; select_member_in_conjunction(M,RHS,RR), conjunct_predicates([LHS,RR],Rest)).
928 select_member_in_conjunction(M,M,b(truth,pred,[])).
929
930 is_a_disjunct(b(disjunct(A,B),pred,_),A,B).
931 is_a_negation(b(negation(A),pred,_),A).
932
933 disjunction_to_list(C,L) :- var(C),!,
934 add_error_fail(disjunction_to_list,'Internal error: var :',disjunction_to_list(C,L)).
935 disjunction_to_list(C,List) :-
936 disjunction_to_list2(C,List,[]).
937 disjunction_to_list2(C,I,O) :- is_a_disjunct(C,LHS,RHS),!,
938 disjunction_to_list2(LHS,I,Inter),
939 disjunction_to_list2(RHS,Inter,O).
940 disjunction_to_list2(X,[X|R],R).
941
942 is_an_implication(b(implication(A,B),pred,_),A,B).
943
944 is_an_equivalence(b(equivalence(A,B),pred,_),A,B).
945
946
947 is_a_disjunct_or_implication(b(DI,pred,_),Type,A,B) :- is_a_disj_or_impl_aux(DI,Type,A,B).
948 is_a_disj_or_impl_aux(disjunct(A,B),'disjunction',A,B).
949 is_a_disj_or_impl_aux(implication(A,B),'implication',NA,B) :-
950 create_negation(A,NA).
951 is_a_disj_or_impl_aux(negation(b(conjunct(A,B),pred,_)),'negated conjunction',NA,NB) :-
952 create_negation(A,NA),create_negation(B,NB).
953
954 % a more liberal version of is_a_conjunct/2 which also detects negated disjunctions/implications
955 is_a_conjunct_or_neg_disj(b(DI,pred,I),A,B) :- is_conjunct_aux(DI,I,A,B).
956
957 is_conjunct_aux(conjunct(LHS,RHS),_,LHS,RHS).
958 is_conjunct_aux(negation(DISJ),_,NegLHS,NegRHS) :-
959 is_a_disjunct_or_implication(DISJ,_Type,LHS,RHS),
960 create_negation(LHS,NegLHS),
961 create_negation(RHS,NegRHS).
962 is_conjunct_aux(equal(TA,TB),I,b(equal(TA1,TB1),pred,I),b(equal(TA2,TB2),pred,I)) :-
963 % split TA1|->TA2 = TB1|->TB2, cf, split_equality/3; useful for enumeration order analysis
964 get_texpr_couple(TA,TA1,TA2),
965 get_texpr_couple(TB,TB1,TB2).
966 % print('Splitting equality in is_a_conjunct_or_neg_disj: '), translate:print_bexpr(b(equal(TA,TB),pred,I)),nl.
967
968 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
969 % remove all info fields by fresh variables
970 % typically the result will be unified with AST terms which contain full info fields
971 remove_all_infos(TExpr,TNExpr) :-
972 var(TExpr),!,TExpr=TNExpr.
973 % in contrast to remove_all_infos_and_ground we provide no special treatment of values with closures here;
974 % there could be a problem if we unify with a free variable as value
975 remove_all_infos(TExpr,TNExpr) :-
976 get_texpr_expr(TExpr,Expr),
977 get_texpr_type(TExpr,Type),
978 ? syntaxtransformation(Expr,Subs,_,NSubs,NExpr),
979 create_texpr(NExpr,Type,_,TNExpr),
980 ? maplist(remove_all_infos,Subs,NSubs).
981
982 % replace all info fields
983 remove_all_infos_and_ground(TExpr,TNExpr) :-
984 var(TExpr),!,TExpr=TNExpr.
985 remove_all_infos_and_ground(b(value(Value),Type,_),TNExpr) :-
986 % special case for closure(_,_,_) since it is not covered by syntraxtransformation/5
987 % most useful for intervals
988 !,
989 remove_all_infos_from_bvalue(Value,NValue),
990 TNExpr = b(value(NValue),Type,[]).
991 remove_all_infos_and_ground(TExpr,TNExpr) :-
992 get_texpr_expr(TExpr,Expr),
993 get_texpr_type(TExpr,Type),
994 syntaxtransformation(Expr,Subs,_,NSubs,NExpr),
995 create_texpr(NExpr,Type,[],TNExpr),
996 maplist(remove_all_infos_and_ground,Subs,NSubs).
997
998 remove_all_infos_from_bvalue(Var,Res) :- var(Var),!, Res=Var.
999 remove_all_infos_from_bvalue((A,B),(RA,RB)) :- !,
1000 remove_all_infos_from_bvalue(A,RA),
1001 remove_all_infos_from_bvalue(B,RB).
1002 remove_all_infos_from_bvalue(closure(P,T,Body),Res) :- !,
1003 remove_all_infos_and_ground(Body,RBody),
1004 Res = closure(P,T,RBody).
1005 % TODO: we could provide more cases like records, sets as lists, freetype values
1006 remove_all_infos_from_bvalue(Val,Val).
1007
1008 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1009
1010 % a version of create_exists_opt which also detects top-level disjunctions
1011 % and marks the exists as generated and as allow_to_lift_exists
1012 create_exists_opt_liftable(Ids,b(disjunct(A,B),pred,Info1),NewPred) :- !,
1013 create_exists_opt_liftable(Ids,A,PA),
1014 create_exists_opt_liftable(Ids,B,PB),
1015 disjunct_predicates_with_pos_info(PA,PB,b(NP,pred,Info2)),
1016 NewPred=b(NP,pred,NewInfo),
1017 extract_just_important_info_aux(Info1,Info2,NewInfo). % copy symbolic or other relevant info
1018 create_exists_opt_liftable(Ids,Pred,NewPred) :- conjunction_to_list(Pred,L),
1019 create_exists_opt(Ids,L,[allow_to_lift_exists],NewPred,_Modified).
1020
1021 % create_exists_opt(TIds,Preds,NewPred)
1022 % creating an existential quantification with some optimisations.
1023 % TIds: The typed identifiers that are quantified
1024 % Preds: A list of predicates
1025 % NewPred: The (optimised) quantified expression
1026 % Basically two optimisations are performed:
1027 % - identifiers that are not used at all are removed from the quantifier
1028 % - predicates that do not use one of the quantified identifiers are moved
1029 % outside the quantification, resulting in a predicate of the form "P & #x.Q(x)"
1030
1031 create_exists_opt(TIds,Preds,NewPred) :-
1032 create_exists_opt(TIds,Preds,[],NewPred,_).
1033
1034 create_exists_opt(TIds,Preds,NewPred,Modified) :-
1035 create_exists_opt(TIds,Preds,[],NewPred,Modified).
1036
1037 create_exists_opt([],Preds,_,NewPred,Modified) :- !, Modified = false,
1038 conjunct_predicates(Preds,NewPred).
1039 create_exists_opt(TIds,Preds,AdditionalInfos,Res,Mod) :-
1040 get_texpr_ids(TIds,UnsortedIds), sort(UnsortedIds,Ids),
1041 (create_exists_opt1(TIds,Ids,Preds,AdditionalInfos,NewPred2,Modified) -> Res = NewPred2, Mod=Modified
1042 ; add_internal_error('Call failed:',create_exists_opt(TIds,Preds,AdditionalInfos,_,_)),fail).
1043 %create_exists_opt1(TIds,_,Preds,AdditionalInfos,NewPred,Modified) :- preference(data_validation_mode,true),
1044 % % do not lift predicates outside of existential quantifiers and change order; see rule_avec_DV.mch ClearSy example (N_ITERa_avec_DV_sans_DV) and test 1945
1045 create_exists_opt1(TIds,Ids,Preds,AdditionalInfos,NewPred2,Modified) :-
1046 create_exists_opt2(Preds,first,Ids,[],Inner,Outer,UsedIds),
1047 % Inner: quantified part, Outer: part which does not have to be quantified
1048 ( Inner = [] -> AllPreds=Outer % no exists needed
1049 ; % Inner = [_|_] ->
1050 create_filtered_exists(TIds,UsedIds,Inner,AdditionalInfos,Exists,IModified),
1051 append(Outer,[Exists],AllPreds)
1052 ),
1053 (Outer=[_|_] -> Modified=true % TO DO: check if TIds=UsedTIds
1054 ; IModified==true -> Modified=true
1055 ; UsedIds == Ids -> Modified= false
1056 ; Modified=true),
1057 conjunct_predicates(AllPreds,NewPred2).
1058
1059 % create an exists for the used Ids only
1060 create_filtered_exists(TIds,UsedIds,Inner,AdditionalInfos,Exists,_) :-
1061 ceo_filter_used_ids(TIds,UsedIds,UsedTIds), % filter out unused variables
1062 conjunct_predicates_with_pos_info(Inner,I), % we could store used_ids info
1063 create_exists_detect_tautology_aux(UsedTIds,I,AdditionalInfos,Exists).
1064 % remove_typing also added in create_exists_detect_tautology_aux
1065
1066
1067 % return Inner: predicates inside quantifier and Outer: predicates that can be moved out of the quantifier
1068 create_exists_opt2([],_,_Ids,UsedIds,[],[],UsedIds) :- !.
1069 create_exists_opt2([Pred|Prest],First,Ids,UsedIdsIn,Inner,Outer,UsedIdsOut) :- !,
1070 find_identifier_uses_if_necessary(Pred, [], LocalUses), % TODO: add used_ids(LocalUses) to Pred
1071 ord_intersection(Ids,LocalUses,ExistsIdsUsed),
1072 ( ExistsIdsUsed = [], % Pred uses none of the quantified ids: we can move it out
1073 (First==first -> true
1074 ; preference(data_validation_mode,false), % see test 1945; step 39 in trace replay
1075 always_well_defined_or_disprover_mode(Pred) % TODO: we should probably also check this !
1076 )
1077 ->
1078 Inner = Irest,
1079 Outer = [Pred|Orest], % move Pred out of existential quantifier as it does not depend on quantified variables
1080 % format('MOVED out of #(~w): ',[Ids]),translate:print_bexpr(Pred), format(' Uses ~w [~w]~n',[LocalUses,ExistsIdsUsed]),
1081 create_exists_opt2(Prest,first,Ids,UsedIdsIn,Irest,Orest,UsedIdsOut)
1082 ;
1083 update_used_ids(Pred,LocalUses,Pred2),
1084 Inner = [Pred2|Irest],
1085 Outer = Orest,
1086 ord_union(UsedIdsIn,ExistsIdsUsed,Urest),
1087 create_exists_opt2(Prest,not_first_anymore,Ids,Urest,Irest,Orest,UsedIdsOut)
1088 ).
1089 create_exists_opt2(Pred,First,Ids,UsedIdsIn,Inner,Outer,UsedIdsOut) :-
1090 add_error(create_exists_opt,'Expecting predicate list: ',Pred),
1091 create_exists_opt2([Pred],First,Ids,UsedIdsIn,Inner,Outer,UsedIdsOut).
1092
1093 % construct exists optimized: keep only used TIds
1094 ceo_filter_used_ids([],_UsedIds,[]).
1095 ceo_filter_used_ids([TId|Irest],UsedIds,Filtered) :-
1096 get_texpr_id(TId,Id),
1097 ( ord_member(Id,UsedIds) -> Filtered = [TId|Frest] % id used: keep it
1098 ; Filtered = Frest),
1099 ceo_filter_used_ids(Irest,UsedIds,Frest).
1100
1101 % a version of create_exists which also detects x=E and x:E, x>E, not(x>E) tautologies
1102 % we could replace this by a more generic prover
1103 create_exists_detect_tautology_aux([TID],b(member(LHS,RHS),pred,_),_,Truth) :-
1104 get_texpr_id(LHS,ID), get_texpr_id(TID,ID),
1105 definitely_not_empty_set(RHS),
1106 always_well_defined_or_disprover_mode(RHS),
1107 !, % replace #x.(x:RHS) by TRUTH
1108 debug_format(19,'Detected tautology exists membership over ~w~n',[ID]),
1109 Truth=b(truth,pred,[]).
1110 create_exists_detect_tautology_aux([TID],b(Pred,_,_),_,Truth) :-
1111 is_comparison(Pred,pos_neg(pos,TID),L,R), get_texpr_id(TID,ID),
1112 ((LHS,RHS)=(L,R) ; (LHS,RHS)=(R,L)),
1113 get_texpr_id(LHS,ID),
1114 \+ occurs_in_expr(ID,RHS),
1115 always_well_defined_or_disprover_mode(RHS),
1116 !, % replace #x.(x COMP E) by TRUTH
1117 debug_format(19,'Detected tautology comparison over ~w~n',[ID]),
1118 Truth=b(truth,pred,[]).
1119 %create_exists_detect_tautology_aux(Ids,b(disjunct(A,B),pred,Info1),AdditionalInfos,NewPred) :- !,
1120 % create_exists(Ids,A,PA), create_exists(Ids,B,PB),
1121 % disjunct_predicates_with_pos_info(PA,PB,b(NP,pred,Info2)),
1122 % NewPred=b(NP,pred,NewInfo),
1123 % extract_just_important_info_aux(Info1,Info2,NewInfo). % copy symbolic or other relevant info
1124 create_exists_detect_tautology_aux(Ids,Pred,AdditionalInfos,NewPred2) :-
1125 create_exists_or_let_predicate(Ids,Pred,NewPred),
1126 add_texpr_infos_if_new(NewPred,[removed_typing|AdditionalInfos],NewPred2).
1127 % removed_typing to avoid spurious exists_body_warning, see test 1681, 625
1128
1129
1130 is_eventb_comprehension_set(b(comprehension_set(TopIds,Body),_,Info),Ids,PRED,EXPR) :-
1131 is_eventb_comprehension_set(TopIds,Body,Info,Ids,PRED,EXPR).
1132 is_eventb_comprehension_set([TID1],Body,Info,Ids,PRED,EXPR) :-
1133 Body = b(exists(Ids,InnerBody),pred,_),
1134 conjunction_to_list(InnerBody,Inner),
1135 append(Inner1,[b(equal(TID2,EXPR),pred,EqInfo)],Inner),
1136 ? (member(was(event_b_comprehension_set),Info) -> true ;
1137 ? member(prob_annotation('LAMBDA-EQUALITY'),EqInfo) % relevant for TLA2B
1138 ),
1139 same_id(TID1,TID2,_),
1140 conjunct_predicates(Inner1,PRED),
1141 % we check that TID1 is not being used in P1 and not just rely on was(event_b_comprehension_set)
1142 not_occurs_in_expr(PRED,TID1).
1143
1144 % -------------------
1145
1146 is_equal(b(equal(LHS,RHS),pred,_),A,B) :-
1147 ((A,B)=(LHS,RHS) ; (A,B)=(RHS,LHS)).
1148
1149 :- use_module(typing_tools,[type_has_at_least_two_elements/1]).
1150 is_comparison(greater(A,B),_,A,B).
1151 is_comparison(less(A,B),_,A,B).
1152 is_comparison(greater_equal(A,B),_,A,B).
1153 is_comparison(less_equal(A,B),_,A,B).
1154 is_comparison(equal(A,B),pos_neg(P,TID),A,B) :-
1155 % for neg: we need to make sure there is more than one value in the type (otherwise we cannot make equal false)
1156 % for pos: assuming the RHS expression above is well-defined there must be at least one element; no need to check non_empty_type(Type)
1157 (P=pos -> true ; get_texpr_type(TID,Type),type_has_at_least_two_elements(Type)).
1158 is_comparison(not_equal(A,B),pos_neg(P,TID),A,B) :- % ditto but with pos and neg reversed
1159 (P=neg -> true ; get_texpr_type(TID,Type),type_has_at_least_two_elements(Type)).
1160 is_comparison(negation(b(Comp,pred,_)),PosNeg,A,B) :- negate(PosNeg,P2),
1161 is_comparison(Comp,P2,A,B).
1162 negate(pos_neg(pos,T),pos_neg(neg,T)).
1163 negate(pos_neg(neg,T),pos_neg(pos,T)).
1164
1165
1166
1167 % is true if a predicate Pred can be split into two parts:
1168 % Outer which does not depend on LocalIds (can be lifted out) and Inner which does
1169 detect_global_predicates(LocalIds,Pred,Outer,Inner) :-
1170 get_texpr_ids(LocalIds,UnsortedIds), sort(UnsortedIds,Ids),
1171 conjunction_to_list(Pred,Preds),
1172 split_predicate_local_global(Preds,Ids,OuterL,InnerL),
1173 OuterL \= [],
1174 conjunct_predicates(OuterL,Outer),
1175 conjunct_predicates(InnerL,Inner).
1176 split_predicate_local_global([],_Ids,[],[]).
1177 split_predicate_local_global([P|Ps],Ids,Outer,Inner) :-
1178 (is_local_predicate(Ids,P)
1179 -> Inner = [P|Is], split_predicate_local_global(Ps,Ids,Outer,Is)
1180 ; Outer = [P|Os], split_predicate_local_global(Ps,Ids,Os,Inner)).
1181 is_local_predicate(Ids,Pred) :-
1182 find_identifier_uses_if_necessary(Pred, [], LocalUses),
1183 ord_intersect(Ids,LocalUses).
1184
1185 %:- use_module(b_global_sets,[b_global_set/1]).
1186 definitely_not_empty_set(b(SET,T,_)) :- not_empty_set_aux(SET,T).
1187 not_empty_set_aux(bool_set,_).
1188 not_empty_set_aux(integer_set(_),_).
1189 not_empty_set_aux(float_set,_).
1190 not_empty_set_aux(real_set,_).
1191 not_empty_set_aux(string_set,_).
1192 not_empty_set_aux(set_extension(X),_) :- dif(X,[]).
1193 not_empty_set_aux(sequence_extension(X),_) :- dif(X,[]).
1194 not_empty_set_aux(pow_subset(_),_). % always contains at least the empty set
1195 not_empty_set_aux(fin_subset(_),_). % ditto
1196 not_empty_set_aux(seq(_),_). % ditto
1197 not_empty_set_aux(iseq(_),_). % ditto
1198 not_empty_set_aux(pow1_subset(A),_) :- definitely_not_empty_set(A).
1199 not_empty_set_aux(fin1_subset(A),_) :- definitely_not_empty_set(A).
1200 not_empty_set_aux(seq1(A),_) :- definitely_not_empty_set(A).
1201 not_empty_set_aux(iseq1(A),_) :- definitely_not_empty_set(A).
1202 not_empty_set_aux(cartesian_product(A,B),_) :- definitely_not_empty_set(A), definitely_not_empty_set(B).
1203 not_empty_set_aux(partial_function(_A,_B),_). % always contains at least the empty set
1204 not_empty_set_aux(partial_injection(_A,_B),_). % ditto
1205 not_empty_set_aux(relations(_A,_B),_). % ditto
1206 not_empty_set_aux(total_function(A,B),_) :-
1207 (definitely_not_empty_set(B) -> true
1208 ; definitely_empty_set(A)). % if A is empty, then the set of total functions is {{}}
1209 not_empty_set_aux(union(A,B),_) :- (definitely_not_empty_set(A) -> true ; definitely_not_empty_set(B)).
1210 not_empty_set_aux(overwrite(A,B),_) :- (definitely_not_empty_set(A) -> true ; definitely_not_empty_set(B)).
1211 % TODO: add a few more function rules
1212 not_empty_set_aux(value(S),_) :- not_empty_value(S).
1213 %not_empty_set_aux(identifier(X),set(global(X))) :- bmachine:b_get_machine_set(X). % what if we have a local variable ? ENSURE THAT WE DO NOT ALLOW identifier X to stand for global set X; see ExistentialGlobalSetIDTest in Tester % also: b_global_set not yet computed when ast_cleanup runs on startup !
1214 % TO DO: determine which identifier(X) refer to global set names
1215 not_empty_set_aux(interval(A,B),_) :- get_integer(A,IA), get_integer(B,IB), IA =< IB.
1216
1217 :- use_module(b_global_sets,[b_non_empty_global_set/1]).
1218 :- use_module(kernel_freetypes,[is_non_empty_freetype/1]).
1219 not_empty_value(S) :- var(S),!,fail.
1220 not_empty_value(avl_set(_)).
1221 not_empty_value([_|_]).
1222 not_empty_value(global_set(G)) :- b_non_empty_global_set(G). % always true
1223 not_empty_value(freetype(G)) :- is_non_empty_freetype(G). % always true
1224 not_empty_value(closure(P,T,B)) :-
1225 custom_explicit_sets:is_interval_closure(P,T,B,LOW,UP), integer(LOW),integer(UP), LOW =< UP.
1226 %TODO: more closures; see also definitely_not_empty_finite_value
1227
1228 definitely_empty_set(b(ES,_,_)) :- is_empty_set_aux(ES).
1229 is_empty_set_aux(empty_set).
1230 is_empty_set_aux(empty_sequence).
1231 is_empty_set_aux(domain(D)) :- definitely_empty_set(D).
1232 is_empty_set_aux(range(D)) :- definitely_empty_set(D).
1233 is_empty_set_aux(domain_subtraction(_,Rel)) :- definitely_empty_set(Rel).
1234 is_empty_set_aux(domain_restriction(Dom,Rel)) :- (definitely_empty_set(Dom) -> true ; definitely_empty_set(Rel)).
1235 is_empty_set_aux(range_restriction(Rel,Ran)) :- (definitely_empty_set(Ran) -> true ; definitely_empty_set(Rel)).
1236 is_empty_set_aux(range_subtraction(Rel,_)) :- definitely_empty_set(Rel).
1237 is_empty_set_aux(interval(A,B)) :- get_integer(A,IA), get_integer(B,IB), IA > IB.
1238 is_empty_set_aux(intersection(A,B)) :- (definitely_empty_set(A) -> true ; definitely_empty_set(B)).
1239 is_empty_set_aux(set_subtraction(A,_)) :- definitely_empty_set(A).
1240 is_empty_set_aux(union(A,B)) :- definitely_empty_set(A), definitely_empty_set(B).
1241 is_empty_set_aux(overwrite(A,B)) :- definitely_empty_set(A), definitely_empty_set(B).
1242 is_empty_set_aux(value(V)) :- V==[].
1243
1244
1245 get_integer(b(B,_,_),I) :- get_integer_aux(B,I).
1246 get_integer_aux(integer(I),I).
1247 get_integer_aux(value(V),I) :- get_integer_value(V,I).
1248 get_integer_value(V,I) :- nonvar(V),V=int(I), integer(I).
1249
1250
1251
1252 :- use_module(probsrc(custom_explicit_sets),[avl_is_interval/3]).
1253 get_interval(b(I,set(integer),_),Low,Up) :-
1254 is_interval_aux(I,Low,Up).
1255 is_interval_aux(interval(Low,Up),Low,Up).
1256 is_interval_aux(value(CS),Low,Up) :- nonvar(CS), CS=avl_set(AVL), % occurs in Leftpad_i.imp
1257 Low = b(integer(LI),integer,[]), Up = b(integer(UI),integer,[]),
1258 avl_is_interval(AVL,LI,UI).
1259 is_interval_aux(set_extension(List),Low,Up) :- print(l(List)),nl,
1260 sort(List,SList),
1261 SList = [Low|Rest], get_integer(Low,LI),
1262 last(SList,Up), get_integer(Up,UI),
1263 length(List,Len),
1264 Len is UI-LI+1,
1265 maplist(get_integer,Rest,_).
1266
1267 % a simple let-detection
1268 create_exists_or_let_predicate([H|T],b(conjunct(LHS,RHS),pred,I),NewPred) :- get_texpr_id(H,ID),
1269 ? is_equal(LHS,TID,IDEXPR), % TO DO: should we do a more complicated check here ? exist technique useful for SLOT-24 codespeed test
1270 get_texpr_id(TID,ID), \+ occurs_in_expr(ID,IDEXPR),
1271 maplist(not_occurs_in_expr(IDEXPR),T),
1272 !,
1273 NewPred = b(let_predicate([TID],[IDEXPR],Body),pred,I),
1274 %print('LET: '),translate:print_bexpr(NewPred),nl,
1275 create_exists_or_let_predicate(T,RHS,Body).
1276 create_exists_or_let_predicate(Ids,Pred,NewPred) :- create_exists(Ids,Pred,NewPred).
1277
1278 not_occurs_in_expr(IDEXPR,TID) :- get_texpr_id(TID,ID), \+ occurs_in_expr(ID,IDEXPR).
1279
1280 create_exists([],Pred,NewPred) :- !,Pred=NewPred.
1281 create_exists(Ids,Pred,NewPred) :-
1282 find_identifier_uses_for_quantifier_body(Ids,Pred, Used),
1283 extract_info_wo_used_ids(Pred,NewImportantInfo),
1284 create_texpr(exists(Ids,Pred),pred,[used_ids(Used)|NewImportantInfo],NewPred).
1285
1286 % a version of create_exists which can merge with an already present exists if possible
1287 % possibly more expensive as identfiers used are recomputed for the moment (TODO: reuse used_ids and subtract)
1288 create_or_merge_exists(IDs, Condition, Exists):-
1289 get_texpr_expr(Condition,exists(InnerVars,InnerCond)),!,
1290 % fuse two exists together
1291 append(IDs,InnerVars,Vars),
1292 create_or_merge_exists(Vars,InnerCond,Exists).
1293 create_or_merge_exists(IDs, Condition, Exists):-
1294 create_exists(IDs,Condition,Exists).
1295
1296 % see create_unsimplified_exists
1297 not_generated_exists_paras([b(_,_,Infos)|_]) :- nonmember(generated_exists_parameter,Infos).
1298
1299
1300 create_forall([],Pred,NewPred) :- !,Pred=NewPred.
1301 create_forall(Ids,Pred,NewPred) :-
1302 find_identifier_uses_for_quantifier_body(Ids,Pred, Used),
1303 split_forall_body(Pred,LHS,RHS),
1304 extract_info_wo_used_ids_and_pos(LHS,RHS,NewImportantInfo),
1305 create_texpr(forall(Ids,LHS,RHS),pred,[used_ids(Used)|NewImportantInfo],NewPred).
1306 split_forall_body(b(implication(LHS,RHS),_,_),LHS,RHS) :- !.
1307 split_forall_body(RHS,b(truth,pred,[]),RHS).
1308
1309 create_implication(b(truth,pred,_),P,Res) :- !, Res=P.
1310 create_implication(b(falsity,pred,_),P,Res) :- !, create_negation(P,Res).
1311 create_implication(Lhs,Rhs,b(implication(Lhs,Rhs),pred,NewInfo)) :-
1312 extract_info(Lhs,Rhs,NewInfo).
1313
1314 create_equivalence(Lhs,Rhs, b(equivalence(Lhs,Rhs),pred,NewInfo)) :-
1315 extract_info(Lhs,Rhs,NewInfo).
1316
1317 create_negation(b(P,pred,I),Res) :- create_negation_aux(P,I,R),!,Res=R.
1318 create_negation(Pred,b(negation(Pred),pred,NewInfo)) :-
1319 extract_info(Pred,Infos),
1320 ? (get_texpr_non_label_posinfo(Pred,Pos) -> NewInfo = [Pos|Infos] ; NewInfo=Infos).
1321
1322 create_negation_aux(truth,I,R) :- !, R=b(falsity,pred,I).
1323 create_negation_aux(falsity,I,R) :- !, R=b(truth,pred,I).
1324 create_negation_aux(negation(Pred),_,R) :- R=Pred. % not(not(P)) = P
1325 %create_negation_aux(equal(A,B),I,R) :- !, R=b(not_equal(A,B),pred,I).
1326 %create_negation_aux(not_equal(A,B),I,R) :- !, R=b(equal(A,B),pred,I).
1327 % we could add some rules about negating member <-> not_member, ... but be careful with effects on is_negation_of
1328
1329 % check if something is the negation of something else (quite stupid at the moment)
1330 % used, e.g., to detect IF-THEN-ELSE constructs in b_ast_cleanup
1331 is_negation_of(P,NP) :-
1332 create_negation(P,NotP), % works both with not(A),A or A,not(A)
1333 same_texpr(NotP,NP).
1334 is_negation_of(b(P,pred,_),b(NP,pred,_)) :- is_negation_aux(P,NP).
1335
1336 is_negation_aux(equal(A,B),NP) :- is_negation_of_equality(NP,A,B).
1337 is_negation_aux(not_equal(A,B),NP) :- is_negation_of_disequality(NP,A,B).
1338 is_negation_aux(subset(XA,SA),not_subset(XB,SB)) :- same_texpr(XA,XB), same_texpr(SA,SB).
1339 is_negation_aux(not_subset(XA,SA),subset(XB,SB)) :- same_texpr(XA,XB), same_texpr(SA,SB).
1340 is_negation_aux(subset_strict(XA,SA),not_subset_strict(XB,SB)) :- same_texpr(XA,XB), same_texpr(SA,SB).
1341 is_negation_aux(not_subset_strict(XA,SA),subset_strict(XB,SB)) :- same_texpr(XA,XB), same_texpr(SA,SB).
1342 is_negation_aux(member(XA,SA),not_member(XB,SB)) :- same_texpr(XA,XB), same_texpr(SA,SB).
1343 is_negation_aux(not_member(XA,SA),member(XB,SB)) :- same_texpr(XA,XB), same_texpr(SA,SB).
1344 is_negation_aux(less(A,B),greater_equal(AA,BB)) :- same_texpr(A,AA), same_texpr(B,BB).
1345 is_negation_aux(less(A,B),less_equal(BB,AA)) :- same_texpr(A,AA), same_texpr(B,BB).
1346 is_negation_aux(less_equal(B,A),less(AA,BB)) :- same_texpr(A,AA), same_texpr(B,BB).
1347 is_negation_aux(less_equal(A,B),greater(AA,BB)) :- same_texpr(A,AA), same_texpr(B,BB).
1348 is_negation_aux(greater_equal(A,B),NP) :- is_negation_aux(less_equal(B,A),NP).
1349 is_negation_aux(greater(A,B),NP) :- is_negation_aux(less(B,A),NP).
1350 is_negation_aux(less_equal_real(B,A),less_real(AA,BB)) :- same_texpr(A,AA), same_texpr(B,BB).
1351 is_negation_aux(less_real(B,A),less_equal_real(AA,BB)) :- same_texpr(A,AA), same_texpr(B,BB).
1352 is_negation_aux(negation(A),negation(B)) :- is_negation_of(A,B).
1353 is_negation_aux(truth,falsity).
1354 is_negation_aux(falsity,truth).
1355 % TO DO: detect more ?? x < y <=> not ( x > y-1 )
1356
1357 is_negation_of_equality(not_equal(AA,BB),A,B) :- same_texpr(A,AA), same_texpr(B,BB).
1358 is_negation_of_equality(equal(AA,BB),A,B) :- same_texpr(A,AA), neg_value(BB,B).
1359
1360 neg_value(b(boolean_true,_,_),b(boolean_false,_,_)).
1361 neg_value(b(boolean_false,_,_),b(boolean_true,_,_)).
1362
1363 is_negation_of_disequality(equal(AA,BB),A,B) :- same_texpr(A,AA), same_texpr(B,BB).
1364 is_negation_of_disequality(not_equal(AA,BB),A,B) :- same_texpr(A,AA), neg_value(BB,B).
1365
1366
1367 % another version which is simpler can can be used to get the negation of some operators
1368
1369 get_negated_operator_expr(b(E,pred,_),Res) :- negate_expr_aux(E,Res).
1370 negate_expr_aux(falsity,truth).
1371 negate_expr_aux(truth,falsity).
1372 negate_expr_aux(member(X,S),not_member(X,S)).
1373 negate_expr_aux(not_member(X,S),member(X,S)).
1374 negate_expr_aux(subset(X,S),not_subset(X,S)).
1375 negate_expr_aux(not_subset(X,S),subset(X,S)).
1376 negate_expr_aux(subset_strict(X,S),not_subset_strict(X,S)).
1377 negate_expr_aux(not_subset_strict(X,S),subset_strict(X,S)).
1378 negate_expr_aux(equal(X,S),not_equal(X,S)).
1379 negate_expr_aux(not_equal(X,S),equal(X,S)).
1380 negate_expr_aux(less(X,S),greater_equal(X,S)).
1381 negate_expr_aux(greater_equal(X,S),less(X,S)).
1382 negate_expr_aux(less_equal(X,S),greater(X,S)).
1383 negate_expr_aux(greater(X,S),less_equal(X,S)).
1384 negate_expr_aux(less_equal_real(X,S),less_real(S,X)).
1385 negate_expr_aux(less_real(X,S),less_equal_real(S,X)).
1386 % TO DO: negation()
1387
1388
1389 % a liberal version for finding equalities
1390 is_equality(TP,TA,TB) :- get_texpr_expr(TP,P), is_equality_aux(P,TA,TB).
1391
1392 is_equality_aux(Var,TA,TB) :- var(Var),!, add_internal_error('Illegal call: ', is_equality_aux(Var,TA,TB)),fail.
1393 is_equality_aux(equal(TA,TB),TA,TB).
1394 is_equality_aux(not_equal(TA,TB),NTA,NTB) :-
1395 (negate_boolean_value(TB,NTB) -> NTA=TA
1396 ; NTB=TB, negate_boolean_value(TA,NTA)). % TA /= TRUE ---> TA = FALSE
1397 is_equality_aux(partition(TA,[TB]),TA,TB).
1398 is_equality_aux(member(TA,TSet),TA,TB) :- singleton_set_extension(TSet,TB). % TA:{TB}
1399 is_equality_aux(negation(TExpr),TA,TB) :- get_negated_operator_expr(TExpr,NT), is_equality_aux(NT,TA,TB).
1400
1401 negate_boolean_value(b(B,T,I),b(NB,T,I)) :- neg_bool_aux(B,NB).
1402 neg_bool_aux(boolean_true,boolean_false).
1403 neg_bool_aux(boolean_false,boolean_true).
1404 % TODO: should we also detect value(pred_true), ....
1405
1406 singleton_set_extension(b(SONE,Type,_),El) :- singleton_set_extension_aux(SONE,Type,El).
1407 singleton_set_extension_aux(set_extension([El]),_,El).
1408 singleton_set_extension_aux(value(Set),set(Type),b(value(El),Type,[])) :- custom_explicit_sets:singleton_set(Set,El).
1409 singleton_set_extension_aux(sequence_extension([El]),_,Couple) :-
1410 ONE = b(integer(1),integer,[]),
1411 create_couple(ONE,El,Couple).
1412
1413
1414 % detect various forms of membership:
1415 is_membership(b(Expr,pred,_),TID,Set) :- is_membership_aux(Expr,TID,Set).
1416 is_membership_aux(member(TID,Set),TID,Set).
1417 is_membership_aux(subset(SONE,Set),TID,Set) :- singleton_set_extension(SONE,TID). % {TID} <: Set
1418
1419 % detect even more forms of membership:
1420 is_membership_or_equality(b(Expr,pred,_),TID,Set) :-
1421 (is_membership_aux(Expr,TID,Set) -> true ; is_mem_eq_aux(Expr,TID,Set)).
1422
1423 is_mem_eq_aux(equal(TID,VAL),TID,Set) :- % x=VAL <==> x:{VAL}
1424 get_texpr_type(VAL,Type),
1425 safe_create_texpr(set_extension([VAL]),set(Type),Set).
1426
1427 % extract a lambda equality from a body; we suppose the equality is the last conjunct
1428 get_lambda_equality(b(equal(TID,ResultExpr),pred,_),ID,[],ResultExpr) :- get_texpr_id(TID,ID).
1429 get_lambda_equality(b(conjunct(LHS,RHS),pred,_),ID,[LHS|T],ResultExpr) :-
1430 ? get_lambda_equality(RHS,ID,T,ResultExpr).
1431
1432 % ---------------------------------
1433
1434 is_pow_subset(B,Set) :-
1435 ( B = b(pow_subset(Set),_,_)
1436 ; B = b(fin_subset(Set),_,_),
1437 finite_wd_set_value(Set)
1438 ).
1439 is_pow1_subset(B,Set) :-
1440 ( B = b(pow1_subset(Set),_,_)
1441 ; B = b(fin1_subset(Set),_,_),
1442 finite_wd_set_value(Set)
1443 ).
1444
1445 % ---------------------------------
1446
1447 get_texpr_couple(b(couple(TA1,TA2),_,_),TA1,TA2).
1448
1449 % detect TA1|->TA2 = TB1|->TB2 and split into two
1450 split_equality(b(equal(TA,TB),pred,I),b(equal(TA1,TB1),pred,I),b(equal(TA2,TB2),pred,I)) :-
1451 get_texpr_couple(TA,TA1,TA2),
1452 get_texpr_couple(TB,TB1,TB2).
1453
1454 create_equality(b(_,TA,_),b(_,TB,_),_) :- TA \= TB, \+ unify_types_strict(TA,TB),!,
1455 add_internal_error('Creating equality with incompatible types:',equal(TA,TB)),fail.
1456 create_equality(A,B,Equality) :-
1457 safe_create_texpr(equal(A,B),pred,Equality).
1458
1459 create_couple(A,B,b(couple(A,B),couple(TA,TB),Infos)) :-
1460 get_texpr_type(A,TA), get_texpr_type(B,TB),
1461 extract_info(A,B,Infos).
1462
1463 % couplise_list for typed expression list
1464 create_couple([A],Couple) :- !,A=Couple.
1465 create_couple([A,B|Rest],Couple) :-
1466 create_couple(A,B,Couple1),
1467 create_couple([Couple1|Rest],Couple).
1468
1469 % derive typing from Ids
1470 create_comprehension_set(Ids,Pred,Info,CompSet) :-
1471 get_texpr_types(Ids,Types),
1472 couplise_list(Types,ElementType),
1473 create_texpr(comprehension_set(Ids,Pred),set(ElementType),Info,CompSet).
1474
1475
1476 :- assert_must_succeed(bsyntaxtree:nested_couple_to_list(b(couple(b(couple(a,b),x,[]),c),xx,[]),[a,b,c])).
1477 :- assert_must_succeed(bsyntaxtree:nested_couple_to_list(b(couple(a,c),x,[]),[a,c])).
1478 :- assert_must_succeed(bsyntaxtree:nested_couple_to_list(b(couple(a,b(couple(b,c),x,[])),xx,[]),[a,b(couple(b,c),x,[])])).
1479 nested_couple_to_list(NC,L) :- nested_couple_to_list_dcg(NC,L,[]).
1480 nested_couple_to_list_dcg(b(couple(A,B),_,_)) --> !,
1481 nested_couple_to_list_dcg(A), [B].
1482 nested_couple_to_list_dcg(E) --> [E].
1483
1484 % --------------------------------------
1485
1486
1487 % check if identifier(s) occur in typed expressions
1488
1489 occurs_in_expr(ID,TExpr) :- var(ID),!,
1490 add_internal_error('Variable id: ',occurs_in_expr(ID,TExpr)),fail.
1491 occurs_in_expr(ID,TExpr) :- ID=b(_,_,_),!, add_internal_error('Non-atomic identifier: ',occurs_in_expr(ID,TExpr)),fail.
1492 occurs_in_expr(ID,TExpr) :- ID=[_|_],!,
1493 add_internal_error('List instead of identifier: ',occurs_in_expr(ID,TExpr)),fail.
1494 occurs_in_expr(ID,TExpr) :- occurs_in_expr1(TExpr,ID).
1495
1496 % treat a few common operators here; possibly avoid traversing whole term if we find ID in a sub-tree
1497 occurs_in_expr1(TExpr,ID) :- TExpr = b(Expr,_,_),!,
1498 occurs_in_expr2(Expr,TExpr,ID).
1499 occurs_in_expr1(TExpr,ID) :- add_internal_error('Illegal typed expression:',occurs_in_expr1(TExpr,ID)).
1500
1501 occurs_in_expr2(add(A,B),_,ID) :- !,
1502 (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)).
1503 occurs_in_expr2(conjunct(A,B),_,ID) :- !,
1504 (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)).
1505 occurs_in_expr2(couple(A,B),_,ID) :- !,
1506 (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)).
1507 occurs_in_expr2(member(A,B),_,ID) :- !,
1508 (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)).
1509 occurs_in_expr2(equal(A,B),_,ID) :- !,
1510 (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)).
1511 occurs_in_expr2(function(A,B),_,ID) :- !,
1512 (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)).
1513 occurs_in_expr2(image(A,B),_,ID) :- !,
1514 (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)).
1515 occurs_in_expr2(intersection(A,B),_,ID) :- !,
1516 (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)).
1517 occurs_in_expr2(interval(A,B),_,ID) :- !,
1518 (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)).
1519 occurs_in_expr2(not_equal(A,B),_,ID) :- !,
1520 (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)).
1521 occurs_in_expr2(assertion_expression(A,_Msg,B),_,ID) :- !,
1522 (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID)).
1523 occurs_in_expr2(domain(A),_,ID) :- !, occurs_in_expr1(A,ID).
1524 occurs_in_expr2(range(A),_,ID) :- !, occurs_in_expr1(A,ID).
1525 occurs_in_expr2(record_field(A,_FieldName),_,ID) :- !, occurs_in_expr1(A,ID).
1526 occurs_in_expr2(identifier(ID1),_,ID) :- !,
1527 ID1 = ID.
1528 occurs_in_expr2(integer(_),_,_ID) :- !,fail.
1529 occurs_in_expr2(string(_),_,_ID) :- !,fail.
1530 occurs_in_expr2(value(_),_,_ID) :- !,fail.
1531 occurs_in_expr2(truth,_,_ID) :- !,fail.
1532 occurs_in_expr2(if_then_else(A,B,C),_,ID) :- !,
1533 (occurs_in_expr1(A,ID) -> true ; occurs_in_expr1(B,ID) -> true ; occurs_in_expr1(C,ID)).
1534 occurs_in_expr2(rec(Fields),_,ID) :- !,
1535 l_field_occurs_in_expr1(Fields,ID).
1536 occurs_in_expr2(set_extension(Elements),_,ID) :- !,
1537 l_occurs_in_expr1(Elements,ID).
1538 occurs_in_expr2(sequence_extension(Elements),_,ID) :- !,
1539 l_occurs_in_expr1(Elements,ID).
1540 occurs_in_expr2(Expr,_,ID) :-
1541 syntaxelement(Expr,List,[], [], [], _), % no bound quantifiers; TO DO: treat bound quantifiers
1542 !,
1543 l_occurs_in_expr1(List,ID).
1544 occurs_in_expr2(_E,TExpr,ID) :-
1545 %functor(_E,F,N), print(occurs_in_expr2(F,N,ID)),nl,
1546 (find_identifier_uses_if_necessary(TExpr,[],Used)
1547 -> %check_sorted(Used),
1548 %add_message(bsyntaxtree,'Occurs check: ',ID:Used,TExpr), translate:nested_print_bexpr(TExpr),nl,
1549 ord_member(ID,Used)
1550 ; add_failed_call_error(find_identifier_uses(TExpr,[],_)),fail).
1551 % TO DO: optimize so that we only look for ID; we don't have to keep track of other IDs
1552
1553 l_occurs_in_expr1([H|T],ID) :- !,
1554 (occurs_in_expr1(H,ID) -> true ; l_occurs_in_expr1(T,ID)).
1555 l_occurs_in_expr1(L,ID) :- L \= [],
1556 add_internal_error('Illegal typed expression list:',l_occurs_in_expr1(L,ID)).
1557 l_field_occurs_in_expr1([field(_,H)|T],ID) :- !,
1558 (occurs_in_expr1(H,ID) -> true ; l_field_occurs_in_expr1(T,ID)).
1559 l_field_occurs_in_expr1(L,ID) :- L \= [],
1560 add_internal_error('Illegal record field list:',l_field_occurs_in_expr1(L,ID)).
1561
1562 %check_sorted(List) :- sort(List,SL), (SL \= List -> add_internal_error('Not sorted:',List) ; true).
1563
1564 some_id_occurs_in_expr([H|T],TExpr) :- (var(H) ; \+ atomic(H) ; var(T) ; T=[H2|_], H2 @< H),
1565 add_internal_error('Must be (sorted) atomic identifiers: ',some_id_occurs_in_expr([H|T],TExpr)),
1566 fail.
1567 some_id_occurs_in_expr([Id],TExpr) :- !, % use version without complete find_identifier_uses
1568 occurs_in_expr(Id,TExpr).
1569 some_id_occurs_in_expr(SortedIDs,TExpr) :-
1570 find_identifier_uses_if_necessary(TExpr,[],Used),
1571 list_to_ord_set(Used,UsedSorted),
1572 ord_intersect(UsedSorted,SortedIDs).
1573
1574 % -----------------------------
1575
1576 % find used identifiers in typed expressions
1577
1578 % a special version for quantifier bodies, attempting to reuse used_ids info
1579 find_identifier_uses_for_quantifier_body(TIds,Body,Res) :-
1580 get_texpr_ids(TIds,Ids),
1581 list_to_ord_set(Ids,Ignore),
1582 find_identifier_uses_if_necessary(Body,Ignore,Res).
1583
1584 % only run find_identifier_uses if necessary because no used_ids Info field present
1585 % TO DO: we could consider using used_ids within find_typed_identifier_uses: drawback: we would need to store types
1586 find_identifier_uses_if_necessary(Expr,Ignore,Res) :-
1587 get_texpr_info(Expr,I),
1588 ? member(used_ids(UIds),I),!, %print('+'),nl,
1589 find_with_reuse(Expr,UIds,Ignore,Res).
1590 find_identifier_uses_if_necessary(Expr,Ignore,Res) :- find_identifier_uses(Expr,Ignore,Res).
1591
1592 find_with_reuse(Expr,UIds,Ignore,Res) :- preference(prob_safe_mode,true),
1593 !,
1594 (is_ordset(Ignore) -> true ; add_internal_error('Not ordset: ',Ignore)),
1595 (is_ordset(UIds) -> true ; add_internal_error('Not ordset: ',UIds)),
1596 ord_subtract(UIds,Ignore,Res0),
1597 find_identifier_uses(Expr,Ignore,Res1),
1598 (Res1=Res0 -> true
1599 ; ord_subtract(Res1,Res0,Miss), % missing
1600 ord_subtract(Res0,Res1,Res01), % too much
1601 (Miss=[] -> add_message(find_identifier_uses_if_necessary,'Suboptimal used_ids: ',Res01,Expr)
1602 ; add_internal_error('Incorrect used_ids:',used_ids(missing(Miss),toomuch(Res01),usedids(UIds),
1603 ignore(Ignore),real(Res1))),
1604 translate:print_bexpr(Expr),nl
1605 )
1606 ),
1607 Res=Res1.
1608 find_with_reuse(_,UIds,Ignore,Res) :-
1609 %(is_ordset(Ignore) -> true ; add_internal_error('Not ordset: ',Ignore)),
1610 ord_subtract(UIds,Ignore,Res).
1611
1612
1613 find_identifier_uses_top_level(TExpr,Ids) :-
1614 get_global_identifiers(Ignored), % ignore all global sets and global constants;
1615 % hence find_identifier_uses_top_level/2 usually should only be called for top level expressions
1616 find_identifier_uses(TExpr,Ignored,Ids).
1617
1618 :- use_module(tools,[safe_sort/3]).
1619 find_identifier_uses(TExpr,Ignored,Ids) :-
1620 %tools_printing:print_term_summary(find_identifier_uses(TExpr,Ignored,Ids)),nl,
1621 check_is_texpr(TExpr,find_identifier_uses),
1622 (find_typed_identifier_uses(TExpr,Ignored,TIds)
1623 -> get_texpr_ids(TIds,RIds),
1624 % in case of type errors, or when type checking is not yet complete, we can have multiple entries of the same identifier with different types !
1625 sort(RIds,Ids) % was remove_dups, but remove_dups just calls sort; TODO: implement get_sorted_texpr_ids
1626 ; add_internal_error('Call failed:',find_typed_identifier_uses(TExpr,Ignored,_)),
1627 Ids=[]
1628 ).
1629 find_identifier_uses_l(TExprs,Ignored,Ids) :-
1630 find_typed_identifier_uses_l(TExprs,Ignored,TIds),
1631 get_texpr_ids(TIds,RIds),
1632 sort(RIds,Ids). % see above
1633
1634 check_is_texpr(X,Context) :-
1635 (get_texpr_expr(X,_) -> true ; add_internal_error('Expected TExpr: ', check_is_texpr(X,Context))).
1636
1637 find_typed_identifier_uses(TExpr,Ids) :-
1638 get_global_identifiers(Ignored), % ignore all global sets and global constants; hence find_typed_identifier_uses/2 usually should only be called for top level expressions
1639 find_typed_identifier_uses(TExpr,Ignored,Ids).
1640
1641 find_typed_identifier_uses(TExpr,Ignored,Ids) :- var(TExpr),!,
1642 add_internal_error('Variable typed expression: ', find_typed_identifier_uses(TExpr,Ignored,Ids)),
1643 Ids = [].
1644 find_typed_identifier_uses(TExpr,Ignored,Ids) :-
1645 find_typed_identifier_uses_l([TExpr],Ignored,Ids).
1646
1647 find_typed_identifier_uses2(TExpr,Ignored,Ids,Rest) :-
1648 get_texpr_expr(TExpr,Expr),
1649 safe_syntaxelement_det(Expr,Subs,TNames,_,_), % QSubs=[],
1650 ( uses_an_identifier(Expr,Id,TExpr,Ignored) ->
1651 ( ord_member(Id,Ignored) -> Ids=Rest
1652 ;
1653 get_texpr_type(TExpr,Type),
1654 normalize_type(Type,NType), % replace seq by set;
1655 % warning: when type-check not yet complete we have variables here
1656 create_texpr(identifier(Id),NType,[],TId),
1657 %print(adding(Id,NType,Ignored)),nl,
1658 Ids = [TId|Rest]
1659 )
1660 % ; (Expr = becomes_such(TIds,_)), nl,print(uses_primes(Expr)),nl,fail
1661 ; indirectly_uses_identifiers(Expr,Ignored,IndirectIds) ->
1662 add_typed_ids(IndirectIds,Ids,Rest2),
1663 find_typed_identifier_uses2_l(Subs,Ignored,Rest2,Rest)
1664 ; TNames = [] -> find_typed_identifier_uses2_l(Subs,Ignored,Ids,Rest)
1665 ;
1666 %find_typed_identifier_uses2_l(QSubs,Ignored,Ids,Ids2), % useless here as QSubs=[]
1667 get_texpr_ids(TNames,Names),
1668 list_to_ord_set(Names,SNames), ord_union(SNames,Ignored,Ignored2),
1669 find_typed_identifier_uses2_l(Subs,Ignored2,Ids,Rest)).
1670 find_typed_identifier_uses2_l([],_) --> !, [].
1671 find_typed_identifier_uses2_l([Expr|Rest],Ignored) --> !,
1672 find_typed_identifier_uses2(Expr,Ignored),
1673 find_typed_identifier_uses2_l(Rest,Ignored).
1674 find_typed_identifier_uses2_l(E,Ignored) -->
1675 {add_internal_error('Illegal arguments (not a list):',find_typed_identifier_uses2_l(E,Ignored)),fail}.
1676
1677 %Note: above we do not remap uses of Id$0 to Id in becomes_such;
1678 % this is done in find_read_vars_for_becomes_such in b_read_write_info
1679
1680
1681 uses_an_identifier(Expr,Id) :- uses_an_identifier(Expr,Id,none,[]).
1682
1683 uses_an_identifier(identifier(Id),Id,_,_).
1684 uses_an_identifier(lazy_lookup_pred(Id),Id,_,_).
1685 uses_an_identifier(lazy_lookup_expr(Id),Id,_,_).
1686 uses_an_identifier(value(_),Id,b(_,_,Info),Ignored) :- Ignored \= [],
1687 ? member(was_identifier(Id),Info),
1688 member('$examine_value_was_identifier_info',Ignored),!.
1689
1690 % uses multiple ids and we also need to inspect subs (operation call arguments)
1691 indirectly_uses_identifiers(operation_call_in_expr(Operation,_),Ignored,IndirectIds) :-
1692 get_texpr_info(Operation,Info),
1693 (memberchk(reads(Vars),Info)
1694 -> (var(Vars) % can happen during initial computation of read_write info for recursive operation calls in expr
1695 -> add_message(bsyntaxtree,'Operation reads info not yet computed (probably recursive call): ',Operation,Info),
1696 fail % Assume this is a direct recursive call which adds no used ids,
1697 % case happens in test 1960 for recursive call to Fact; TODO: more robust solution or disallow recursion
1698 ; true)
1699 ; add_warning(bsyntaxtree,'Operation call contains no read infos:',Operation,Info),fail),
1700 ord_subtract(Vars,Ignored,IndirectIds),
1701 IndirectIds \= [].
1702 %indirectly_uses_identifiers(external_pred_call(FunName,_),Ignored,IndirectIds) :-
1703 % expects_state(FunName), TODO: check for which external functions/predicates we need to add ids
1704
1705
1706 % this is to convert untyped ids in operation call reads infos to typed ids
1707 add_typed_ids([]) --> [].
1708 add_typed_ids([Id|T]) --> {var_cst_type(Id,Type)},!,
1709 {create_texpr(identifier(Id),Type,[],TId)}, [TId], add_typed_ids(T).
1710 add_typed_ids([Id|T]) --> {debug_println(19,ignoring_used_id(Id))}, add_typed_ids(T).
1711
1712 :- use_module(bmachine,[bmachine_is_precompiled/0, b_is_variable/2,b_is_constant/2]).
1713 var_cst_type(Name,Type) :- bmachine_is_precompiled,!,
1714 (b_is_variable(Name,Type) ; b_is_constant(Name,Type)),!.
1715 var_cst_type(_,any). % TODO: provide a better solution; maybe only allow untyped find_identifier_uses ??
1716
1717 % -------------
1718
1719 find_typed_identifier_uses_l(TExprs,Ignored,Ids) :-
1720 check_atomic_ids(Ignored),
1721 list_to_ord_set(Ignored,SIgnored),
1722 find_typed_identifier_uses2_l(TExprs,SIgnored,Unsorted,[]),!,
1723 safe_sort(find_typed_identifier_uses,Unsorted,Ids),
1724 (preference(prob_safe_mode,true) -> check_typed_ids(Ids) ; true).
1725 find_typed_identifier_uses_l(TExprs,Ignored,Ids) :-
1726 add_internal_error('Call failed:',find_typed_identifier_uses_l(TExprs,Ignored,Ids)),
1727 fail.
1728
1729 check_typed_ids([]) :- !.
1730 check_typed_ids([b(identifier(ID),T,_)|Tail]) :- !, check_ids3(Tail,ID,T).
1731 check_typed_ids(Other) :- add_internal_error('Unexpected typed id list:',check_typed_ids(Other)).
1732
1733
1734 check_atomic_ids([]) :- !.
1735 check_atomic_ids([Id|_]) :- atomic(Id),!.
1736 check_atomic_ids(Other) :- add_internal_error('Expected atomic id list:',check_atomic_ids(Other)).
1737
1738
1739 check_ids3([],_,_) :- !.
1740 check_ids3([b(identifier(ID),T,_)|Tail],ID1,T1) :- !,
1741 (ID=ID1 -> add_internal_error('Identifier appears multiple times with types:',id(ID,T1,T)) ; true),
1742 check_ids3(Tail,ID,T).
1743 check_ids3(Other,ID1,T1) :- add_internal_error('Unexpected typed id list:',check_ids3(Other,ID1,T1)).
1744
1745
1746 update_used_ids(b(Pred,T,OInfo),UsedIds,b(Pred,T,[used_ids(UsedIds)|NInfo])) :-
1747 delete(OInfo,used_ids(_),NInfo).
1748
1749 % check if some pre-computed used ids are valid wrt find_typed_identifier_uses
1750 check_computed_used_ids(TExpr,CompUsedIds) :-
1751 find_identifier_uses(TExpr,[],RealUsedIds),
1752 (RealUsedIds=CompUsedIds -> print(ok(CompUsedIds)),nl
1753 ; add_error(range,'Unexpected used ids:',CompUsedIds,TExpr),
1754 format('Real: ~w~nComp: ~w~n',[RealUsedIds,CompUsedIds]),trace
1755 ).
1756
1757 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1758 % break predicate into components with disjunct identifiers
1759 % Pred: a predicate
1760 % Components: a list of terms component/2 where the first argument
1761 % is a predicate, the second is the set of used identifiers
1762 predicate_components(Pred,Res) :- predicate_components_in_scope(Pred,[],Res).
1763 predicate_components_in_scope(Pred,LocalVars,Res) :-
1764 predicate_components_with_restriction(Pred,LocalVars,all,Res).
1765
1766 predicate_components_with_restriction(Pred,LocalVars,RestrictionList,Res) :-
1767 conjunction_to_list(Pred,Preds),
1768 l_predicate_identifiers(Preds,LocalVars,PredIds),
1769 (RestrictionList=all -> R=all ; list_to_ord_set(RestrictionList,R)),
1770 try_find_and_remove_equalities(PredIds,PredIds2),
1771 % print(find_components(R)),nl,nl,
1772 %%(member(pred(P,Ids,X),PredIds2), nl,print(pred(Ids,X)),nl,translate:print_bexpr(P),nl,fail ; true),
1773 find_components(PredIds2,R,Components),
1774 !,
1775 %maplist(print_component,Components),
1776 Components=Res.
1777 predicate_components_with_restriction(Pred,_,_,[component(Pred,[])]) :-
1778 add_internal_error('predicate_components failed: ',predicate_components_with_restriction(Pred,_,_,_)).
1779
1780 % print_component(component(Pred,Ids)) :- format('Component over ~w :~n',[Ids]), translate:print_bexpr(Pred),nl.
1781
1782 % get the list of used identifiers for each predicate
1783 l_predicate_identifiers([],_LocalVars,[]).
1784 l_predicate_identifiers([Pred|PRest],LocalVars,[pred(Pred,Ids,_Selected)|IRest]) :-
1785 predicate_identifiers_in_scope(Pred,LocalVars,Ids), % Do not ignore local variables; used instead of enumerate set elements
1786 l_predicate_identifiers(PRest,LocalVars,IRest).
1787
1788
1789 try_find_and_remove_equalities(PredAndIds,PredAndIds2) :-
1790 preferences:get_preference(partition_predicates_inline_equalities,true),
1791 \+ preferences:get_preference(use_solver_on_load,kodkod),
1792 ? find_and_remove_equalities(PredAndIds,RR),
1793 !, PredAndIds2=RR.
1794 try_find_and_remove_equalities(Ps,Ps).
1795
1796 :- use_module(debug,[debug_println/2]).
1797 % find and apply obvious equalities so that they do not interfere with partitioning into components
1798 % example: c = 1 & f: 1..c --> A & g: 1..c --> B
1799 % TO DO: preprocess and do one pass to detect potential equalities
1800 find_and_remove_equalities([],[]).
1801 find_and_remove_equalities(List,[pred(P,PIds,Sel)|FT]) :-
1802 ? select(pred(P,PIds,Sel),List,Rest),
1803 %PIds = [Id],
1804 identifier_equality(P,Id,Value),
1805 %(value_which_can_be_replaced(Value) -> true ; nl,print('Not replaced: '),translate:print_bexpr(Value),nl,fail),
1806 (get_texpr_id(Value,Id2)
1807 -> Id2 \= Id %,print(inline_id(Id,Id2)),nl
1808 % Note: this inlining does *not* help with partitioning; but does help ProB detect common predicates/expressions
1809 ; PIds=[Id],value_which_can_be_replaced(Value)),
1810 debug_println(9,replace_simple_equality(Id,PIds)),
1811 ? maplist(apply_to_pred(Id,Value),Rest,RT),
1812 !,
1813 ? find_and_remove_equalities(RT,FT).
1814 % TO DO: detect equalityes x = EXPR, where EXPR does not contain x and where x occurs in no other predicate
1815 % we can then annotate x as not to enumerate
1816 find_and_remove_equalities(R,R).
1817
1818 identifier_equality(b(equal(LHS,RHS),_,_),Id,EqTerm) :-
1819 (get_texpr_id(LHS,Id) -> EqTerm = RHS
1820 ; get_texpr_id(RHS,Id) -> EqTerm = LHS).
1821 % TO DO: should we detect other equalities?
1822
1823 value_which_can_be_replaced(b(E,T,_)) :- value_which_can_be_replaced2(E,T).
1824 %(value_which_can_be_replaced2(E,T) -> true ; print(not_val(E)),nl,fail).
1825 value_which_can_be_replaced2(value(_),_).
1826 value_which_can_be_replaced2(integer(_),_).
1827 %value_which_can_be_replaced2(identifier(I),global(G)) :- b_global_constant(G), id_not_used_anywhere(I).
1828 value_which_can_be_replaced2(integer_set(_),_).
1829 value_which_can_be_replaced2(unary_minus(A),_) :- value_which_can_be_replaced(A).
1830 value_which_can_be_replaced2(add(A,B),_) :- value_which_can_be_replaced(A), value_which_can_be_replaced(B).
1831 % we could compute the value
1832 value_which_can_be_replaced2(minus(A,B),_) :- value_which_can_be_replaced(A), value_which_can_be_replaced(B).
1833 value_which_can_be_replaced2(multiplication(A,B),_) :- value_which_can_be_replaced(A), value_which_can_be_replaced(B).
1834 value_which_can_be_replaced2(div(A,B),_) :-
1835 get_integer(B,IB), IB \= 0,
1836 value_which_can_be_replaced(A).
1837 value_which_can_be_replaced2(floored_div(A,B),T) :- value_which_can_be_replaced2(div(A,B),T).
1838 % should we add: with WD check: division, modulo, .... ? see also simple2 in b_ast_cleanup
1839 value_which_can_be_replaced2(max_int,_).
1840 value_which_can_be_replaced2(min_int,_).
1841 value_which_can_be_replaced2(float_set,_).
1842 value_which_can_be_replaced2(real(_),_).
1843 value_which_can_be_replaced2(real_set,_).
1844 value_which_can_be_replaced2(string(_),_).
1845 value_which_can_be_replaced2(string_set,_).
1846 value_which_can_be_replaced2(boolean_true,_).
1847 value_which_can_be_replaced2(boolean_false,_).
1848 value_which_can_be_replaced2(bool_set,_).
1849 value_which_can_be_replaced2(empty_set,_).
1850 value_which_can_be_replaced2(empty_sequence,_).
1851 value_which_can_be_replaced2(couple(A,B),_) :- value_which_can_be_replaced(A), value_which_can_be_replaced(B).
1852 value_which_can_be_replaced2(interval(A,B),_) :- value_which_can_be_replaced(A), value_which_can_be_replaced(B).
1853 value_which_can_be_replaced2(set_extension(L),_) :- maplist(value_which_can_be_replaced,L).
1854 value_which_can_be_replaced2(sequence_extension(L),_) :- maplist(value_which_can_be_replaced,L).
1855 value_which_can_be_replaced2(cartesian_product(A,B),_) :- % typing equations, like t_float = INTEGER*NATURAL1
1856 simple_value_set(A), simple_value_set(B).
1857 value_which_can_be_replaced2(pow_subset(A),_) :- simple_value_set(A).
1858 %value_which_can_be_replaced2(identifier(_),_). % TO DO: check that this is not the LHS identifier which we replace !!
1859 % identifiers can also be replaced: we check above that the only identifier in the predicate is the equality identifier
1860 % TO DO: enable this but then we need to fix replace_id_by_expr2 to updated the used_ids info ! + we can have scoping issues !?; see test 1358
1861
1862 % TO DO: also allow inlining of prj1/prj2 of simple_value_set:
1863 % not_val(comprehension_set([b(identifier(_zzzz_unary),integer,[generated(first)]),b(identifier(_zzzz_binary),integer,[generated(first)]),b(identifier(_lambda_result_),integer,[lambda_result])],b(equal(b(identifier(_lambda_result_),integer,[lambda_result]),b(identifier(_zzzz_unary),integer,[generated(first)])),pred,[prob_annotation(LAMBDA),lambda_result])))
1864 % not_val(comprehension_set([b(identifier(_zzzz_unary),integer,[generated(second)]),b(identifier(_zzzz_binary),integer,[generated(second)]),b(identifier(_lambda_result_),integer,[lambda_result])],b(equal(b(identifier(_lambda_result_),integer,[lambda_result]),b(identifier(_zzzz_binary),integer,[generated(second)])),pred,[prob_annotation(LAMBDA),lambda_result])))
1865
1866 % TO DO: maybe check if it is an infinite type which cannot be evaluated anyway
1867 simple_value_set(b(E,_,_)) :- simple_value_set2(E).
1868 %simple_value_set2(bool_set). % Warning: we could have a finite construct which gets evaluated multiple times
1869 simple_value_set2(string_set).
1870 simple_value_set2(integer_set(_)).
1871 simple_value_set2(float_set).
1872 simple_value_set2(real_set).
1873 simple_value_set2(cartesian_product(A,B)) :- simple_value_set(A), simple_value_set(B).
1874 simple_value_set2(pow_subset(A)) :- simple_value_set(A).
1875 % POW, records struct(_) set ?
1876
1877 % apply a substiution of ID/Expr on a pred(EXPR,VarList,X) term
1878 % Expr must either be a variable or contain no variables at all
1879 apply_to_pred(ID,Expr,pred(E1,PIds1,X),pred(E2,PIds3,X)) :-
1880 ? (select(ID,PIds1,PIds2)
1881 ? -> replace_id_by_expr(E1,ID,Expr,E2), %,print(applied(ID)),nl,translate:print_bexpr(E2),nl
1882 % TO DO: replace_id_by_expr does not seem to update used_ids info !! check_used_ids_info fails for test 1358 if we allow identifiers inside Expr
1883 (get_texpr_id(Expr,NewID)
1884 -> ord_add_element(PIds2,NewID,PIds3)
1885 ; PIds3 = PIds2)
1886 %, format('Apply ~w -> ~w : ',[ID,NewID]),translate:print_bexpr(E2),nl
1887 ; E1=E2,PIds1=PIds3).
1888
1889
1890 % project a predicate : keep only those Predicates that are directly or
1891 % indirectly relevant for Ids; FullIds are all identifiers used by ProjectedPredicate
1892 project_predicate_on_identifiers(Pred,Ids,ProjectedPredicate,FullIds, RestList) :-
1893 (debug_mode(on)
1894 -> print('project: '),print_bexpr(Pred),nl, print(' on : '), print(Ids),nl
1895 ; true),
1896 conjunction_to_list(Pred,Preds),
1897 l_predicate_identifiers(Preds,[],PredIds), % TO DO: allow LocalVariables to be passed
1898 % print(predids(PredIds)),nl,
1899 try_find_and_remove_equalities(PredIds,PredIds2),
1900 extract_all_predicates(Ids,all,Ids,PredIds2,ProjectedPredicates, RestList,FullIds),
1901 conjunct_predicates(ProjectedPredicates,ProjectedPredicate),
1902 (debug_mode(on)
1903 -> print('*result: '),print_bexpr(ProjectedPredicate),nl,
1904 print(' on : '), print(FullIds),nl
1905 ; true).
1906
1907 %print_preds([]).
1908 %print_preds([pred(P,_IDs,_)|T]) :- translate:print_bexpr(P), nl, print(' '), print_preds(T).
1909
1910 :- use_module(b_global_sets,[b_get_global_constants/1, b_get_enumerated_set_constants/1, b_get_global_sets/1]).
1911 predicate_identifiers(Pred,Ids) :- predicate_identifiers_in_scope(Pred,[],Ids).
1912 predicate_identifiers_in_scope(Pred,LocalVariables,Ids) :-
1913 get_global_identifiers(IS),
1914 list_to_ord_set(LocalVariables,LV),
1915 ord_subtract(IS,LV,Ignore2), % Do not ignore any local variable; it will be used instead of enumerate set element
1916 find_identifier_uses_if_necessary(Pred,Ignore2,Ids1), % Ignore enumerated set names
1917 list_to_ord_set(Ids1,Ids).
1918
1919 get_global_identifiers(IDs) :- get_global_identifiers(IDs,all).
1920 % get global set and constant identifiers which you usually want to exclude for find_identifier_uses
1921 get_global_identifiers(IDs,Option) :-
1922 (Option=ignore_promoted_constants
1923 % do not include those constants that have been automatically promoted as enumerated set elements
1924 -> b_get_enumerated_set_constants(EnumeratedSetCsts)
1925 ; b_get_global_constants(EnumeratedSetCsts)
1926 ),
1927 % b_global_sets:b_get_global_enumerated_sets(GSets), % is there a reason to exclude deferred sets ??; cardinality inference,... are all done before partitioning ?
1928 b_get_global_sets(GSets),
1929 append(GSets,EnumeratedSetCsts,GE),
1930 list_to_ord_set(GE,IDs).
1931
1932 % find_components(ListOf_pred, Restrict, Out:ListOfComponents)
1933 % role of Restrict: all if we do normal partition or List of VariableIDs on which we restrict our attention to (for Existential quantifier construction)
1934 find_components([],_,[]).
1935 find_components([pred(P,PIds,true)|PRest],Restrict,[component(Pred,Ids)|CRest]) :-
1936 % find all predicates which are using identifiers occuring in PIds
1937 % (and additionally those which use common identifiers )
1938 ord_restrict(Restrict,PIds,InterIDs),
1939 %format('Treating predicate with ids ~w; restr. intersect = ~w~n',[PIds,InterIDs]),
1940 ( InterIDs =[] ->
1941 % we simply copy this predicate into a single component; not with the scope of Restricted IDs
1942 % print(skip(PIds,P)),nl, %
1943 Pred=P, Ids=PIds, PRest=Rest
1944 ;
1945 extract_all_predicates(InterIDs,Restrict,PIds,PRest,Preds,Rest,Ids),
1946 %length([P|Preds],Len), format('Detected component with ~w conjuncts over ~w~n',[Len,Ids]),
1947 conjunct_predicates_with_pos_info([P|Preds],Pred)
1948 ),
1949 find_components(Rest,Restrict,CRest).
1950 extract_all_predicates([],_,_,Preds,Found,Rest,[]) :- !, % selecting done at end: keep same order of conjuncts
1951 select_predicates(Preds,Found,Rest).
1952 extract_all_predicates(Ids,Restrict,OldIds,Preds,Found,Rest,ResultIds) :-
1953 % search for all predicates that directly use one of the
1954 % identifiers in "Ids"
1955 select_all_using_preds(Preds,Ids,FoundIds),
1956 ord_subtract(FoundIds,OldIds,NewIds),
1957 ord_restrict(Restrict,NewIds,NewIdsToExtract),
1958 ord_union(OldIds,FoundIds,OldIds2),
1959 % now recursively do this which the new identifiers that we have found
1960 extract_all_predicates(NewIdsToExtract,Restrict,OldIds2,Preds,Found,Rest,RestIds),
1961 ord_union([Ids,NewIds,RestIds],ResultIds).
1962
1963 % mark all predicates which intersect with ComponentIds and compute new ids to be added to the component
1964 select_all_using_preds([],_,[]).
1965 select_all_using_preds([pred(_P,PIds,Selected)|PRest],ComponentIds,NewFoundIds) :-
1966 ( (Selected==true ; ord_disjoint(PIds,ComponentIds)) ->
1967 NewFoundIds1 = []
1968 ; % we select the predicate for the component
1969 ord_subtract(PIds,ComponentIds,NewFoundIds1),
1970 Selected=true
1971 ),
1972 select_all_using_preds(PRest,ComponentIds,NewFoundIds2),
1973 ord_union(NewFoundIds1,NewFoundIds2,NewFoundIds).
1974
1975 % ord_intersection with special case for all term
1976 ord_restrict(all,Ids,Res) :- !, Res=Ids.
1977 ord_restrict(Restrict,Ids,Res) :- ord_intersection(Ids,Restrict,Res).
1978
1979 select_predicates(Predicates,FoundPreds,OtherPreds) :-
1980 split_list(is_selected_predicate,Predicates,FoundPredIds,OtherPreds),
1981 maplist(extract_found_predicate,FoundPredIds,FoundPreds).
1982 is_selected_predicate(pred(_P,_PIds,Selected)) :- ground(Selected).
1983 extract_found_predicate(pred(P,_PIds,_Selected),P).
1984
1985 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1986 % replace (simultaneously) multiple identifiers by expressions
1987 % this could be used to replace the predicate replace_id_by_expr by mapping everything in a
1988 % singleton list. however, that would involve list operations instead of unifications
1989 parse_pred(Codes,TExpr) :- %format('Parsing ~s~n',[Codes]),
1990 bmachine:b_parse_machine_predicate_from_codes_open(no_quantifier,Codes,[],[],TExpr).
1991 parse_expr(Codes,TExpr) :- bmachine:b_parse_machine_expression_from_codes(Codes,[],TExpr,_Type,true,_Error).
1992 test_result(1,b(equal(b(comprehension_set([b(identifier(__FRESH____),integer,_)],
1993 b(greater(b(identifier(__FRESH____2),integer,_),b(identifier(x),integer,_)),pred,_)),set(integer),_),
1994 b(empty_set,set(integer),_)),pred,_)).
1995
1996 :- assert_must_succeed((bsyntaxtree:parse_pred("{x|x:INTEGER & x>y}={}",T1), replace_ids_by_exprs(T1,[],[],T1))).
1997 :- assert_must_succeed((bsyntaxtree:parse_pred("{x|x:INTEGER & x>y}={}",T1), bsyntaxtree:parse_expr("100",T2),
1998 replace_ids_by_exprs(T1,[y],[T2],R),bsyntaxtree:parse_pred("{x|x>100}={}",T3),same_texpr(R,T3) )).
1999 :- assert_must_succeed((bsyntaxtree:parse_pred("{x|x:INTEGER & x>y}={}",T1),
2000 replace_ids_by_exprs(T1,[y],[b(identifier(x),integer,[])],R),
2001 bsyntaxtree:test_result(1,R),bsyntaxtree:parse_pred("{x|x:INTEGER & x>x}={}",T3),\+ same_texpr(R,T3) )).
2002 :- assert_must_succeed((bsyntaxtree:parse_pred("{x,y|x:INTEGER & y:INTEGER & x>v & y>w}={}",T1),
2003 replace_ids_by_exprs(T1,[v,w],[b(identifier(w),integer,[]),b(identifier(v),integer,[])],R),
2004 bsyntaxtree:parse_pred("{x,y|x:INTEGER & y:INTEGER & x>w & y>v}={}",T3), same_texpr(R,T3) )).
2005 :- assert_must_succeed((gensym:reset_gensym, bsyntaxtree:parse_pred("{x,y|x:INTEGER & y:INTEGER & x>v & y>w}={}",T1),
2006 replace_ids_by_exprs(T1,[v,w],[b(identifier(w),integer,[]),b(identifier(x),integer,[])],R),
2007 translate:translate_bexpression(R,TR),
2008 TR = '{`__FRESH____1`,y|`__FRESH____1` > w & y > x} = {}')). %'{__FRESH____1,y|(__FRESH____1 : INTEGER & y : INTEGER) & (__FRESH____1 > w & y > x)} = {}' )).
2009
2010 replace_ids_by_exprs(TExpr,[TId],[Inserted],Replaced) :- !, % better, more robust and efficient version
2011 check_ids([TId],[Id]),
2012 replace_id_by_expr(TExpr,Id,Inserted,Replaced).
2013 replace_ids_by_exprs(TExpr,[],[],Replaced) :- !, Replaced=TExpr. % Nothing to do
2014 replace_ids_by_exprs(TExpr,Ids,Exprs,Replaced) :-
2015 check_ids(Ids,Ids2), % convert to atomic identifiers
2016 find_identifier_uses_l(Exprs,[],ExprsUsedIds),
2017 sort(ExprsUsedIds,SExprsUsedIds),
2018 generate_rename_list(Ids2,Exprs,RenameList),
2019 %print(replace(RenameList,SExprsUsedIds)),nl,
2020 replace_ids_by_exprs2(RenameList,SExprsUsedIds,TExpr,Replaced,_). %, nl,print(done),nl.
2021 % a version of replace_ids_by_exprs2 for maplist:
2022 %replace_ids_by_exprs1(RenameList,SExprsUsedIds,TExpr,Replaced) :-
2023 % replace_ids_by_exprs2(RenameList,SExprsUsedIds,TExpr,Replaced,_). %, print('Rep: '), translate:print_bexpr(Replaced),nl.
2024
2025 generate_rename_list([],[],[]).
2026 generate_rename_list([ID1|T],[Expr1|TE],[rename(ID1,Expr1)|RT]) :- generate_rename_list(T,TE,RT).
2027
2028 check_ids([],[]).
2029 check_ids([H|T],[ID|IT]) :- (atomic(H) -> ID=H ; def_get_texpr_id(H,ID)), check_ids(T,IT).
2030 replace_ids_by_exprs2(RenameList,ExprsUsedIds,TExpr,Replaced,WDC) :-
2031 remove_bt(TExpr,Expr,NewExpr,TNewExpr),
2032 ? ( Expr = identifier(Id), member(rename(Id,Inserted),RenameList) ->
2033 Replaced = Inserted,
2034 get_texpr_info(Inserted,Infos),
2035 (memberchk(contains_wd_condition,Infos)
2036 -> WDC = true ; WDC = false) % WDC = true means we have added a wd-condition where previously there was none
2037 ; contains_no_ids(Expr) -> Replaced=TExpr, WDC=false
2038 ;
2039 syntaxtransformation_det(Expr,Subs1,Names,NSubs,NewExpr),
2040 find_variable_clashes(Names,ExprsUsedIds,RenameNames), % check for variable caputure
2041 (RenameNames = []
2042 -> Subs = Subs1 % no variable capture occured
2043 ; %format('*** VARIABLE CAPTURE : ~w~n~n',[RenameNames]),
2044 rename_bt_l(Subs1,RenameNames,Subs) % replace affected names by fresh ids in sub arguments (will also change list of quantified variables itself)
2045 ),
2046 %l_replace_ids_by_exprs2(QSubs,RenameList,ExprsUsedIds,NQSubs,WDC1), % QSubs are like RHS of let expression, where Names are not in scope
2047 remove_hidden_names(Names,RenameList,UpdatedRenameList),
2048 ( UpdatedRenameList = [] -> % all Ids are now hidden for the inner expressions
2049 NSubs=Subs, WDC=false
2050 ;
2051 l_replace_ids_by_exprs2(Subs,UpdatedRenameList,ExprsUsedIds,NSubs,WDC)
2052 ),
2053 TNewExpr = b(E1,T1,Info1),
2054 rename_update_used_ids_info(RenameList,Info1,Info2),
2055 add_wd_if_needed(WDC,b(E1,T1,Info2),Replaced)
2056 ).
2057
2058 contains_no_ids(integer(_)).
2059 contains_no_ids(string(_)).
2060 contains_no_ids(value(_)).
2061
2062
2063 % check if we have to rename any quantified variable to avoid variable capture of RHS of renamings
2064 % example, suppose we rename x/y+1 and we enter {y|y>x} we have to generate {fresh|fresh>y+1} and *not* {y|y>y+1}
2065 find_variable_clashes([],_,[]).
2066 find_variable_clashes([Name|Names],ExprsUsedIds,[rename(ID,FRESHID)|Renaming] ) :-
2067 def_get_texpr_id(Name,ID),
2068 ord_member(ID,ExprsUsedIds), % the quantified name is also introduced by the renaming
2069 !,
2070 gensym('__FRESH__',FRESHID),
2071 find_variable_clashes(Names,ExprsUsedIds,Renaming).
2072 find_variable_clashes([_|Names],ExprsUsedIds,Renaming) :-
2073 find_variable_clashes(Names,ExprsUsedIds,Renaming).
2074
2075
2076 l_replace_ids_by_exprs2([],_,_,[],false).
2077 l_replace_ids_by_exprs2([H|T],UpdatedRenameList,ExprsUsedIds,[IH|IT],WDC) :-
2078 replace_ids_by_exprs2(UpdatedRenameList,ExprsUsedIds,H,IH,WDC1),
2079 l_replace_ids_by_exprs2(T,UpdatedRenameList,ExprsUsedIds,IT,WDC2),
2080 and_wdc(WDC1,WDC2,WDC).
2081
2082 % remove any identifiers that are now "invisible" because they are masked by quantified names
2083 % e.g., when we enter #x.(P) then a renaming of x will be "hidden" inside P
2084 remove_hidden_names([],RenameList,RenameList).
2085 remove_hidden_names([Name|Names],RenameList,NewRenameList) :-
2086 def_get_texpr_id(Name,ID),
2087 delete(RenameList,rename(ID,_),RenameList1),
2088 !, % only one rename should exist
2089 %print(del(ID,RenameList1)),nl,
2090 remove_hidden_names(Names,RenameList1,NewRenameList).
2091
2092 find_rhs_ids(rename(Id,TExpr),rename_ids(Id,InsUsedIds)) :- find_identifier_uses(TExpr,[],InsUsedIds).
2093
2094 % apply a rename list to the used_ids,... information fields
2095 % this is more tricky than applying a single identifier, as we first have to deleted all ids
2096 % and remember which ones were deleted, and only then insert the corresponding ids
2097 % e.g., we could have a RenameList = [rename(p,q),rename(q,p)] ; see test 1776 M1_Internal_v3.mch
2098 rename_update_used_ids_info(RenameList,IIn,IOut) :-
2099 l_find_rhs_ids(RenameList,RenameList2),
2100 %maplist(apply_rename_list(RenameList2),IIn,IOut).
2101 l_apply_rename_list(IIn,RenameList2,IOut).
2102
2103 l_find_rhs_ids([],[]).
2104 l_find_rhs_ids([R1|T],[NR1|NTR]) :-
2105 find_rhs_ids(R1,NR1),
2106 l_find_rhs_ids(T,NTR).
2107
2108 l_apply_rename_list([],_,[]).
2109 l_apply_rename_list([Info1|T],RenameList2,[NewInfo1|NTI]) :-
2110 apply_rename_list(RenameList2,Info1,NewInfo1),
2111 l_apply_rename_list(T,RenameList2,NTI).
2112
2113 apply_rename_list(RenameList,I,NI) :-
2114 apply_rename_list2(I,RenameList,NI).
2115 apply_rename_list2(used_ids(IDS),RenameList,used_ids(NewIDS)) :- !, apply_rename_list_to_ids(RenameList,IDS,[],NewIDS).
2116 apply_rename_list2(reads(IDS),RenameList,reads(NewIDS)) :- !, apply_rename_list_to_ids(RenameList,IDS,[],NewIDS).
2117 apply_rename_list2(modifies(IDS),RenameList,modifies(NewIDS)) :- !, apply_rename_list_to_ids(RenameList,IDS,[],NewIDS).
2118 apply_rename_list2(Info,_,Info).
2119
2120 % apply a rename list to a sorted list of ids
2121 apply_rename_list_to_ids([],Acc,ToInsert,Res) :- ord_union(Acc,ToInsert,Res).
2122 apply_rename_list_to_ids([rename_ids(Id,NewIds)|T],Acc,ToInsert,Res) :-
2123 (ord_delete_existing_element(Acc,Id,Acc2) % the Id occurs and is deleted
2124 -> ord_union(NewIds,ToInsert,ToInsert2),
2125 apply_rename_list_to_ids(T,Acc2,ToInsert2,Res)
2126 ; apply_rename_list_to_ids(T,Acc,ToInsert,Res)).
2127
2128 ord_delete_existing_element(List,El,ResList) :- % ord_del_element also succeeds if El is not in the list !
2129 ord_intersection([El],List,[El],ResList).
2130 % -----------------------
2131 % remove an Identifier from used_ids Info field if it exists
2132 remove_used_id_from_info(I,ID_to_remove,NI) :-
2133 update_used_ids_info(I,ID_to_remove,[],NI).
2134
2135 remove_used_ids_from_info([],I,I).
2136 remove_used_ids_from_info([ID_to_remove|T],I,NI) :- remove_used_id_from_info(I,ID_to_remove,I2),
2137 remove_used_ids_from_info(T,I2,NI).
2138
2139 % remove a single Identifier from used_ids Info field if it exists and insert sorted list of ids instead
2140 % a simpler version of rename_update_used_ids_info for a single identifier
2141 update_used_ids_info([],_,_,[]).
2142 update_used_ids_info([InfoField|T],ID_to_remove,IDsInserted,[NewInfoField|NT]) :-
2143 (update_id_from_info_field(ID_to_remove,IDsInserted,InfoField,R)
2144 -> NewInfoField=R
2145 ; NewInfoField=InfoField),
2146 update_used_ids_info(T,ID_to_remove,IDsInserted,NT).
2147
2148 update_id_from_info_field(ID_to_remove,IDsInserted,I,NI) :-
2149 update_id_from_info_field2(I,ID_to_remove,IDsInserted,NI).
2150 update_id_from_info_field2(used_ids(IDS),ID,IDsInserted,used_ids(NewIDS)) :- update_id(IDS,ID,IDsInserted,NewIDS).
2151 update_id_from_info_field2(reads(IDS),ID,IDsInserted,reads(NewIDS)) :- update_id(IDS,ID,IDsInserted,NewIDS).
2152 update_id_from_info_field2(modifies(IDS),ID,IDsInserted,modifies(NewIDS)) :- update_id(IDS,ID,IDsInserted,NewIDS).
2153
2154 update_id(IDS,ID_to_remove,IDsInserted,NewIDS) :-
2155 ord_delete_existing_element(IDS,ID_to_remove,IDS2), % the Id occurs and is deleted
2156 ord_union(IDsInserted,IDS2,NewIDS).
2157 %if ord_del_element fails we do not add IDsInserted: we assume the used_ids info is correct and ID_to_remove does not occur !
2158 % We could use this info to avoid traversing subtree !
2159 % print(projecting_away_unknown_id(ID_to_remove,IDS)),nl,
2160
2161 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2162
2163 :- assert_must_succeed((gensym:reset_gensym, bsyntaxtree:exists_ast(A), replace_id_by_expr(A,y,b(identifier(x),integer,[]),RA),translate:translate_bexpression(RA,TR),
2164 TR = 'r = {`__FRESH____1`|`__FRESH____1` : 1 .. x & `__FRESH____1` mod 2 = 1}' )).
2165 :- assert_must_succeed((bsyntaxtree:parse_pred("{x|x:INTEGER & x>y}={}",T1),
2166 replace_id_by_expr(T1,y,b(identifier(x),integer,[]),R),
2167 bsyntaxtree:test_result(1,R),bsyntaxtree:parse_pred("{x|x:INTEGER & x>x}={}",T3),
2168 \+ same_texpr(R,T3) )).
2169 :- assert_must_succeed((bsyntaxtree:parse_pred("{x|x:INTEGER & x>y}={}",T1), bsyntaxtree:parse_expr("100",T2),
2170 replace_id_by_expr(T1,y,T2,R),bsyntaxtree:parse_pred("{x|x>100}={}",T3),same_texpr(R,T3) )).
2171
2172 % replace an identifier Id by an expression Inserted
2173 replace_id_by_expr(TExpr,Id,Inserted,Replaced) :-
2174 ? replace_id_by_expr_with_count(TExpr,Id,Inserted,Replaced,_).
2175
2176 replace_id_by_expr_with_count(TExpr,Id,Inserted,Replaced,NrReplacements) :- \+ atomic(Id),!,
2177 add_internal_error('Id not atomic: ',replace_id_by_expr(TExpr,Id,Inserted,Replaced)),
2178 Replaced = TExpr, NrReplacements=0.
2179 replace_id_by_expr_with_count(TExpr,Id,Inserted,Replaced,NrReplacements) :-
2180 %find_all_relevant_quantified_vars(Id,TExpr,QVars),
2181 find_identifier_uses(Inserted,[],SInsUsedIds), % SInsUsedIds is sorted
2182 ? replace_id_by_expr2(Id,Inserted,SInsUsedIds,TExpr,Replaced,_WDC,0,NrReplacements).
2183
2184 replace_id_by_expr2(Id,Inserted,InsUsedIds,TExpr,Replaced,WDC,InR,OutR) :-
2185 remove_bt(TExpr,Expr,NewExpr,TNewExpr),
2186 ( Expr = identifier(Id) -> % TODO: count number of replacements
2187 Replaced = Inserted,
2188 OutR is InR+1,
2189 get_texpr_info(Inserted,Infos),
2190 (memberchk(contains_wd_condition,Infos)
2191 -> WDC = true ; WDC = false) % WDC = true means we have added a wd-condition where previously there was none
2192 ; contains_no_ids(Expr) -> Replaced=TExpr, WDC=false, OutR=InR
2193 ;
2194 ? syntaxtransformation_det(Expr,Subs,Names,NSubs,NewExpr),
2195 get_texpr_id(TId,Id),
2196 ( memberchk(TId,Names) -> % the Id is now hidden for the inner expressions
2197 NSubs=Subs, WDC=false, OutR = InR
2198 ; (InsUsedIds \= [],
2199 get_texpr_ids(Names,Ns),sort(Ns,SNs),
2200 ord_intersection(SNs,InsUsedIds,Captured),
2201 Captured \= [] %, print(inter(SNs,InsUsedIds,Captured)),nl
2202 )
2203 % The Names introduced clash with variables used in the Inserted expression
2204 -> findall(rename(X,FRESHID),(member(X,Captured),gensym:gensym('__FRESH__',FRESHID)),RenameList),
2205 %print(rename(RenameList)),nl,
2206 rename_bt_l(Subs,RenameList,RenSubs),
2207 l_replace_id_by_expr2(RenSubs,Id,Inserted,InsUsedIds,NSubs,WDC,InR,OutR)
2208 ;
2209 ? l_replace_id_by_expr2(Subs,Id,Inserted,InsUsedIds,NSubs,WDC,InR,OutR)
2210 ),
2211 TNewExpr = b(E1,T1,Info1),
2212 update_used_ids_info(Info1,Id,InsUsedIds,Info2),
2213 %(E1 = exists(P,_) -> print(exists(P,Id,Info1,Info2)),nl ; true),
2214 add_wd_if_needed(WDC,b(E1,T1,Info2),Replaced)
2215 ).
2216
2217 l_replace_id_by_expr2([],_,_,_,[],false,R,R).
2218 l_replace_id_by_expr2([H|T],Id,Inserted,InsUsedIds,[IH|IT],WDC,InR,OutR) :-
2219 ? replace_id_by_expr2(Id,Inserted,InsUsedIds,H,IH,WDC1,InR,InR2),
2220 ? l_replace_id_by_expr2(T,Id,Inserted,InsUsedIds,IT,WDC2,InR2,OutR),
2221 and_wdc(WDC1,WDC2,WDC).
2222
2223 % conjunct wd condition added flag
2224 and_wdc(true,_,R) :- !,R=true.
2225 and_wdc(_,true,R) :- !, R=true.
2226 and_wdc(_,_,false).
2227
2228 % add contains_wd_condition if a change occured during replacement of id by expression
2229 add_wd_if_needed(true,b(E,T,Infos),Replaced) :-
2230 nonmember(contains_wd_condition,Infos),
2231 !,
2232 Replaced = b(E,T,[contains_wd_condition|Infos]).
2233 add_wd_if_needed(_,T,T).
2234
2235
2236
2237 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2238
2239
2240 % syntaxtransformation_fixed/7 is the same as syntaxtransformation/5 with the exception
2241 % that we distinguish between subexpressions that have the newly introduced identifiers (Names)
2242 % in scope (OSubs) and those who don't (OExprs). The only expressions where the latter case is relevant
2243 % are let_expression and let_predicate.
2244 % TODO: This is a quick'n dirty fix for only some cases.
2245 % NO LONGER REQUIRED: let_expression and let_predicate now obey another semantic, not the Z semantics anymore
2246 %syntaxtransformation_fixed(OExpr,OExprs,OSubs,Names,NExprs,NSubs,NExpr) :-
2247 %syntaxtransformation_fixed(Expr,[],Subs,Names,[],NSubs,NExpr) :-
2248 % syntaxtransformation_det(Expr,Subs,Names,NSubs,NExpr).
2249
2250
2251 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2252 % rename identifier
2253
2254 % r = {x|x : 1..y & x mod 2 = 1}
2255 exists_ast(AST) :- AST =
2256 b(equal(b(identifier(r),set(integer),[nodeid(none)]),
2257 b(comprehension_set([b(identifier(x),integer,[nodeid(none)])],
2258 b(conjunct(b(member(b(identifier(x),integer,[nodeid(none)]),
2259 b(interval(b(integer(1),integer,[nodeid(none)]),b(identifier(y),integer,[nodeid(none)])),
2260 set(integer),[nodeid(none)])),pred,[nodeid(none)]),
2261 b(equal(b(modulo(b(identifier(x),integer,[nodeid(none)]),
2262 b(integer(2),integer,[nodeid(none)])),integer,[contains_wd_condition,nodeid(none)]),
2263 b(integer(1),integer,[nodeid(none)])),pred,
2264 [contains_wd_condition,nodeid(none)])),pred,[contains_wd_condition,nodeid(none)])),
2265 set(integer),[contains_wd_condition,nodeid(none)])),
2266 pred,[contains_wd_condition,nodeid(none)]).
2267
2268 :- assert_must_succeed((bsyntaxtree:exists_ast(A), rename_bt(A,[rename(x,xx)],RA), RA==A )).
2269 :- assert_must_succeed((bsyntaxtree:exists_ast(A), rename_bt(A,[rename(r,v)],RA),
2270 translate:translate_bexpression(RA,TR), TR='v = {x|x : 1 .. y & x mod 2 = 1}' )).
2271 :- assert_must_succeed((gensym:reset_gensym, bsyntaxtree:exists_ast(A), rename_bt(A,[rename(y,x)],RA), RA \= A,
2272 translate:translate_bexpression(RA,TR),
2273 TR = 'r = {`__FRESH____1`|`__FRESH____1` : 1 .. x & `__FRESH____1` mod 2 = 1}' )).
2274
2275 % a simplified version of replace_ids_by_exprs, which assumes target of renamings are variables
2276 rename_bt(Expr,[],Res) :- !,Res=Expr.
2277 rename_bt(OExpr,Renamings,NExpr) :-
2278 create_texpr(Old,Type,OInfo,OExpr),
2279 create_texpr(New,Type,NInfo,NExpr),
2280 rename_in_infos(OInfo,Renamings,NInfo),
2281 ? rename_bt2(Old,Renamings,New).
2282 rename_bt2(identifier(Old),Renamings,identifier(New)) :-
2283 !, rename_id(Old,Renamings,New).
2284 rename_bt2(lazy_lookup_expr(Old),Renamings,lazy_lookup_expr(New)) :-
2285 !, rename_id(Old,Renamings,New).
2286 rename_bt2(lazy_lookup_pred(Old),Renamings,lazy_lookup_pred(New)) :-
2287 !, rename_id(Old,Renamings,New).
2288 rename_bt2(OExpr,Renamings,NExpr) :-
2289 ? syntaxtransformation_for_renaming(OExpr,Subs,TNames,NSubs,NExpr),
2290 get_texpr_exprs(TNames,Names),
2291 remove_renamings(Names,Renamings,NRenamings),
2292 ? rename_bt_l(Subs,NRenamings,NSubs).
2293 rename_bt_l([],_,[]).
2294 rename_bt_l([Old|ORest],Renamings,[New|NRest]) :-
2295 ? rename_bt(Old,Renamings,New),
2296 ? rename_bt_l(ORest,Renamings,NRest).
2297
2298 % syntaxtransformation rule for operation_call_in_expr does not show Id field in sub expressions
2299 % (to avoid issues with find_identifier_uses, see below)
2300 % so here we explicitly also rename the operation name if required, relevant for bmachine_construction, test 2504
2301 % TODO: avoid this special case and fix find_identifier_uses instead
2302 syntaxtransformation_for_renaming(operation_call_in_expr(ID,Subs1),Subs,TNames,NSubs,NExpr) :- !,
2303 NExpr = operation_call_in_expr(NID,NSubs1),
2304 Subs = [ID|Subs1],
2305 NSubs = [NID|NSubs1], TNames = [].
2306 syntaxtransformation_for_renaming(OExpr,Subs,TNames,NSubs,NExpr) :-
2307 ? syntaxtransformation(OExpr,Subs,TNames,NSubs,NExpr).
2308
2309 remove_renamings([],Renamings,Renamings).
2310 remove_renamings([identifier(Name)|Rest],Old,New) :-
2311 ? ( select(rename(Name,_),Old,Inter1) -> true % Name no longer visible to renaming
2312 ; Old = Inter1),
2313 (member(rename(_OldName,Name),Inter1) ->
2314 gensym('__FRESH__',FRESHID),
2315 %print(variable_capture_in_rename(Name,from(OldName),FRESHID)),nl,
2316 Inter2 = [rename(Name,FRESHID)|Inter1]
2317 ; Inter2 = Inter1),
2318 remove_renamings(Rest,Inter2,New).
2319
2320 rename_in_infos(Old,Renamings,New) :-
2321 ( has_info_to_rename(Old) ->
2322 maplist(rename_in_infos2(Renamings),Old,New)
2323 ;
2324 Old = New).
2325 rename_in_infos2(Renamings,OInfo,NInfo) :-
2326 ( infos_to_rename(OInfo,OIds,SortedNIds,NInfo) ->
2327 rename_ids(OIds,Renamings,NIds),
2328 sort(NIds,SortedNIds)
2329 ;
2330 OInfo = NInfo).
2331
2332 rename_ids([],_,[]).
2333 rename_ids([OId|Orest],Renamings,[NId|Nrest]) :-
2334 rename_id(OId,Renamings,NId),
2335 rename_ids(Orest,Renamings,Nrest).
2336 rename_id(Old,Renamings,New) :-
2337 ( memberchk(rename(Old,New),Renamings) -> true % we could use ord_member if we sort !
2338 ; Old=New).
2339
2340 has_info_to_rename(Infos) :-
2341 ? member(I,Infos),infos_to_rename(I,_,_,_),!.
2342
2343 infos_to_rename(modifies(O),O,N,modifies(N)).
2344 infos_to_rename(reads(O),O,N,reads(N)).
2345 infos_to_rename(non_det_modifies(O),O,N,non_det_modifies(N)).
2346 infos_to_rename(modifies_locals(O),O,N,modifies_locals(N)).
2347 infos_to_rename(reads_locals(O),O,N,reads_locals(N)).
2348 infos_to_rename(used_ids(O),O,N,used_ids(N)).
2349 %infos_to_rename(lambda_result(O),[O],[N],lambda_result(N)). % whould we no longer assume that we have lambda result, as predicate has possibly changed!?
2350
2351
2352 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2353 % remove type information for transformations
2354
2355 remove_bt(b(Expr,Type,Infos),Expr,NExpr,b(NExpr,Type,Infos)).
2356
2357 remove_bt_and_used_ids(b(OldExpr,T,Infos),OldExpr,NewExpr,b(NewExpr,T,NewInfos)) :-
2358 delete(Infos,used_ids(_),NewInfos). % invalidate used_ids info
2359
2360 %remove_bt_l([],[],[],[]).
2361 %remove_bt_l([OT|OTRest],[O|ORest],[N|NRest],[NT|NTRest]) :-
2362 % remove_bt(OT,O,N,NT),
2363 % remove_bt_l(OTRest,ORest,NRest,NTRest).
2364
2365 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2366 % traversations
2367 % Takes a predicate or expression or substitution and extracts:
2368 % the expression itself Expr, its type Type, the syntaxnode information Infos
2369 % + the subexpressions as a list Subs and the local identifiers declared
2370 syntaxtraversion(b(Expr,Type,Infos),Expr,Type,Infos,Subs,Names) :- !,
2371 safe_syntaxelement(Expr,Subs,Names,_,_).
2372 syntaxtraversion(IExpr,Expr,Type,Infos,Subs,Names) :-
2373 add_internal_error('Not properly wrapped', syntaxtraversion(IExpr,Expr,Type,Infos,Subs,Names)),
2374 fail.
2375
2376
2377 map_over_full_bexpr_no_fail(P,BExpr) :-
2378 syntaxtraversion(BExpr,Expr,_,_,Subs,_TNames),
2379 call(P,Expr), % the predicate should not fail
2380 (Subs=[] -> true ; maplist(map_over_full_bexpr_no_fail(P),Subs)).
2381
2382 map_over_bexpr(P,BExpr) :-
2383 syntaxtraversion(BExpr,Expr,_,_,Subs,_TNames),
2384 (call(P,Expr) % should probably fail so that by backtrack we recurse
2385 ;
2386 ? member(Sub,Subs), map_over_bexpr(P,Sub)
2387 ).
2388 % same as above but gets typed expressions:
2389 map_over_typed_bexpr(P,BExpr) :-
2390 syntaxtraversion(BExpr,_Expr,_,_,Subs,_TNames),
2391 (call(P,BExpr)
2392 ;
2393 ? member(Sub,Subs), map_over_typed_bexpr(P,Sub)
2394 ).
2395 % same as above but returns value:
2396 map_over_typed_bexpr(P,BExpr,Result) :-
2397 syntaxtraversion(BExpr,_Expr,_,_,Subs,_TNames),
2398 (call(P,BExpr,Result)
2399 ;
2400 ? member(Sub,Subs), map_over_typed_bexpr(P,Sub,Result)
2401 ).
2402 % this one gets TNames (locally introduced variables as parameter)
2403 map_over_typed_bexpr_with_names(P,BExpr) :-
2404 syntaxtraversion(BExpr,_Expr,_,_,Subs,TNames),
2405 (call(P,BExpr,TNames)
2406 ;
2407 member(Sub,Subs), map_over_typed_bexpr_with_names(P,Sub)
2408 ).
2409
2410 % same as map_over_expr but provides an accumulator passed top-down to children; needs to be used by failure driven loop
2411
2412 map_over_bexpr_top_down_acc(P,BExpr,TDAcc) :-
2413 syntaxtraversion(BExpr,Expr,_,_,Subs,_TNames),
2414 (call(P,Expr,TDAcc,NewAcc)
2415 -> member(Sub,Subs), map_over_bexpr_top_down_acc(P,Sub,NewAcc)
2416 ; member(Sub,Subs), map_over_bexpr_top_down_acc(P,Sub,TDAcc)
2417 ).
2418 % now a version which gets the typed predicate as argument
2419
2420 map_over_typed_bexpr_top_down_acc(P,BExpr,TDAcc) :-
2421 syntaxtraversion(BExpr,_Expr,_,_,Subs,_TNames),
2422 (call(P,BExpr,TDAcc,NewAcc)
2423 -> member(Sub,Subs), map_over_typed_bexpr_top_down_acc(P,Sub,NewAcc)
2424 ; member(Sub,Subs), map_over_typed_bexpr_top_down_acc(P,Sub,TDAcc)
2425 ).
2426
2427 % predicate P has 3 arguments: (Expr,ValueSoFar,NewValue)
2428 reduce_over_bexpr(P,BExpr,InitialValue,ResultValue) :-
2429 syntaxtraversion(BExpr,Expr,_,_,Subs,_TNames),
2430 call(P,Expr,InitialValue,I1), % print(reduce(P,Expr,InitialValue,I1)),nl,
2431 scanlist(reduce_over_bexpr(P),Subs,I1,ResultValue).
2432
2433 % apply a predicate over a syntax tree (bottom-up)
2434
2435 transform_bexpr(Pred,b(Expr,Type,Info),NewBExpr) :- !,
2436 ? syntaxtransformation(Expr,Subs,_Names,NSubs,NewExpr1),
2437 ? l_transform_bexpr(Subs,Pred,NSubs),
2438 (call(Pred,b(NewExpr1,Type,Info),NewBExpr) -> true ; NewBExpr = b(NewExpr1,Type,Info)).
2439 transform_bexpr(Pred,Expr,NewBExpr) :-
2440 add_internal_error('Expression not properly wrapped:',transform_bexpr(Pred,Expr,NewBExpr)),
2441 fail.
2442
2443 l_transform_bexpr([],_,[]).
2444 l_transform_bexpr([SubH|T],Pred,[TSubH|TT]) :-
2445 ? transform_bexpr(Pred,SubH,TSubH),
2446 ? l_transform_bexpr(T,Pred,TT).
2447
2448 % apply a predicate over a syntax tree (bottom-up), and provide scoping info about local ids
2449
2450 transform_bexpr_with_scoping(Pred,BExpr,NewBExpr) :-
2451 transform_bexpr_with_scoping2(Pred,BExpr,NewBExpr,[]).
2452 transform_bexpr_with_scoping2(Pred,b(Expr,Type,Info),NewBExpr,LocalIds) :-
2453 syntaxtransformation(Expr,Subs,Names,NSubs,NewExpr1),
2454 get_texpr_ids(Names,QuantifiedNewIds), list_to_ord_set(QuantifiedNewIds,SQuantifiedNewIds),
2455 ord_union(LocalIds,SQuantifiedNewIds,NewLocalIds),
2456 l_transform_bexpr_with_scoping(Subs,Pred,NSubs,NewLocalIds),
2457 (call(Pred,b(NewExpr1,Type,Info),NewBExpr,LocalIds) -> true ; NewBExpr = b(NewExpr1,Type,Info)).
2458
2459 l_transform_bexpr_with_scoping([],_,[],_).
2460 l_transform_bexpr_with_scoping([SubH|T],Pred,[TSubH|TT],LocalIds) :-
2461 transform_bexpr_with_scoping2(Pred,SubH,TSubH,LocalIds),
2462 l_transform_bexpr_with_scoping(T,Pred,TT,LocalIds).
2463
2464 % transform a predicate top-down with scoping infos
2465 % if Pred succeeds the top-down traversal stops
2466 transform_bexpr_td_with_scoping(Pred,BExpr,NewBExpr) :-
2467 ? transform_bexpr_td_with_scoping2(Pred,BExpr,NewBExpr,[]).
2468 transform_bexpr_td_with_scoping2(Pred,b(Expr,Type,Info),b(NewExpr1,Type,Info),LocalIds) :-
2469 ? (call(Pred,Expr,NewExpr1,LocalIds)
2470 -> true
2471 ? ; syntaxtransformation(Expr,Subs,Names,NSubs,NewExpr1),
2472 get_texpr_ids(Names,QuantifiedNewIds), list_to_ord_set(QuantifiedNewIds,SQuantifiedNewIds),
2473 ord_union(LocalIds,SQuantifiedNewIds,NewLocalIds),
2474 ? l_transform_bexpr_td_with_scoping(Subs,Pred,NSubs,NewLocalIds)
2475 ).
2476
2477 l_transform_bexpr_td_with_scoping([],_,[],_).
2478 l_transform_bexpr_td_with_scoping([SubH|T],Pred,[TSubH|TT],LocalIds) :-
2479 ? transform_bexpr_td_with_scoping2(Pred,SubH,TSubH,LocalIds),
2480 ? l_transform_bexpr_td_with_scoping(T,Pred,TT,LocalIds).
2481
2482
2483 % apply a predicate over a syntax tree (bottom-up) with Accumulator result
2484 % Accumulator is constructed bottom up; Pred receives *all* accumulators of sub expressions
2485
2486 transform_bexpr_with_bup_accs(Pred,b(Expr,Type,Info),NewBExpr,EmptyAcc,Acc) :-
2487 syntaxtransformation(Expr,Subs,_Names,NSubs,NewExpr1),
2488 l_transform_bexpr_with_bup_accs(Subs,Pred,NSubs,EmptyAcc,SubAccs),
2489 (call(Pred,b(NewExpr1,Type,Info),NewBExpr,SubAccs,Acc) -> true
2490 ; NewBExpr = b(NewExpr1,Type,Info), Acc = EmptyAcc).
2491
2492 l_transform_bexpr_with_bup_accs([],_,[],_,[]).
2493 l_transform_bexpr_with_bup_accs([SubH|T],Pred,[TSubH|TT],EmptyAcc,[Acc1|RestAcc]) :-
2494 transform_bexpr_with_bup_accs(Pred,SubH,TSubH,EmptyAcc,Acc1),
2495 l_transform_bexpr_with_bup_accs(T,Pred,TT,EmptyAcc,RestAcc).
2496
2497 % apply a predicate over a syntax tree (bottom-up) with Accumulator result
2498 % a single Accumulator is passed along
2499
2500 transform_bexpr_with_acc(_Pred,E,NewBExpr,InAcc,Acc) :- var(E),!,
2501 NewBExpr=E, Acc=InAcc.
2502 transform_bexpr_with_acc(Pred,b(Expr,Type,Info),NewBExpr,InAcc,Acc) :-
2503 syntaxtransformation(Expr,Subs,_Names,NSubs,NewExpr1),
2504 l_transform_bexpr_with_acc(Subs,Pred,NSubs,InAcc,SubAcc),
2505 (call(Pred,b(NewExpr1,Type,Info),NewBExpr,SubAcc,Acc) -> true
2506 ; NewBExpr = b(NewExpr1,Type,Info), Acc = SubAcc).
2507
2508 l_transform_bexpr_with_acc([],_,[],Acc,Acc).
2509 l_transform_bexpr_with_acc([SubH|T],Pred,[TSubH|TT],InAcc,ResAcc) :-
2510 transform_bexpr_with_acc(Pred,SubH,TSubH,InAcc,Acc1),
2511 l_transform_bexpr_with_acc(T,Pred,TT,Acc1,ResAcc).
2512
2513 % a non-deterministic version of this
2514 non_det_transform_bexpr_with_acc(_Pred,E,NewBExpr,InAcc,Acc) :- var(E),!,
2515 NewBExpr=E, Acc=InAcc.
2516 non_det_transform_bexpr_with_acc(Pred,b(Expr,Type,Info),NewBExpr,InAcc,Acc) :-
2517 syntaxtransformation(Expr,Subs,_Names,NSubs,NewExpr1),
2518 l_nd_transform_bexpr_with_acc(Subs,Pred,NSubs,InAcc,SubAcc),
2519 if(call(Pred,b(NewExpr1,Type,Info),NewBExpr,SubAcc,Acc),
2520 true,
2521 (NewBExpr = b(NewExpr1,Type,Info), Acc = SubAcc)).
2522
2523 l_nd_transform_bexpr_with_acc([],_,[],Acc,Acc).
2524 l_nd_transform_bexpr_with_acc([SubH|T],Pred,[TSubH|TT],InAcc,ResAcc) :-
2525 non_det_transform_bexpr_with_acc(Pred,SubH,TSubH,InAcc,Acc1),
2526 l_nd_transform_bexpr_with_acc(T,Pred,TT,Acc1,ResAcc).
2527
2528
2529 % -------------------------
2530
2531 min_max_integer_value_used(BExpr,Min,Max) :-
2532 min_max_integer_value_used(BExpr,none,none,Min,Max).
2533 min_max_integer_value_used(BExpr,IMin,IMax,Min,Max) :-
2534 reduce_over_bexpr(min_max_aux,BExpr,minmax(IMin,IMax),minmax(Min,Max)).
2535
2536 min_max_aux(sequence_extension(L),minmax(Min,Max),minmax(NMin,NMax)) :- !,
2537 length(L,Len), % we use implicitly numbers from 1..Len
2538 (number(Min),1>Min -> NMin=Min ; NMin=1),
2539 (number(Max),Len<Max -> NMax=Max ; NMax=Len).
2540 min_max_aux(integer(N),minmax(Min,Max),minmax(NMin,NMax)) :- !,
2541 (number(Min),N>Min -> NMin=Min ; NMin=N),
2542 (number(Max),N<Max -> NMax=Max ; NMax=N).
2543 min_max_aux(_,V,V).
2544
2545 % check if a B expression uses something like NAT,NAT1,INT, MAXINT or MININT.
2546 uses_implementable_integers(BExpr) :-
2547 map_over_bexpr(uses_implementable_integers_aux,BExpr).
2548
2549 uses_implementable_integers_aux(maxint).
2550 uses_implementable_integers_aux(minint).
2551 uses_implementable_integers_aux(integer_set(X)) :-
2552 (X='NAT1' ; X='NAT' ; X='INT').
2553
2554 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2555 % some checks
2556 check_if_typed_predicate(b(Pred,X,_)) :- ground(X), X=pred, % at runtime there can be value(X) with variables inside !
2557 syntaxelement(Pred,_,_,_,_,TypePred), (TypePred=pred -> true ; TypePred = pred/only_typecheck).
2558 check_if_typed_expression(b(Expr,Type,_)) :-
2559 syntaxelement(Expr,_,_,_,_,TypeExpr),
2560 (TypeExpr=expr -> true ; TypeExpr = expr/only_typecheck),
2561 Type \== pred, Type \== subst, ground(Type).
2562 check_if_typed_substitution(b(Subst,X,_)) :- ground(X), X=subst,
2563 syntaxelement(Subst,_,_,_,_,subst).
2564
2565 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2566 % transformations
2567
2568 syntaxtransformation(Expr,Subs,Names,NSubs,NExpr) :-
2569 functor(Expr,F,Arity),
2570 functor(NExpr,F,Arity),
2571 safe_syntaxelement(Expr,Subs,Names,Lists,Constant),
2572 all_same_length(Lists,NLists),
2573 ? syntaxelement(NExpr,NSubs,_,NLists,Constant,_).
2574 % a faster non-backtracking version:
2575 syntaxtransformation_det(Expr,Subs,Names,NSubs,NExpr) :-
2576 functor(Expr,F,Arity),
2577 functor(NExpr,F,Arity),
2578 safe_syntaxelement_det(Expr,Subs,Names,Lists,Constant),
2579 all_same_length(Lists,NLists),
2580 ? syntaxelement(NExpr,NSubs,_,NLists,Constant,_).
2581
2582
2583 safe_syntaxelement(Expr,Subs,Names,Lists,Constant) :-
2584 ( syntaxelement(Expr,SubsX,NamesX,Lists,ConstantX,_) ->
2585 Subs=SubsX, Names=NamesX, Constant=ConstantX
2586 %(Subs,Names,Constant)=(SubsX,NamesX,ConstantX)
2587 ;
2588 functor(Expr,F,Arity),
2589 add_error_fail(bsyntaxtree,'Uncovered syntax element: ', F/Arity)
2590 ).
2591 % a faster non-backtracking version of safe_syntaxelement, assuming Subs, Names, ... are fresh vars
2592 safe_syntaxelement_det(Expr,Subs,Names,Lists,Constant) :-
2593 (syntaxelement(Expr,Subs,Names,Lists,Constant,_) -> true
2594 ; functor(Expr,F,Arity),
2595 add_error_fail(bsyntaxtree,'Uncovered syntax element: ', F/Arity)).
2596
2597 is_subst_syntaxelement(Subst) :-
2598 syntaxelement(Subst,_,_,_,_,subst).
2599
2600 % check if we have a syntax node without parameters
2601 is_syntax_constant(Expr) :- atom(Expr), syntaxelement(Expr,_,_,_,_,_).
2602
2603 % syntaxelement(Expr,SubExprs,Identifiers,Lists,Constant,Type):
2604 % Expr: the expression itself
2605 % SubExprs: a list of sub-expressions
2606 % Identifiers: a list of identifiers that are newly introduced (e.g. by a quantifier)
2607 % Lists: A list of lists in the expression, to prevent infinite loops when having variable parts
2608 % Constant: A part of the expression that is not a sub-expression (e.g. the number in integer(...))
2609 % Type: Fundamental type of the element (predicate, expression, etc)
2610
2611 % predicates
2612 syntaxelement(truth, [], [], [], [], pred).
2613 syntaxelement(falsity, [], [], [], [], pred).
2614 syntaxelement(unknown_truth_value(Msg),[], [], [], Msg, pred). % artificial, e.g., created by well_def_analyser
2615 syntaxelement(conjunct(A,B), [A,B],[], [], [], pred).
2616 %syntaxelement(conjunct(As), As, [], [], [], pred). % TO DO: support associative version of conjunct
2617 syntaxelement(negation(A), [A], [], [], [], pred).
2618 syntaxelement(disjunct(A,B), [A,B],[], [], [], pred).
2619 syntaxelement(implication(A,B), [A,B],[], [], [], pred).
2620 syntaxelement(equivalence(A,B), [A,B],[], [], [], pred).
2621 syntaxelement(equal(A,B), [A,B],[], [], [], pred).
2622 syntaxelement(not_equal(A,B), [A,B],[], [], [], pred).
2623 syntaxelement(member(A,B), [A,B],[], [], [], pred).
2624 syntaxelement(not_member(A,B), [A,B],[], [], [], pred).
2625 syntaxelement(subset(A,B), [A,B],[], [], [], pred).
2626 syntaxelement(subset_strict(A,B), [A,B],[], [], [], pred).
2627 syntaxelement(not_subset(A,B), [A,B],[], [], [], pred).
2628 syntaxelement(not_subset_strict(A,B),[A,B],[], [], [], pred).
2629 syntaxelement(less_equal(A,B), [A,B],[], [], [], pred).
2630 syntaxelement(less(A,B), [A,B],[], [], [], pred).
2631 syntaxelement(less_equal_real(A,B), [A,B],[], [], [], pred).
2632 syntaxelement(less_real(A,B), [A,B],[], [], [], pred).
2633 syntaxelement(greater_equal(A,B), [A,B],[], [], [], pred).
2634 syntaxelement(greater(A,B), [A,B],[], [], [], pred).
2635 syntaxelement(forall(Ids,D,P), [D,P|Ids],Ids,[Ids], [], pred).
2636 syntaxelement(exists(Ids,P), [P|Ids], Ids,[Ids], [], pred).
2637 syntaxelement(finite(A), [A], [], [], [], pred/only_typecheck).
2638 syntaxelement(partition(S,Es), [S|Es],[],[Es],[],pred).
2639 syntaxelement(kodkod(PId,Ids), Ids,[],[Ids],PId, pred).
2640 syntaxelement(external_pred_call(F,Args),Args,[],[Args],F,pred).
2641
2642 % expressions
2643 syntaxelement(value(V), [], [], [], V, expr).
2644 syntaxelement(operation_call_in_expr(Id,As), As, [], [As], Id, expr). % Do not treat Id as a sub-expression for find_identifier_uses, ...
2645 %syntaxelement(operation_call_in_expr(Id,As), [Id|As], [], [As], [], expr). % was like this, but changed to avoid op(.) ids in find_identifier_uses
2646 syntaxelement(boolean_true, [], [], [], [], expr).
2647 syntaxelement(boolean_false, [], [], [], [], expr).
2648 syntaxelement(max_int, [], [], [], [], expr).
2649 syntaxelement(min_int, [], [], [], [], expr).
2650 syntaxelement(empty_set, [], [], [], [], expr).
2651 syntaxelement(bool_set, [], [], [], [], expr).
2652 syntaxelement(float_set, [], [], [], [], expr).
2653 syntaxelement(real(I), [], [], [], I, expr).
2654 syntaxelement(real_set, [], [], [], [], expr).
2655 syntaxelement(string_set, [], [], [], [], expr).
2656 syntaxelement(convert_bool(A), [A], [], [], [], expr).
2657 syntaxelement(convert_real(A), [A], [], [], [], expr).
2658 syntaxelement(convert_int_floor(A), [A], [], [], [], expr).
2659 syntaxelement(convert_int_ceiling(A), [A], [], [], [], expr).
2660 syntaxelement(add(A,B), [A,B],[], [], [], expr).
2661 syntaxelement(add_real(A,B), [A,B],[], [], [], expr).
2662 syntaxelement(minus(A,B), [A,B],[], [], [], expr).
2663 syntaxelement(minus_real(A,B), [A,B],[], [], [], expr).
2664 syntaxelement(minus_or_set_subtract(A,B),[A,B],[], [], [], expr/only_typecheck).
2665 syntaxelement(unary_minus(A), [A], [], [], [], expr).
2666 syntaxelement(unary_minus_real(A), [A], [], [], [], expr).
2667 syntaxelement(multiplication(A,B), [A,B],[], [], [], expr).
2668 syntaxelement(multiplication_real(A,B),[A,B],[], [], [], expr).
2669 syntaxelement(mult_or_cart(A,B), [A,B],[], [], [], expr/only_typecheck).
2670 syntaxelement(cartesian_product(A,B), [A,B],[], [], [], expr).
2671 syntaxelement(div(A,B), [A,B],[], [], [], expr).
2672 syntaxelement(div_real(A,B), [A,B],[], [], [], expr).
2673 syntaxelement(floored_div(A,B), [A,B],[], [], [], expr).
2674 syntaxelement(modulo(A,B), [A,B],[], [], [], expr).
2675 syntaxelement(power_of(A,B), [A,B],[], [], [], expr).
2676 syntaxelement(power_of_real(A,B), [A,B],[], [], [], expr).
2677 syntaxelement(successor, [], [], [], [], expr).
2678 syntaxelement(predecessor, [], [], [], [], expr).
2679 syntaxelement(max(A), [A], [], [], [], expr).
2680 syntaxelement(max_real(A), [A], [], [], [], expr).
2681 syntaxelement(min(A), [A], [], [], [], expr).
2682 syntaxelement(min_real(A), [A], [], [], [], expr).
2683 syntaxelement(card(A), [A], [], [], [], expr).
2684 syntaxelement(couple(A,B), [A,B],[], [], [], expr).
2685 syntaxelement(pow_subset(A), [A], [], [], [], expr).
2686 syntaxelement(pow1_subset(A), [A], [], [], [], expr).
2687 syntaxelement(fin_subset(A), [A], [], [], [], expr).
2688 syntaxelement(fin1_subset(A), [A], [], [], [], expr).
2689 syntaxelement(interval(A,B), [A,B],[], [], [], expr).
2690 syntaxelement(union(A,B), [A,B],[], [], [], expr).
2691 syntaxelement(intersection(A,B), [A,B],[], [], [], expr).
2692 syntaxelement(set_subtraction(A,B), [A,B],[], [], [], expr).
2693 syntaxelement(general_union(A), [A], [], [], [], expr).
2694 syntaxelement(general_intersection(A), [A] , [], [], [], expr).
2695 syntaxelement(relations(A,B), [A,B],[], [], [], expr).
2696 syntaxelement(identity(A), [A], [], [], [], expr).
2697 syntaxelement(event_b_identity, [], [], [], [], expr). % for Rodin 1.0, TO DO: Daniel please check
2698 syntaxelement(reverse(A), [A], [], [], [], expr).
2699 syntaxelement(first_projection(A,B), [A,B],[], [], [], expr/only_typecheck).
2700 syntaxelement(first_of_pair(A), [A], [], [], [], expr).
2701 syntaxelement(event_b_first_projection(A),[A], [], [], [], expr/only_typecheck).
2702 syntaxelement(event_b_first_projection_v2,[], [], [], [], expr/only_typecheck). % for Rodin 1.0, TO DO: Daniel please check
2703 syntaxelement(second_projection(A,B), [A,B],[], [], [], expr/only_typecheck).
2704 syntaxelement(event_b_second_projection_v2,[], [], [], [], expr/only_typecheck). % for Rodin 1.0, TO DO: Daniel please check
2705 syntaxelement(second_of_pair(A), [A], [], [], [], expr).
2706 syntaxelement(event_b_second_projection(A),[A], [], [], [], expr/only_typecheck).
2707 syntaxelement(composition(A,B), [A,B],[], [], [], expr).
2708 syntaxelement(ring(A,B), [A,B],[], [], [], expr/only_typecheck).
2709 syntaxelement(direct_product(A,B), [A,B],[], [], [], expr).
2710 syntaxelement(parallel_product(A,B), [A,B],[], [], [], expr).
2711 syntaxelement(trans_function(A), [A], [], [], [], expr).
2712 syntaxelement(trans_relation(A), [A], [], [], [], expr).
2713 syntaxelement(iteration(A,B), [A,B],[], [], [], expr).
2714 syntaxelement(reflexive_closure(A), [A], [], [], [], expr).
2715 syntaxelement(closure(A), [A], [], [], [], expr).
2716 syntaxelement(domain(A), [A], [], [], [], expr).
2717 syntaxelement(range(A), [A], [], [], [], expr).
2718 syntaxelement(image(A,B), [A,B],[], [], [], expr).
2719 syntaxelement(domain_restriction(A,B), [A,B],[], [], [], expr).
2720 syntaxelement(domain_subtraction(A,B), [A,B],[], [], [], expr).
2721 syntaxelement(range_restriction(A,B), [A,B],[], [], [], expr).
2722 syntaxelement(range_subtraction(A,B), [A,B],[], [], [], expr).
2723 syntaxelement(overwrite(A,B), [A,B],[], [], [], expr).
2724 syntaxelement(partial_function(A,B), [A,B],[], [], [], expr).
2725 syntaxelement(total_function(A,B), [A,B],[], [], [], expr).
2726 syntaxelement(partial_injection(A,B), [A,B],[], [], [], expr).
2727 syntaxelement(total_injection(A,B), [A,B],[], [], [], expr).
2728 syntaxelement(partial_surjection(A,B), [A,B],[], [], [], expr).
2729 syntaxelement(total_surjection(A,B), [A,B],[], [], [], expr).
2730 syntaxelement(total_bijection(A,B), [A,B],[], [], [], expr).
2731 syntaxelement(partial_bijection(A,B), [A,B],[], [], [], expr).
2732 syntaxelement(total_relation(A,B), [A,B],[], [], [], expr).
2733 syntaxelement(surjection_relation(A,B),[A,B],[], [], [], expr).
2734 syntaxelement(total_surjection_relation(A,B),[A,B],[], [], [], expr).
2735 syntaxelement(seq(A), [A], [], [], [], expr).
2736 syntaxelement(seq1(A), [A], [], [], [], expr).
2737 syntaxelement(iseq(A), [A], [], [], [], expr).
2738 syntaxelement(iseq1(A), [A], [], [], [], expr).
2739 syntaxelement(perm(A), [A], [], [], [], expr).
2740 syntaxelement(empty_sequence, [], [], [], [], expr).
2741 syntaxelement(size(A), [A], [], [], [], expr).
2742 syntaxelement(first(A), [A], [], [], [], expr).
2743 syntaxelement(last(A), [A], [], [], [], expr).
2744 syntaxelement(front(A), [A], [], [], [], expr).
2745 syntaxelement(tail(A), [A], [], [], [], expr).
2746 syntaxelement(rev(A), [A], [], [], [], expr).
2747 syntaxelement(concat(A,B), [A,B],[], [], [], expr).
2748 syntaxelement(insert_front(A,B), [A,B],[], [], [], expr).
2749 syntaxelement(insert_tail(A,B), [A,B],[], [], [], expr).
2750 syntaxelement(restrict_front(A,B), [A,B],[], [], [], expr).
2751 syntaxelement(restrict_tail(A,B), [A,B],[], [], [], expr).
2752 syntaxelement(general_concat(A), [A], [], [], [], expr).
2753 syntaxelement(function(A,B), [A,B],[], [], [], expr).
2754 syntaxelement(external_function_call(F,Args),Args,[],[Args],F,expr).
2755 syntaxelement(identifier(I), [], [], [], I, expr).
2756 syntaxelement(lazy_lookup_expr(I), [], [], [], I, expr).
2757 syntaxelement(lazy_lookup_pred(I), [], [], [], I, pred).
2758 syntaxelement(integer(I), [], [], [], I, expr).
2759 syntaxelement(integer_set(T), [], [], [], T, expr).
2760 syntaxelement(string(S), [], [], [], S, expr).
2761 syntaxelement(set_extension(L), L, [], [L], [], expr).
2762 syntaxelement(sequence_extension(L), L, [], [L], [], expr).
2763 syntaxelement(comprehension_set(Ids,P),[P|Ids], Ids,[Ids], [], expr).
2764 syntaxelement(event_b_comprehension_set(Ids,E,P),[E,P|Ids], Ids,[Ids], [], expr/only_typecheck).
2765 syntaxelement(lambda(Ids,P,E), [P,E|Ids],Ids,[Ids], [], expr).
2766 syntaxelement(general_sum(Ids,P,E), [P,E|Ids],Ids,[Ids], [], expr).
2767 syntaxelement(general_product(Ids,P,E), [P,E|Ids],Ids,[Ids], [], expr).
2768 syntaxelement(quantified_union(Ids,P,E), [P,E|Ids],Ids,[Ids], [], expr).
2769 syntaxelement(quantified_intersection(Ids,P,E), [P,E|Ids],Ids,[Ids], [], expr).
2770 syntaxelement(struct(Rec), [Rec], [], [], [], expr).
2771 ?syntaxelement(rec(Fields), FContent, [], [FContent], FNames, expr) :- syntaxfields(Fields,FContent, FNames).
2772 syntaxelement(record_field(R,I), [R], [], [], I, expr).
2773 syntaxelement(assertion_expression(Cond,ErrMsg,Expr), [Cond,Expr], [], [], ErrMsg, expr).
2774 syntaxelement(typeset, [], [], [], [], expr/only_typecheck).
2775
2776 syntaxelement(tree(A), [A], [], [], [], expr).
2777 syntaxelement(btree(A), [A], [], [], [], expr).
2778 syntaxelement(const(A,B), [A,B],[], [], [], expr).
2779 syntaxelement(top(A), [A], [], [], [], expr).
2780 syntaxelement(sons(A), [A], [], [], [], expr).
2781 syntaxelement(prefix(A), [A], [], [], [], expr).
2782 syntaxelement(postfix(A), [A], [], [], [], expr).
2783 syntaxelement(sizet(A), [A], [], [], [], expr).
2784 syntaxelement(mirror(A), [A], [], [], [], expr).
2785 syntaxelement(rank(A,B), [A,B],[], [], [], expr).
2786 syntaxelement(father(A,B), [A,B],[], [], [], expr).
2787 syntaxelement(son(A,B,C), [A,B,C],[], [], [], expr).
2788 syntaxelement(subtree(A,B), [A,B],[], [], [], expr).
2789 syntaxelement(arity(A,B), [A,B],[], [], [], expr).
2790 syntaxelement(bin(A), [A],[], [], [], expr).
2791 syntaxelement(bin(A,B,C), [A,B,C],[], [], [], expr).
2792 syntaxelement(infix(A), [A], [], [], [], expr).
2793 syntaxelement(left(A), [A], [], [], [], expr).
2794 syntaxelement(right(A), [A], [], [], [], expr).
2795
2796 % substitutions
2797 syntaxelement(skip, [], [], [], [], subst).
2798 syntaxelement(precondition(A,B), [A,B],[], [], [], subst).
2799 syntaxelement(assertion(A,B), [A,B],[], [], [], subst).
2800 syntaxelement(witness_then(A,B), [A,B],[], [], [], subst).
2801 syntaxelement(if_elsif(A,B), [A,B],[], [], [], subst/elsif).
2802 syntaxelement(while(A,B,C,D), [A,B,C,D],[], [], [], subst).
2803 % used only internally in the interpreter, contains last value of variant:
2804 syntaxelement(while1(A,B,C,D,E), [A,B,C,D],[], [], E, subst).
2805 syntaxelement(select_when(A,B), [A,B],[], [], [], subst/when).
2806 syntaxelement(block(S),[S],[],[],[], subst/only_typecheck).
2807 syntaxelement(assign(Lhs,Rhs),Exprs,[],[Lhs,Rhs], [], subst) :- append(Lhs,Rhs,Exprs).
2808 syntaxelement(assign_single_id(Id,Rhs),[Id,Rhs],[],[], [], subst).
2809 syntaxelement(any(Ids,P,S),[P,S|Ids],Ids,[Ids], [], subst).
2810 syntaxelement(var(Ids,S), [S|Ids], Ids,[Ids], [], subst).
2811 syntaxelement(if(Ifs), Ifs, [], [Ifs], [], subst).
2812 syntaxelement(parallel(Ss), Ss, [], [Ss], [], subst).
2813 syntaxelement(sequence(Ss), Ss, [], [Ss], [], subst).
2814 syntaxelement(becomes_element_of(Ids,E), [E|Ids], [], [Ids], [], subst).
2815 syntaxelement(becomes_such(Ids,P), [P|Ids], [], [Ids], [], subst). % Ids are new value, Ids$0 is old value
2816 syntaxelement(evb2_becomes_such(Ids,P), [P|Ids], [], [Ids], [], subst/only_typecheck).
2817 syntaxelement(let(Ids,P,S), [P,S|Ids], Ids, [Ids], [], subst).
2818 syntaxelement(operation_call(Id,Rs,As), [Id|Exprs], [], [Rs,As], [], subst) :- append(Rs,As,Exprs).
2819 syntaxelement(case(E,Eithers,Else), [E,Else|Eithers], [], [Eithers], [], subst).
2820 syntaxelement(case_or(Es,S), [S|Es], [], [Es], [], subst/caseor).
2821 syntaxelement(choice(Ss), Ss, [], [Ss], [], subst).
2822 syntaxelement(select(Whens), Whens, [], [Whens], [], subst).
2823 syntaxelement(select(Whens,Else), [Else|Whens], [], [Whens], [], subst).
2824 syntaxelement(operation(I,Rs,As,B), [I,B|Ids], Ids, [Rs,As], [], subst) :- append(Rs,As,Ids).
2825 syntaxelement(external_subst_call(F,Args),Args,[],[Args],F,subst).
2826
2827 % elements of a VALUES clause
2828 syntaxelement(values_entry(I,E),[I,E],[],[],[],values_entry).
2829
2830 % syntax for Event-B events
2831 syntaxelement(rlevent(I,Sec,St,Ps,G,Ts,As,VWs,PWs,Ums,Rs), Subs, [], [Ps,Ts,As,VWs,PWs,Ums,Rs], [I,Sec], subst) :-
2832 append([[St],Ps,[G],Ts,As,VWs,PWs,Ums,Rs],Subs).
2833 syntaxelement(witness(I,P), [I,P], [], [], [], witness).
2834
2835 % extended syntax for Z
2836 syntaxelement(let_predicate(Ids,As,Pred), Exprs, Ids, [Ids,As], [], pred) :- append([Ids,As,[Pred]],Exprs).
2837 syntaxelement(let_expression(Ids,As,Expr), Exprs, Ids, [Ids,As], [], expr) :- append([Ids,As,[Expr]],Exprs).
2838 syntaxelement(let_expression_global(Ids,As,Expr), Exprs, Ids, [Ids,As], [], expr) :- % version used by b_compiler
2839 append([Ids,As,[Expr]],Exprs).
2840 syntaxelement(lazy_let_expr(TID,A,Expr), [TID, A, Expr], [TID], [[TID],[A]], [], expr).
2841 syntaxelement(lazy_let_pred(TID,A,Expr), [TID, A, Expr], [TID], [[TID],[A]], [], pred).
2842 syntaxelement(lazy_let_subst(TID,A,Expr), [TID, A, Expr], [TID], [[TID],[A]], [], subst).
2843 syntaxelement(if_then_else(If,Then,Else),[If,Then,Else], [], [], [], expr).
2844 syntaxelement(compaction(A), [A], [], [], [], expr).
2845 syntaxelement(mu(A), [A], [], [], [], expr).
2846 syntaxelement(bag_items(A), [A], [], [], [], expr).
2847
2848 syntaxelement(freetype_set(Id), [], [], [], Id, expr).
2849 syntaxelement(freetype_case(Type,Case,Expr), [Expr], [], [], [Type,Case], pred).
2850 syntaxelement(freetype_constructor(Type,Case,Expr), [Expr], [], [], [Type,Case], expr).
2851 syntaxelement(freetype_destructor(Type,Case,Expr), [Expr], [], [], [Type,Case], expr).
2852
2853 syntaxelement(ordinary, [], [], [], [], status).
2854 syntaxelement(anticipated(Variant), [Variant], [], [], [], status).
2855 syntaxelement(convergent(Variant), [Variant], [], [], [], status).
2856
2857 % Just one ID expected
2858 syntaxelement(recursive_let(Id,C),[Id,C],[Id],[],[], expr). % Note: Id is not really introduced !
2859
2860
2861 % fields of records
2862 %syntaxfields(Fields,C,_) :- var(Fields),var(C),var(N),!, add_internal_error('Illegal call: ',syntaxfields(Fields,C,N)),fail.
2863 syntaxfields([],[],[]).
2864 ?syntaxfields([field(N,C)|Rest],[C|CRest],[N|NRest]) :- syntaxfields(Rest,CRest,NRest).
2865
2866 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2867 % helper for declaration of quantified identifiers
2868
2869 % has_declared_identifier/2 returns a list of identifiers which are declared in
2870 % this AST node. The main difference to the Names variable when doing a
2871 % syntaxtraversion/6 or similiar is that the identifiers are described by
2872 % predicates.
2873 has_declared_identifier(TExpr,Ids) :-
2874 get_texpr_expr(TExpr,Expr),
2875 ( default_declaration(Expr,_,Ids,_)
2876 ; non_default_declaration(Expr,Ids)).
2877
2878 add_declaration_for_identifier(b(Expr,Type,Infos),Decl,b(NExpr,Type,NewInfos)) :-
2879 %delete(Infos,used_ids(_),NewInfos), % we cannot
2880 ( default_declaration(Expr,Predicate,Ids,Constant) ->
2881 same_functor(Expr,NExpr),
2882 conjunct_predicates([Decl,Predicate],NPredicate),
2883 default_declaration(NExpr,NPredicate,Ids,Constant)
2884 ; non_default_declaration(Expr,Ids) ->
2885 add_non_default_declaration(Expr,Decl,NExpr)
2886 ),
2887 add_used_ids(Infos,Ids,Decl,NewInfos).
2888
2889 % add used ids of a predicate within quantification of Ids to current used_ids info; if it is there
2890 add_used_ids(Infos,Ids,Pred,NewInfos) :- update_used_ids(Infos,OldUsed,NewInfos,NewUsed),
2891 !, % a field needs updating
2892 find_identifier_uses(Pred,[],NewIds), get_texpr_ids(Ids,UnsortedIds),sort(UnsortedIds,SIds),
2893 ord_subtract(NewIds,SIds,NewIds2),
2894 ord_union(NewIds2,OldUsed,NewUsed).
2895 add_used_ids(I,_,_,I).
2896
2897 % just update used_ids field (e.g., when just computed to store it for later)
2898 update_used_ids(Infos,OldUsed,NewInfos,NewUsed) :- select(OldInfo,Infos,I1),
2899 used_ids_like_info(OldInfo,F,OldUsed),!,
2900 used_ids_like_info(NewInfo,F,NewUsed),NewInfos = [NewInfo|I1].
2901
2902 % info fields which contain used_ids information
2903 used_ids_like_info(used_ids(UsedIds),used_ids,UsedIds).
2904 used_ids_like_info(reads(UsedIds),reads,UsedIds).
2905
2906 :- use_module(probsrc(btypechecker), [prime_identifiers/2]).
2907
2908 % default_declaration(Expr,Predicate,Ids,Constant)
2909 default_declaration(forall(Ids,D,P),D,Ids,P).
2910 default_declaration(exists(Ids,P),P,Ids,[]).
2911 default_declaration(comprehension_set(Ids,P),P,Ids,[]).
2912 default_declaration(event_b_comprehension_set(Ids,E,P),P,Ids,E). % translated !?
2913 default_declaration(lambda(Ids,P,E),P,Ids,E).
2914 default_declaration(general_sum(Ids,P,E),P,Ids,E).
2915 default_declaration(general_product(Ids,P,E),P,Ids,E).
2916 default_declaration(quantified_union(Ids,P,E),P,Ids,E).
2917 default_declaration(quantified_intersection(Ids,P,E),P,Ids,E).
2918 default_declaration(any(Ids,P,S),P,Ids,S).
2919 default_declaration(becomes_such(Ids,P),P,Ids,[]).
2920 default_declaration(evb2_becomes_such(Ids,P),P,Primed,[]) :-
2921 nl,print(evb2(Ids,Primed)),nl,nl, % no longer used, as it is translated to becomes_such
2922 prime_identifiers(Ids,Primed).
2923 default_declaration(rlevent(I,Sec,St,Ps,G,Ts,As,VWs,PWs,Ums,Rs),G,Ps,
2924 [I,Sec,St,Ps,Ts,As,VWs,PWs,Ums,Rs]).
2925 default_declaration(let_predicate(Ids,Ps,Body),Ps,Ids,Body) :- print(let(Ids)),nl. % TODO: check format of Ps
2926 default_declaration(let_expression(Ids,Ps,Body),Ps,Ids,Body) :- print(let(Ids)),nl. % TODO: check format of Ps
2927 default_declaration(let_expression_global(Ids,Ps,Body),Ps,Ids,Body) :- print(let(Ids)),nl. % TODO: check format of Ps
2928 % TODO: lazy let ?
2929
2930 non_default_declaration(operation(_I,Rs,As,_TBody),Ids) :-
2931 append(Rs,As,Ids).
2932
2933 add_non_default_declaration(operation(I,Rs,As,TBody),Decl,operation(I,Rs,As,NTBody)) :-
2934 ( get_guard_and_copy(TBody,P,NP,NTBody) ->
2935 conjunct_predicates([Decl,P],NP)
2936 ; create_texpr(precondition(Decl,TBody),subst,[],NTBody)).
2937
2938 get_guard_and_copy(TBody,P,NP,NTBody) :- remove_bt(TBody,Body,NBody,NTBody),
2939 get_guard_copy2(Body,P,NP,NBody).
2940
2941 get_guard_copy2(precondition(P,S),P,NP,precondition(NP,S)).
2942 get_guard_copy2(rlevent(I,Sec,St,Ps, G,Ts,As,VWs,PWs,Ums,Rs), G, NG,
2943 rlevent(I,Sec,St,Ps,NG,Ts,As,VWs,PWs,Ums,Rs)).
2944
2945 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2946 % pattern definitions (not yet finished)
2947
2948 bsyntax_pattern(Expr,TExpr) :-
2949 var(Expr),!,Expr=TExpr.
2950 bsyntax_pattern(-Expr,TExpr) :-
2951 !,remove_all_infos(Expr,TExpr).
2952 bsyntax_pattern(Expr,TExpr) :-
2953 functor(Expr,b,3),!,Expr=TExpr.
2954 bsyntax_pattern(Expr:Type/Info,TExpr) :-
2955 !,bsyntax_pattern2(Expr,Type,Info,TExpr).
2956 bsyntax_pattern(Expr:Type,TExpr) :-
2957 !,bsyntax_pattern2(Expr,Type,_Info,TExpr).
2958 bsyntax_pattern(Expr/Info,TExpr) :-
2959 !,bsyntax_pattern2(Expr,_Type,Info,TExpr).
2960 bsyntax_pattern(Expr,TExpr) :-
2961 !,bsyntax_pattern2(Expr,_Type,_Info,TExpr).
2962
2963 bsyntax_pattern2(Pattern,Type,Info,TExpr) :-
2964 functor(Pattern,Functor,Arity),
2965 functor(R,Functor,Arity),
2966 create_texpr(R,Type,Info,TExpr),
2967 syntaxelement(Pattern,PSubs,_,PLists,Const,EType),
2968 syntaxelement(R,RSubs,_,RLists,Const,EType),
2969 ( EType==pred -> Type=pred
2970 ; EType==subst -> Type=subst
2971 ; true),
2972 all_same_length(PLists,RLists),
2973 maplist(bsyntax_pattern,PSubs,RSubs).
2974
2975 all_same_length([],[]).
2976 all_same_length([A|Arest],[B|Brest]) :-
2977 ( var(A),var(B) ->
2978 add_error_fail(bsyntaxtree,'At least one list should contain nonvar elements for all_same_length',[A,B])
2979 ;
2980 same_length(A,B)),
2981 all_same_length(Arest,Brest).
2982
2983 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2984 % strip an AST into a more compact form (without b/3 terms)
2985
2986 strip_and_norm_ast(TExpr,SNExpr) :-
2987 get_texpr_expr(TExpr,Expr),
2988 strip_and_norm_ast_aux(Expr,SNExpr).
2989
2990 :- use_module(tools,[safe_univ_no_cutoff/2]).
2991 strip_and_norm_ast_aux(Expr,Res) :-
2992 comm_assoc_subs(Expr,Op,Subs,[]), !, % associative & commutative operator detected
2993 maplist(strip_and_norm_ast_aux,Subs,NSubs), % Subs are already unwrapped
2994 sort(NSubs,Sorted), % in case there are associative operators that are not commutative: insert is_commutative check
2995 safe_univ_no_cutoff(Res,[Op|Sorted]).
2996 strip_and_norm_ast_aux(Expr,Res) :-
2997 assoc_subs(Expr,Op,Subs,[]), !, % associative operator detected
2998 maplist(strip_and_norm_ast_aux,Subs,NSubs), % Subs are already unwrapped
2999 safe_univ_no_cutoff(Res,[Op|NSubs]).
3000 strip_and_norm_ast_aux(Expr,SNExpr) :-
3001 syntaxtransformation(Expr,Subs,_,NSubs,SExpr),
3002 strip_and_norm_ast_l(Subs,NSubs),
3003 norm_strip(SExpr,SNExpr).
3004
3005 strip_and_norm_ast_l([],[]).
3006 strip_and_norm_ast_l([TExpr|Trest],[NExpr|Nrest]) :-
3007 strip_and_norm_ast(TExpr,NExpr),
3008 strip_and_norm_ast_l(Trest,Nrest).
3009
3010 norm_strip(greater_equal(A,B),less_equal(B,A)) :- !.
3011 norm_strip(greater(A,B),less(B,A)) :- !.
3012 norm_strip(set_extension(NL),set_extension(SNL)) :- !,
3013 sort(NL,SNL).
3014 norm_strip(Old,New) :-
3015 functor(Old,Functor,2),
3016 is_commutative(Functor),!,
3017 arg(1,Old,OA),
3018 arg(2,Old,OB),
3019 ( OA @> OB -> New =.. [Functor,OB,OA]
3020 ; New=Old).
3021 norm_strip(Old,Old).
3022 % TO DO: flatten associative operators into lists !
3023
3024 comm_assoc_subs(conjunct(TA,TB),conjunct) --> !,
3025 {get_texpr_expr(TA,A), get_texpr_expr(TB,B)},
3026 comm_assoc_subs(A,conjunct), comm_assoc_subs(B,conjunct).
3027 comm_assoc_subs(disjunct(TA,TB),disjunct) --> !,
3028 {get_texpr_expr(TA,A), get_texpr_expr(TB,B)},
3029 comm_assoc_subs(A,disjunct), comm_assoc_subs(B,disjunct).
3030 comm_assoc_subs(add(TA,TB),add) --> !,
3031 {get_texpr_expr(TA,A), get_texpr_expr(TB,B)},
3032 comm_assoc_subs(A,add), comm_assoc_subs(B,add).
3033 comm_assoc_subs(multiplication(TA,TB),multiplication) --> !,
3034 {get_texpr_expr(TA,A), get_texpr_expr(TB,B)},
3035 comm_assoc_subs(A,multiplication), comm_assoc_subs(B,multiplication).
3036 comm_assoc_subs(union(TA,TB),union) --> !,
3037 {get_texpr_expr(TA,A), get_texpr_expr(TB,B)},
3038 comm_assoc_subs(A,union), comm_assoc_subs(B,union).
3039 comm_assoc_subs(intersection(TA,TB),intersection) --> !,
3040 {get_texpr_expr(TA,A), get_texpr_expr(TB,B)},
3041 comm_assoc_subs(A,intersection), comm_assoc_subs(B,intersection).
3042 comm_assoc_subs(Expr,Op) --> {nonvar(Op)},[Expr]. % base case for other operators
3043
3044 % detect just associative operators
3045 assoc_subs(concat(TA,TB),concat) --> !,
3046 {get_texpr_expr(TA,A), get_texpr_expr(TB,B)},
3047 assoc_subs(A,concat), assoc_subs(B,concat).
3048 assoc_subs(composition(TA,TB),composition) --> !,
3049 {get_texpr_expr(TA,A), get_texpr_expr(TB,B)},
3050 assoc_subs(A,composition), assoc_subs(B,composition).
3051 assoc_subs(Expr,Op) --> {nonvar(Op)},[Expr]. % base case for other operators
3052
3053 is_commutative(conjunct).
3054 is_commutative(disjunct).
3055 is_commutative(equivalence).
3056 is_commutative(equal).
3057 is_commutative(not_equal).
3058 is_commutative(add).
3059 is_commutative(multiplication).
3060 is_commutative(union).
3061 is_commutative(intersection).
3062
3063 % check if two type expressions are same modulo info fields and reordering of commutative operators
3064 % same_texpr does not reorder wrt commutativity.
3065 same_norm_texpr(TExpr1,TExpr2) :-
3066 strip_and_norm_ast(TExpr1,N1),
3067 strip_and_norm_ast(TExpr2,N1).
3068
3069
3070 % small utility to get functor of texpr:
3071 get_texpr_functor(b(E,_,_),F,N) :- !, functor(E,F,N).
3072 get_texpr_functor(E,_,+) :- add_error_fail(get_texpr_functor,'Not a typed expression: ',E).
3073
3074 % -------------------------
3075
3076 % check if a ProB type is a set type:
3077 is_set_type(set(Type),Type).
3078 is_set_type(seq(Type),couple(integer,Type)).
3079 % should we have a rule for any ?? : in all cases using is_set_type any seems not possible; better that we generate error message in get_set_type or get_texpr_set_type
3080 % is_set_type(any,any).
3081
3082 get_set_type(TypeX,Res) :-
3083 ? (is_set_type(TypeX,SetType) -> Res=SetType ; add_error_fail(get_set_type,'Not a set type: ',TypeX)).
3084
3085 get_texpr_set_type(X,Res) :- get_texpr_type(X,TypeX),
3086 get_set_type(TypeX,Res).
3087
3088
3089 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3090 % check if a set contains all elements of a type, i.e., maximal type
3091 is_just_type(Expr) :- is_just_type(Expr,[]).
3092 % is_just_type(+Expr,+RTT):
3093 % like is_just_type/1 but RTT is a list of identifiers (without type information)
3094 % of variables or constants that are known to be types, too.
3095 % E.g. is_just_type(a ** INTEGER) would fail but is_just_type(a ** INTEGER,[a]) would
3096 % succeed.
3097 is_just_type(b(E,T,I),RTT) :- is_just_type3(E,T,I,RTT).
3098
3099
3100 is_just_type3(identifier(G),SType,Infos,RefsToTypes) :-
3101 nonvar(SType), SType = set(Type), nonvar(Type),
3102 ( Type = global(G),
3103 memberchk(given_set,Infos) % no accidental local variable G that hides global G
3104 ; memberchk(G,RefsToTypes) -> true
3105 %; Type = freetype(G),
3106 % memberchk(given_set,Infos) % no accidental local variable G that hides global G
3107 % TODO: we do not know if the Freetype has restrictions (which are encoded in the PROPERTIES)
3108 ),!.
3109 is_just_type3(freetype_set(_),_,_,_).
3110 is_just_type3(pow_subset(E),_,_,RTT) :- is_just_type(E,RTT).
3111 is_just_type3(fin_subset(E),T,_,RTT) :-
3112 is_finite_type_in_context(proving,T), % animation or proving
3113 is_just_type(E,RTT).
3114 is_just_type3(integer_set('INTEGER'),set(integer),_,_).
3115 is_just_type3(bool_set,set(boolean),_,_).
3116 is_just_type3(real_set,set(real),_,_).
3117 is_just_type3(string_set,set(string),_,_).
3118 is_just_type3(cartesian_product(A,B),_,_,RTT) :-
3119 is_just_type(A,RTT),is_just_type(B,RTT).
3120 is_just_type3(mult_or_cart(A,B),_,_,RTT) :- % is_just_type/1 could be called before the cleanup
3121 is_just_type(A,RTT),is_just_type(B,RTT). % of an expression has finished
3122 is_just_type3(relations(A,B),_,_,RTT) :-
3123 is_just_type(A,RTT),is_just_type(B,RTT).
3124 is_just_type3(struct(b(rec(Fields),_,_)),_,_,RTT) :-
3125 maplist(field_is_just_type(RTT),Fields).
3126 is_just_type3(typeset,_,_,_).
3127 is_just_type3(comprehension_set(_,b(truth,_,_)),_,_,_).
3128 is_just_type3(value(Val),ST,_,_) :- is_set_type(ST,Type), is_maximal_value(Val,Type). % also see: quick_is_definitely_maximal_set(Val).
3129
3130 field_is_just_type(RTT,field(_,Set)) :- is_just_type(Set,RTT).
3131
3132 is_maximal_value(V,_) :- var(V),!,fail.
3133 is_maximal_value(global_set(GS),Type) :- (GS=='INTEGER' -> true ; Type==global(GS)). % we could call is_maximal_global_set(GS) or b_global_set (but requires compiled)
3134
3135 % Generate a custom matching / visitor predicate
3136 % bsyntaxtree:gen_visitor(bexpr_variables_aux,bexpr_variables)
3137 /*
3138 gen_visitor(Pred, BodyPred) :- syntaxelement(Expr,SubsX,_NamesX,_Lists,_ConstantX,_),
3139 print_clause(Pred,BodyPred,Expr,SubsX),
3140 fail.
3141 gen_visitor(Pred, BodyPred) :- nl.
3142
3143 print_clause(Pred,BodyPred,Expr,SubsX) :- E=..[Op|SubsX], format('~w(~w) :- ',[Pred,Expr]).
3144 */
3145
3146 /*
3147 * create_recursive_compset(+Ids,+Cond,+Type,+Infos,-RecId,-TCompSet)
3148 * creates a recursive comprehension set:
3149 * Ids is the list of the introduced typed identifiers
3150 * Cond is the condition (a typed predicate)
3151 * Infos are additional informations for the comprehension set syntax element
3152 * RecId is the identifier (untyped, an atom) that can be used in Cond to refer to the
3153 * comprehension set recursively. Usually RecId is used in Cond as a variable
3154 * TCompSet is the generated recursive comprehension set, the recursion parameter is introduced
3155 * by a recusive(Id,CompSet) syntax element
3156 */
3157 create_recursive_compset(Ids,Cond,Type,Infos,RecId,TCompSet) :-
3158 unique_id("recursive.",RecId),
3159 add_symbolic_annotation(Infos,RInfos),
3160 create_texpr(comprehension_set(Ids,Cond),Type,RInfos,TCompSet1),
3161 create_typed_id(RecId,Type,TRecId),
3162 create_texpr(recursive_let(TRecId,TCompSet1),Type,[],TCompSet).
3163
3164 unique_typed_id(Prefix,Type,TId) :-
3165 unique_id(Prefix,Id),
3166 create_typed_id(Id,Type,TId).
3167
3168
3169 mark_bexpr_as_symbolic(b(E,T,I),b(E2,T,RI)) :-
3170 add_symbolic_annotation(I,RI),
3171 mark_aux(E,E2).
3172 mark_aux(union(A,B),R) :- !, R=union(SA,SB),
3173 mark_bexpr_as_symbolic(A,SA), mark_bexpr_as_symbolic(B,SB).
3174 % union is currently the only operator that is kept symbolically
3175 mark_aux(A,A).
3176
3177 add_symbolic_annotation([H|I],R) :- H == prob_annotation('SYMBOLIC'),!, R=[H|I].
3178 add_symbolic_annotation(I,R) :- !, R=[prob_annotation('SYMBOLIC')|I].
3179
3180 % identifier_sub_ast(+TExpr,+Identifier,-SubPosition):
3181 % Find occurences of an identifier "Identifier" in an expression "TExpr"
3182 % Returns a list of positions (beginning with 0) that describes the position of a sub-expression
3183 % that contains all occurrences of Identifier in TExpr.
3184 % E.g. [1,0,1] means "second sub-expression of TExpr, then the first sub-expression of that,
3185 % then the second sub-expression of that".
3186 % When an identifier has multiple occurences, the position of the sub-expression is returned
3187 % where all occurences of it are located.
3188 % If the identifier is not found, the call fails.
3189 % Sub-expressions are meant like the ones syntaxtraversion or syntaxtransformation return.
3190 identifier_sub_ast(TExpr,Identifier,SubPosition) :-
3191 syntaxtraversion(TExpr,Expr,_Type,_Infos,AllSubs,Names),
3192 identifier_sub_ast_aux(Expr,AllSubs,Names,Identifier,SubPosition).
3193 identifier_sub_ast_aux(identifier(Identifier),[],[],Identifier,[]) :- !.
3194 identifier_sub_ast_aux(_Expr,AllSubs,Names,Identifier,SubPosition) :-
3195 get_texpr_id(TId,Identifier),nonmember(TId,Names),
3196 % For each sub-expression E in the list AllSubs create a term Pos-E
3197 % where Pos is E's position (starting with 0) in AllSubs
3198 foldl(annotate_pos,AllSubs,AllAnnotatedSubs,0,_),
3199 % Introduced identifiers occur alsa as sub-expressions, remove those
3200 foldl(select_sub,Names,AllAnnotatedSubs,RealAnnSubs),
3201 convlist_max(identifier_sub_ast_aux2(Identifier),2,RealAnnSubs,SubPositions), % find at most 2 sols
3202 ( SubPositions = [SubPosition] -> true
3203 ; SubPositions = [_,_|_] -> % More then one occurrences - make this the found node
3204 SubPosition = []).
3205 identifier_sub_ast_aux2(Identifier,Pos-TExpr,[Pos|SubPosition]) :-
3206 identifier_sub_ast(TExpr,Identifier,SubPosition).
3207 annotate_pos(TExpr,I-TExpr,I,I2) :- I2 is I+1.
3208 select_sub(Name,AnnotatedSubs,Result) :-
3209 selectchk(_Pos-Name,AnnotatedSubs,Result).
3210
3211
3212
3213 % exchange_ast_position(+SubPosition,+OldTExpr,-OldInner,+NewInner,-NewTExpr):
3214 % exchanges a sub-expression in the expression "OldTExpr".
3215 % SubPosition is a list of positions like identifier_sub_ast/3 returns it.
3216 % OldInner is the sub-expression found in OldTExpr.
3217 % NewInner is the new sub-expression.
3218 % NewTExpr is the new expression that originates from replacing OldInner by NewInner.
3219 exchange_ast_position([],Old,Old,New,New).
3220 exchange_ast_position([Pos|RestPos],OldTExpr,OldInner,NewInner,NewTExpr) :-
3221 remove_bt_and_used_ids(OldTExpr,OldExpr,NewExpr,NewTExpr), % also invalidates used_ids info
3222 syntaxtransformation(OldExpr,Subs,_Names,NSubs,NewExpr),
3223 nth0(Pos,Subs, OldSelected,Rest),
3224 nth0(Pos,NSubs,NewSelected,Rest),
3225 exchange_ast_position(RestPos,OldSelected,OldInner,NewInner,NewSelected).
3226
3227
3228 % -----------------------
3229 % utility to expand / inline all let expressions and let predicates:
3230 % useful for tools that cannot handle the lets
3231
3232 expand_all_lets(Expr,NewExpr) :-
3233 transform_bexpr(tl_expand_lets,Expr,NewExpr).
3234
3235 tl_expand_lets(b(E,_,_),Res) :- tl_expand_lets2(E,Res).
3236 tl_expand_lets2(let_expression(Ids,Exprs,Body),NewBody) :- % expand LET expression
3237 replace_ids_by_exprs(Body,Ids,Exprs,NewBody).
3238 tl_expand_lets2(let_predicate(Ids,Exprs,Body),NewBody) :- % expand LET predicate
3239 replace_ids_by_exprs(Body,Ids,Exprs,NewBody).
3240
3241 % -----------------------
3242
3243 :- public check_used_ids/2.
3244 % a simple checker, only checks used_ids info fields for entire typed expression:
3245 check_used_ids(TExpr,PP) :- %format('CHECK AST for ~w~n',[PP]),
3246 map_over_typed_bexpr(check_used_ids_texpr_fail(PP),TExpr).
3247 check_used_ids(_,_).
3248 check_used_ids_texpr_fail(PP,E) :- check_used_ids_texpr(PP,E),!,fail.
3249 check_used_ids_texpr(PP,b(P,T,I)) :- member(used_ids(UIds1),I),!,
3250 (find_identifier_uses(b(P,T,I),[],UIds2) -> true
3251 ; add_internal_error('find_identifier_uses failed',PP),fail),
3252 (UIds1==UIds2 -> true
3253 ; format('*** Wrong used_ids Info (~w)!!~n Used_ids: ~w~n Comp_ids: ~w~n',[PP,UIds1,UIds2]),
3254 translate:print_bexpr(b(P,T,I)),nl,
3255 add_error(check_used_ids,'Wrong used_ids: ',PP,I)
3256 ).
3257 check_used_ids_texpr(_,_).
3258
3259 % repair any broken used_ids info in typed expression TExpr and re-compute used_ids if necessary
3260 % PP is a program point, will be reported in case of an error
3261 repair_used_ids(PP,TExpr,Res) :-
3262 (transform_bexpr(bsyntaxtree:repair_used_ids_info(PP),TExpr,NewTExpr) -> Res=NewTExpr
3263 ; add_internal_error('Repairing used_ids failed:',PP),
3264 Res=TExpr).
3265
3266 % we could also simply call recompute_used_ids_inf; but it would not generate any messages
3267 repair_used_ids_info(PP,b(P,T,I),b(P,T,NI)) :- %functor(P,FF,_), print(repair(FF)),nl,
3268 select(used_ids(OldUsed),I,I2),!,
3269 (find_identifier_uses(b(P,T,I),[],NewUsed)
3270 -> (NewUsed=OldUsed -> NI=I
3271 ; NI = [used_ids(NewUsed)|I2],
3272 add_message(repair_used_ids,'Updating used_ids for: ',b(P,T,I),I2)
3273 )
3274 ; add_internal_error('find_identifier_uses failed',PP),
3275 NI=I
3276 ).
3277 repair_used_ids_info(PP,b(P,T,I),b(P,T,NI)) :-
3278 requires_used_ids(P),
3279 (find_identifier_uses(b(P,T,I),[],NewUsed) -> true
3280 ; add_internal_error('find_identifier_uses failed',PP),fail
3281 ),
3282 !,
3283 NI=[used_ids(NewUsed)|I].
3284 repair_used_ids_info(_,B,B).
3285
3286 requires_used_ids(exists(_,_)).
3287 requires_used_ids(forall(_,_,_)).
3288
3289 % a simple checker to see if an AST is well-formed:
3290 % can be tested e.g. as follows: b_get_invariant_from_machine(I), check_ast(I).
3291 % called in prob_safe_mode by clean_up_section
3292
3293 check_ast(TE) :- check_ast(false,TE).
3294 check_ast(AllowVars,TExpr) :- %nl,print('CHECK AST'),nl,
3295 map_over_typed_bexpr(check_ast_texpr(AllowVars),TExpr).
3296 check_ast(_,_).
3297
3298 :- use_module(typing_tools,[valid_ground_type/1]).
3299 %check_ast_texpr(X) :- print(check(X)),nl,fail.
3300 check_ast_texpr(AllowVars,AST) :- AST = b(E,Type,Infos),
3301 (debug:debug_level_active_for(9) -> write(' check_ast: '),print_bexpr(AST), write(' :: '), write(Type), nl ; true),
3302 (check_expr(E,Type,Infos) -> true
3303 ; add_error(check_ast_texpr,'Invalid Expr: ', AST) %, trace, check_expr(E,Type,Infos)
3304 ),
3305 (check_type(Type,AllowVars) -> true
3306 ; add_error(check_ast_texpr,'Invalid Type for: ',AST,Infos)),
3307 safe_functor(E,F),
3308 check_ast_typing(E,Type,Infos),
3309 (check_infos(Infos,F) -> true ; add_error(check_ast_texpr,'Invalid Infos: ',AST)),
3310 check_special_rules(E,Type,Infos),
3311 fail. % to force backtracking in map_over_typed_bexpr
3312
3313
3314 check_special_rules(operation_call_in_expr(Operation,_),_,OInfos) :- !,
3315 get_texpr_info(Operation,Info), % reads info important for used_ids computation
3316 (memberchk(reads(_V),Info) -> true
3317 ; add_error(check_ast_texpr,'Missing reads info: ',Operation,OInfos)).
3318
3319
3320 safe_functor(V,R) :- var(V),!,R='$VAR'.
3321 safe_functor(E,F/N) :- functor(E,F,N).
3322
3323 % check whether the type term is ok
3324 check_type(X,AllowVars) :- var(X),!,
3325 (AllowVars==true -> true ; add_error(check_type,'Variable type: ',X),fail).
3326 check_type(pred,_) :- !.
3327 check_type(subst,_) :- !.
3328 check_type(op(Paras,Returns),AllowVars) :- !,
3329 maplist(check_normal_type(AllowVars),Paras),
3330 maplist(check_normal_type(AllowVars),Returns).
3331 check_type(T,AllowVars) :- check_normal_type(AllowVars,T).
3332
3333 check_normal_type(AllowVars,T) :-
3334 (AllowVars \== true -> valid_ground_type(T)
3335 ; ground(T) -> valid_ground_type(T)
3336 ; true). % TO DO: call valid_ground_type but pass AllowVars
3337
3338 :- use_module(probsrc(btypechecker), [lookup_type_for_expr/2, unify_types_werrors/4]).
3339 % check whether type is compatible with operators
3340 check_ast_typing(member(A,B),Type,Pos) :- !,
3341 get_texpr_type(B,TB), check_set_type(TB,member,Pos),
3342 check_type(Type,pred,member),
3343 get_texpr_type(A,TA),
3344 unify_types_werrors(set(TA),TB,Pos,member).
3345 check_ast_typing(not_equal(A,B),Type,Pos) :- !, check_ast_typing(equal(A,B),Type,Pos).
3346 check_ast_typing(equal(A,B),Type,Pos) :- !,
3347 get_texpr_type(B,TB),
3348 get_texpr_type(A,TA),
3349 unify_types_werrors(TA,TB,Pos,'='),
3350 (non_value_type(TA)
3351 -> add_error(check_ast_typing,'Binary predicate has to have values as arguments:',TA,Pos)
3352 ; Type=pred -> true
3353 ; add_error(check_ast_typing,'Illegal type for binary predicate:',Type,Pos)
3354 ).
3355 check_ast_typing(greater_equal(A,B),Type,_) :- !,
3356 get_texpr_type(A,TA),check_type(TA,integer,greater_equal),
3357 get_texpr_type(B,TB),check_type(TB,integer,greater_equal), check_type(Type,pred,member).
3358 check_ast_typing(Expr,Type,Pos) :-
3359 syntaxtransformation(Expr,Subs,Names,NSubs,NewExpr),
3360 check_names(Names,Pos),
3361 (lookup_type(NewExpr,T) -> true
3362 ; add_warning(check_ast_typing,'Unable to lookup type for: ',NewExpr),
3363 fail
3364 ),
3365 !,
3366 (unify_types_werrors(Type,T,Pos,'check_ast')
3367 -> maplist(check_sub_type(Expr,Pos),Subs,NSubs)
3368 ; add_error(check_ast_typing,'Type mismatch for expression:',Expr,Pos)
3369 ).
3370 check_ast_typing(_,subst,_) :- !. % ignore subst for the moment
3371 check_ast_typing(operation(_TName,_Res,_Params,_TBody),_,_) :- !. % ignore operations for the moment
3372 check_ast_typing(Expr,_,Pos) :-
3373 syntaxtransformation(Expr,_,_Names,_,_NewExpr),!,
3374 add_message(check_ast_typing,'Cannot lookup type for expression: ',Expr,Pos).
3375 check_ast_typing(Expr,_,Pos) :-
3376 add_message(check_ast_typing,'No applicable type rule for expression: ',Expr,Pos).
3377
3378 non_value_type(X) :- var(X),!,fail.
3379 non_value_type(pred).
3380 non_value_type(subst).
3381 non_value_type(op(_)).
3382
3383
3384 check_names([],_).
3385 check_names([H|T],Pos) :-
3386 (member(H,T) -> add_error(check_ast_name,'Duplicate name:',H,Pos) ; check_names(T,Pos)).
3387
3388 check_sub_type(OuterExpr,Pos,Arg,Type) :- get_texpr_type(Arg,T),!,
3389 (unify_types_werrors(Type,T,Pos,'check_sub_type') -> true
3390 ; add_error(check_ast_typing,'Type mismatch for sub-expression:',Arg,Pos),
3391 write('Outer expression: '),translate:print_bexpr(OuterExpr),nl,
3392 write('Outer type: '),write(Type),nl,
3393 write('Arg type: '),write(T),nl,print(type(T)),nl, tools_printing:print_term_summary(Arg),nl,trace
3394 ).
3395 check_sub_type(_,Pos,Arg,_) :-
3396 add_error(check_ast_typing,'Cannot extract type: ',Arg,Pos).
3397
3398 lookup_type(identifier(_),_) :- !. % ignore typing issues for identifiers
3399 lookup_type(Expr,Type) :- lookup_type_for_expr(Expr,Type).
3400
3401 check_set_type(Var,_,_) :- var(Var),!.
3402 check_set_type(set(_),_,_) :- !.
3403 check_set_type(seq(_),_,_) :- !.
3404 check_set_type(Type,Func,Pos) :- add_error(check_ast_typing,'Invalid type for operator: ',Func:Type,Pos).
3405
3406 check_type(Type,Type,_) :- !.
3407 check_type(Type,_,Func) :- add_error(check_ast_typing,'Unexpected type for operator: ',Func:Type).
3408
3409 check_infos(X,F) :- var(X),!, add_error(check_infos,'Info field list not terminated: ',F:X),fail.
3410 check_infos([],_).
3411 check_infos([H|_],F) :- \+ ground(H),!, add_error(check_infos,'Info field not ground: ',F:H),fail.
3412 check_infos([[H|T]|_],F) :- !, add_error(check_infos,'Info field contains nested list: ',F:[H|T]),fail.
3413 check_infos([cse_used_ids(H)|T],F) :- member(cse_used_ids(H2),T),!,
3414 add_error(check_infos,'Multiple cse_used_ids entries: ',F:[H,H2]),fail.
3415 check_infos([used_ids(H)|T],F) :- member(used_ids(H2),T),!,
3416 add_error(check_infos,'Multiple used_ids entries: ',F:[H,H2]),fail.
3417 check_infos([nodeid(N1)|T],F) :- member(nodeid(N2),T),!,
3418 add_error(check_infos,'Multiple nodeid entries: ',F:[N1,N2],[nodeid(N1)]),fail.
3419 check_infos([removed_typing|T],F) :- member(removed_typing,T),!,
3420 add_error(check_infos,'Multiple removed_typing entries: ',F,T),fail.
3421 check_infos([_|T],F) :- check_infos(T,F).
3422
3423 check_expr(Expr,Type,Infos) :- nonmember(contains_wd_condition,Infos),
3424 sub_expression_contains_wd_condition(Expr,Sub),
3425 TE = b(Expr,Type,Infos),
3426 (Type = subst
3427 -> fail % AST cleanup is not called for substitutions; WD-info not available for substitutions at the moment
3428 ; translate_bexpression(TE,PS)),
3429 functor(Expr,Functor,_),
3430 functor(Sub,SubFunctor,_),
3431 tools:ajoin(['Node for AST node ',Functor,' does not contain WD info from Subexpression ',SubFunctor,' :'],Msg),
3432 add_warning(check_expr,Msg,PS,TE).
3433 % well_def_analyser:nested_print_wd_bexpr(TE),nl.
3434 % TODO: check when we have an unnecessary WD condition
3435 check_expr(Expr,Type,Infos) :- nonmember(contains_wd_condition,Infos),
3436 always_not_wd_top(Expr),
3437 add_warning(check_expr,'AST is not well-defined but does not contain WD info: ',b(Expr,Type,Infos),Infos).
3438 check_expr(member(LHS,RHS),Type,Infos) :- is_just_type(RHS),
3439 get_preference(optimize_ast,true),
3440 !,
3441 TE = b(member(LHS,RHS),Type,Infos),
3442 translate:translate_bexpression(TE,PS),
3443 add_warning(check_expr,'AST contains redundant typing predicate: ',PS,TE).
3444 check_expr(identifier(ID),_,_) :- illegal_id(ID),!,
3445 add_error(check_infos,'Illegal identifier: ', identifier(ID)).
3446 check_expr(lazy_lookup_expr(ID),_,_) :- illegal_id(ID),!,
3447 add_error(check_infos,'Illegal identifier: ', lazy_lookup_expr(ID)).
3448 check_expr(lazy_lookup_pred(ID),_,_) :- illegal_id(ID),!,
3449 add_error(check_infos,'Illegal identifier: ', lazy_lookup_pred(ID)).
3450 check_expr(exists(Parameters,Condition),pred,Infos) :- !,
3451 check_used_ids(exists,Parameters,Condition,Infos,_Used).
3452 check_expr(forall(Parameters,LHS,RHS),pred,Infos) :- !,
3453 create_implication(LHS,RHS,Condition),
3454 check_used_ids(forall,Parameters,Condition,Infos,_Used). %
3455 check_expr(value(V),Type,_) :- !, check_bvalue(V,Type).
3456 check_expr(_,_,_).
3457
3458 % will check all used_ids fields (not just for exists and forall)
3459 :- public check_used_ids_in_ast/1.
3460 check_used_ids_in_ast(closure(_,_,TExpr)) :- !, (map_over_typed_bexpr(check_used_ids_aux,TExpr) ; true).
3461 check_used_ids_in_ast(TExpr) :- map_over_typed_bexpr(check_used_ids_aux,TExpr).
3462 check_used_ids_in_ast(_).
3463
3464 check_used_ids_aux(AST) :- AST = b(_,_,Infos),
3465 ? member(used_ids(_),Infos),!,
3466 find_identifier_uses_if_necessary(AST,[],_), % will perform check
3467 fail.
3468
3469 % --------------------
3470
3471 :- use_module(specfile,[eventb_mode/0, z_or_tla_minor_mode/0]).
3472 % check if an expression is definitely not WD; looking at the top-level operator only
3473 always_not_wd_top(function(X,_)) :- definitely_empty_set(X). % TODO: detect a few more cases, e.g., arg not in dom
3474 always_not_wd_top(power_of(X,Y)) :- (get_integer(Y,VY), VY < 0 -> true
3475 ; eventb_mode, get_integer(X,VX), VX < 0).
3476 always_not_wd_top(div(_,Val)) :- get_integer(Val,VV), VV==0.
3477 always_not_wd_top(modulo(X,Y)) :-
3478 (get_integer(Y,VY), VY=<0
3479 -> true % there seems to be a def for Z in Z Live, cf modulo2
3480 ; get_integer(X,VX), VX<0, \+ z_or_tla_minor_mode).
3481 always_not_wd_top(min(X)) :- definitely_empty_set(X).
3482 always_not_wd_top(max(X)) :- definitely_empty_set(X).
3483 always_not_wd_top(size(X)) :- definitely_not_sequence(X). % TODO: detect infinite sets; also for card(_)
3484 always_not_wd_top(first(X)) :- definitely_not_non_empty_sequence(X).
3485 always_not_wd_top(front(X)) :- definitely_not_non_empty_sequence(X).
3486 always_not_wd_top(last(X)) :- definitely_not_non_empty_sequence(X).
3487 always_not_wd_top(tail(X)) :- definitely_not_non_empty_sequence(X).
3488 always_not_wd_top(general_intersection(X)) :- definitely_empty_set(X).
3489
3490 definitely_not_non_empty_sequence(X) :-
3491 (definitely_empty_set(X) -> true ; definitely_not_sequence(X)).
3492
3493 :- use_module(avl_tools,[avl_min_pair/3]).
3494 definitely_not_sequence(b(value(A),_,_)) :- nonvar(A), A=avl_set(AVL),
3495 avl_min_pair(AVL,int(StartIndex),_), StartIndex \= 1.
3496 % TODO: treat set_extension
3497
3498 :- use_module(b_ast_cleanup,[check_used_ids_info/4]).
3499 check_used_ids(Quantifier,Parameters,Condition,Infos,Used) :-
3500 select(used_ids(Used),Infos,Rest)
3501 -> check_used_ids_info(Parameters,Condition,Used,Quantifier), %% comment in to check used_ids field
3502 (member(used_ids(_),Rest)
3503 -> add_internal_error('Multiple used_ids info fields:',Parameters:Infos) ; true)
3504 ;
3505 add_internal_error(
3506 'Expected information of used identifiers information',Quantifier:Parameters:Infos).
3507
3508 illegal_id(ID) :- var(ID),!.
3509 illegal_id(op(ID)) :- !, \+ atom(ID).
3510 illegal_id(ID) :- \+ atom(ID).
3511
3512 :- use_module(btypechecker, [unify_types_strict/2, couplise_list/2]).
3513 :- use_module(avl_tools,[check_is_non_empty_avl/1]).
3514 % TO DO: we could check type more
3515 check_bvalue(V,_) :- var(V),!.
3516 check_bvalue(avl_set(A),Type) :- !, unify_types_strict(Type,set(_)),
3517 check_is_non_empty_avl(A).
3518 check_bvalue(closure(_,T,B),Type) :- !,
3519 couplise_list(T,CT), unify_types_strict(set(CT),Type),
3520 check_ast(B).
3521 check_bvalue(_,_).
3522
3523 % -----------------------
3524
3525
3526 indent_ws(X) :- X<1,!.
3527 indent_ws(X) :- print(' '), X1 is X-1, indent_ws(X1).
3528
3529 print_ast_td(b(E,T,I),Level,L1) :-
3530 indent_ws(Level),
3531 (E=identifier(_)
3532 -> format('~w (~w) -> ~w~n',[E,T,I])
3533 ; functor(E,F,N),
3534 format('~w/~w (~w) -> ~w~n',[F,N,T,I])
3535 ),
3536 L1 is Level+1.
3537 print_ast(TExpr) :-
3538 (map_over_typed_bexpr_top_down_acc(print_ast_td,TExpr,0),fail ; true).
3539
3540 % ---------------------
3541
3542 :- dynamic count_id_usage/2.
3543 single_usage_id_count(Expr) :- uses_an_identifier(Expr,Id),
3544 retract(count_id_usage(Id,Count)),
3545 !,
3546 Count=0,
3547 C1 is Count+1,
3548 assertz(count_id_usage(Id,C1)).
3549 single_usage_id_count(_).
3550
3551 % check if an identifier is used at most once
3552 single_usage_identifier(ID,ExprOrPredicates,Count) :-
3553 retractall(count_id_usage(_,_)),
3554 assertz(count_id_usage(ID,0)),
3555 % TO DO: take care of naming; do not count occurences when we enter scope defining ID
3556 maplist(single_usage_cnt,ExprOrPredicates),
3557 retract(count_id_usage(ID,Count)).
3558
3559 single_usage_cnt(ExprOrPredicate) :- map_over_full_bexpr_no_fail(single_usage_id_count,ExprOrPredicate).
3560
3561 gen_fresh_id_if_necessary(Default,Expr,FreshID) :-
3562 occurs_in_expr(Default,Expr),!,
3563 gensym('__FRESH_ID__',FreshID). % assumes _Fresh_XXX not used
3564 gen_fresh_id_if_necessary(Default,_,Default).
3565
3566 %% rewrite_if_then_else_expr_to_b(IfThenElseExpr, NExpr).
3567 % Rewrite if-then-else expr to B as understood by Atelier-B.
3568 % {d,x| d:BOOL & If => x=Then & not(if) => x=Else}(TRUE)
3569 rewrite_if_then_else_expr_to_b(if_then_else(If,Then,Else), NExpr) :-
3570 get_texpr_type(Then,Type),
3571 ARG = b(boolean_true,boolean,[]), AT=boolean, % we could use unit type or BOOL here
3572 gen_fresh_id_if_necessary('_zzzz_unary',b(if_then_else(If,Then,Else),Type,[]),AID1),
3573 gen_fresh_id_if_necessary('_zzzz_binary',b(if_then_else(If,Then,Else),Type,[]),AID2),
3574 safe_create_texpr(identifier(AID1), AT, [], Id1), % a dummy argument
3575 safe_create_texpr(identifier(AID2), Type, [], Id2), % The result
3576 safe_create_texpr(equal(Id2,Then), pred, [], Eq1),
3577 safe_create_texpr(equal(Id2,Else), pred, [], Eq2),
3578 safe_create_texpr(implication(If,Eq1), pred, [], Pred1),
3579 safe_create_texpr(negation(If), pred, [], NIf),
3580 safe_create_texpr(implication(NIf,Eq2), pred, [], Pred2),
3581 safe_create_texpr(conjunct(Pred1,Pred2), pred, [], Pred),
3582 safe_create_texpr(comprehension_set([Id1,Id2],Pred), set(couple(AT,Type)), [], FUN),
3583 NExpr = function(FUN,ARG).
3584
3585
3586 % --------------------
3587
3588 % apply normalisation rules from Atlier-B PP/ML provers
3589 % see chapter 3 of Atelier-B prover manual
3590
3591 normalise_bexpr_for_ml(TExpr,Res) :-
3592 transform_bexpr(normalise_bexpr,TExpr,Res).
3593
3594 normalise_bexpr(b(E,T,I),b(E2,T,I)) :- norm2(E,E2),!.
3595
3596 norm2(equivalence(A,B),conjunct(TIMP1,TIMP2)) :- !,
3597 safe_create_texpr(implication(A,B),pred,TIMP1),
3598 safe_create_texpr(implication(B,A),pred,TIMP2).
3599 norm2(subset_strict(A,B),conjunct(TMEM,TNEQ)) :- !,
3600 norm2(subset(A,B),MEM), safe_create_texpr(MEM,pred,TMEM),
3601 safe_create_not_equal(A,B,TNEQ).
3602 norm2(subset(A,B),member(A,PowB)) :- !, % A <: B <===> A:POW(B)
3603 get_texpr_type(A,TA),
3604 safe_create_texpr(pow_subset(B),TA,PowB).
3605 norm2(not_equal(A,B),negation(TEQ)) :- !,
3606 safe_create_texpr(equal(A,B),pred,TEQ).
3607 norm2(not_member(A,B),negation(TMEM)) :- !,
3608 safe_create_texpr(member(A,B),pred,TMEM).
3609 norm2(not_subset(A,B),negation(TMEM)) :- !,
3610 norm2(subset(A,B),MEM),safe_create_texpr(MEM,pred,TMEM).
3611 norm2(not_subset_strict(A,B),implication(TMEM,TEQ)) :- !, % A /<< : B <===> A:POW(B) => A=B
3612 norm2(subset(A,B),MEM),safe_create_texpr(MEM,pred,TMEM),
3613 safe_create_texpr(equal(A,B),pred,TEQ).
3614 norm2(POW1,set_subtraction(TPOW,TSEMPTY)) :- not_empty_pow(POW1,A,POW), !,
3615 % POW1(A) <===> POW(A) - {{}}, FIN1(A) <===> FIN(A) - {{}}, ...
3616 safe_create_texpr(POW,pred,TPOW),
3617 get_texpr_type(A,TA), TEMPTY = b(empty_set,TA,[]),
3618 safe_create_texpr(set_extension([TEMPTY]),set(TA),TSEMPTY).
3619 norm2(member(A,b(integer_set('NATURAL'),_,_)),conjunct(TMEM,TLEQ)) :- !, % A <: NATURAL <===> A:INTEGER & 0 <= A
3620 INTEGER = b(integer_set('INTEGER'),set(integer),[]),
3621 safe_create_texpr(member(A,INTEGER),pred,TMEM),
3622 Zero = b(integer(0),integer,[]),
3623 safe_create_texpr(less_equal(Zero,A),pred,TLEQ).
3624 norm2(set_extension(List),Union) :- List = [H|T], T=[_|_], !, % {A,B} <===> {A} \/ {B}
3625 get_texpr_type(H,Type),
3626 set_extension_to_union(H,T,set(Type),b(Union,_,_)).
3627 norm2(greater_equal(A,B),less_equal(B,A)) :- !.
3628 norm2(greater(A,B),less_equal(B1,A)) :- !, plus1(B,B1).
3629 norm2(less(A,B),less_equal(A,B1)) :- !, minus1(B,B1). % the normalisation rule in chapter 3 is actually false
3630 norm2(integer_set(NAT1),set_subtraction(TNAT,TSZero)) :- nat1(NAT1,NAT), !, % NATURAL1 <===> NATURAL - {0}
3631 TNAT = b(integer_set(NAT),set(integer),[]),
3632 set_with_zero(TSZero).
3633 norm2(empty_sequence,empty_set) :- !.
3634 norm2(perm(A),intersection(ISEQ,PSURJ)) :- !, % perm(A) <===> iseq(A) /\ (NATURAL-{0} +->> A)
3635 get_texpr_type(A,TA),
3636 safe_create_texpr(iseq(A),set(seq(TA)),ISEQ),
3637 set_with_zero(TSZero),
3638 NATURAL = b(integer_set('NATURAL'),set(integer),[]),
3639 safe_create_texpr(set_subtraction(NATURAL,TSZero),set(integer),DOM),
3640 safe_create_texpr(partial_surjection(DOM,A),set(seq(TA)),PSURJ).
3641 % TODO: total_relation, if_then_else, ...?
3642
3643 set_with_zero(TSZero) :- % {0}
3644 TZero = b(integer(0),TA,[]),
3645 safe_create_texpr(set_extension([TZero]),set(TA),TSZero).
3646
3647 % TODO: more intelligent versions like x-1 ==> x ...
3648 plus1(A,Plus1) :- One = b(integer(1),integer,[]),
3649 safe_create_texpr(add(A,One),integer,Plus1).
3650 minus1(A,Plus1) :- One = b(integer(1),integer,[]),
3651 safe_create_texpr(minus(A,One),integer,Plus1).
3652
3653 not_empty_pow(pow1_subset(A),A,pow_subset(A)).
3654 not_empty_pow(fin1_subset(A),A,fin_subset(A)).
3655 not_empty_pow(seq1(A),A,seq(A)).
3656 not_empty_pow(iseq1(A),A,iseq(A)).
3657
3658 nat1('NATURAL1','NATURAL').
3659 nat1('NAT1','NAT').
3660
3661 safe_create_not_equal(A,B,TNEQ) :-
3662 safe_create_texpr(equal(A,B),pred,TEQ),
3663 safe_create_texpr(negation(TEQ),pred,TNEQ).
3664
3665 set_extension_to_union(H,[],Type,Res) :- !,
3666 safe_create_texpr(set_extension([H]),Type,Res).
3667 set_extension_to_union(H,[H2|T],Type,Res) :-
3668 safe_create_texpr(set_extension([H]),Type,TH),
3669 set_extension_to_union(H2,T,Type,TUnion),
3670 safe_create_texpr(union(TH,TUnion),Type,Res).