1 % (c) 2020-2026 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(well_def_prover, [prove_po/3]).
6
7 :- use_module(probsrc(module_information),[module_info/2]).
8 :- module_info(group,well_def_prover).
9 :- module_info(description,'This module proves WD POs.').
10
11 :- use_module(library(avl)).
12 :- use_module(library(lists)).
13
14 :- use_module(wdsrc(well_def_hyps),[get_hyp_var_type/3, portray_hyps/1, get_clash_renaming_subst/2,
15 is_hyp_var/2, is_finite_type_for_wd/2, add_new_hyp_any_vars/3, negate_op/2,
16 hyps_inconsistent/1,
17 push_normalized_hyp/3, push_and_rename_normalized_hyp/3]).
18
19 :- use_module(wdsrc(well_def_tools), [rename_norm_term/3, member_in_norm_conjunction/2, not_occurs/2, occurs/2]).
20 :- use_module(probsrc(debug)).
21 :- use_module(probsrc(error_manager),[add_error/3, add_internal_error/2]).
22
23 :- use_module(probsrc(custom_explicit_sets),[domain_of_explicit_set_wf/3, equal_avl_tree/2,
24 range_of_explicit_set_wf/3,
25 invert_explicit_set/2,check_interval_in_custom_set/4, is_interval_closure/5,
26 check_avl_in_interval/3, check_avl_subset/2, is_one_element_avl/2,
27 avl_is_interval/3,
28 expand_custom_set_to_list/2, quick_definitely_maximal_set_avl/1,
29 expand_and_convert_to_avl_set/4, safe_is_avl_sequence/1, is_avl_partial_function/1]).
30
31 :- load_files(library(system), [when(compile_time), imports([environ/2])]).
32
33 % PROVING:
34 % --------
35
36
37 % some more rules are covered in process_sequent_aux of prove_sequent/3
38 prove_po(truth,_,truth).
39 prove_po(_NormTarget,Hyps,false_hyp) :- hyps_inconsistent(Hyps).
40 prove_po(NormTarget,hyp_rec(AVL,_),hyp) :- avl_fetch(NormTarget,AVL).
41 prove_po(member(X,Y),Hyps,mem(PT)) :- % Y is usually domain(Func)
42 simplify_expr_loop(Y,Hyps,SY),
43 simplify_expr_loop(X,Hyps,SX),
44 ? check_member_of_set(SY,SX,Hyps,PT).
45 prove_po(not_member(X,Y),Hyps,mem(PT)) :-
46 simplify_expr_loop(Y,Hyps,SY),
47 simplify_expr_loop(X,Hyps,SX),
48 ? check_not_member_of_set(SY,SX,Hyps,PT).
49 ?prove_po(finite(Set),Hyp,finite_set(PT)) :- check_finite(Set,Hyp,PT).
50 prove_po(not_equal(A,B),Hyp,not_equal) :-
51 simplify_expr_loop(A,Hyp,SA),
52 simplify_expr_loop(B,Hyp,SB),
53 ? check_not_equal(SA,SB,Hyp).
54 prove_po(equal(A,B),Hyp,equal) :- % not generated by our POG
55 simplify_expr_loop(A,Hyp,SA),
56 simplify_expr_loop(B,Hyp,SB),
57 ? check_equal(SA,SB,Hyp,_).
58 prove_po(greater(A,B),Hyp,PT) :- prove_po(less(B,A),Hyp,PT).
59 prove_po(greater_equal(A,B),Hyp,greater_equal) :- % print(check_leq(B,A)),nl,
60 check_leq(B,A,Hyp).
61 prove_po(less_equal(A,B),Hyp,less_equal) :-
62 ? check_leq(A,B,Hyp).
63 %prove_po(less_equal_real(A,B),Hyp,less_equal_real) :-
64 % check_leq(A,B,Hyp). % TODO: check that all proof rules are sound for reals, ditto for less
65 prove_po(less(A,B),Hyp,less) :-
66 ? check_leq(A,B,Hyp),!,
67 ? check_not_equal(A,B,Hyp).
68 prove_po(subset(A,B),Hyp,PT) :-
69 simplify_expr_loop(A,Hyp,SA), simplify_expr_loop(B,Hyp,SB),
70 ? check_is_subset(SA,SB,Hyp,PT).
71 prove_po(subset_strict(A,B),Hyp,subset_strict(PT)) :-
72 simplify_expr_loop(A,Hyp,SA), simplify_expr_loop(B,Hyp,SB),
73 check_is_subset_strict(SA,SB,Hyp,PT).
74 prove_po(not_subset_strict(A,B),Hyp,not_subset_strict(PT)) :-
75 simplify_expr_loop(A,Hyp,SA), simplify_expr_loop(B,Hyp,SB),
76 ? check_not_is_subset_strict(SA,SB,Hyp,PT).
77 prove_po(not_subset(A,B),Hyp,not_subset(PT)) :-
78 simplify_expr_loop(A,Hyp,SA), simplify_expr_loop(B,Hyp,SB),
79 check_not_subset(SA,SB,Hyp,PT).
80 prove_po(conjunct(A,B),Hyp,conj(T1,T2)) :- % generated by Rodin
81 ? prove_po(A,Hyp,T1),
82 !,
83 ? prove_po(B,Hyp,T2).
84 prove_po(disjunct(A,B),Hyp,conj(T1,T2)) :- % could be generated by Rodin
85 (% push_normalized_hyp(NotB,Hyp,Hyp2), % % OR_R rule allows to add not(B) as hypothesis
86 prove_po(A,Hyp,T1) -> true
87 ; prove_po(B,Hyp,T2)). % OR_R rule allows to add not(A) as hypothesis, this is done in prove_sequent_goal
88 prove_po(implication(A,B),Hyp,imply(T2)) :- % generated by Rodin; now treated in prove_sequent_goal
89 % also generated for power_of_real
90 (prove_negated_po(A,Hyp,PT) -> T2=false_lhs(PT)
91 ; debug_println(19,not_pushing_lhs_for_implication(A)),
92 %push_normalized_hyp(A,Hyp,Hyp2), % TODO: activate this
93 prove_po(B,Hyp,T2)
94 ).
95 prove_po(exists([$(B0)],forall([$(X)],member($(X),Set),less_equal($(X),$(B0)))),Hyp,finite_max(PT)) :- X \= B0,
96 % generated by Rodin for max(Set)
97 debug_println(19,checking_finite_for_max(Set)),
98 check_finite(Set,Hyp,PT).
99 prove_po(exists([$(B0)],forall([$(X)],member($(X),Set),less_equal($(B0),$(X)))),Hyp,finite_min(PT)) :- X \= B0,
100 % generated by Rodin for min(Set)
101 debug_println(19,checking_finite_for_min(Set)),
102 check_finite(Set,Hyp,PT).
103 ?prove_po(negation(Goal),Hyp,negation(PT)) :- prove_negated_po(Goal,Hyp,PT).
104 %prove_po(NT,_,_) :- format('Unproven by WD Prover: ~w~n~n',[NT]),fail.
105
106 % some redundancy wrt negate_hyp; but negate_hyp currently does not go inside conjunction
107 prove_negated_po(falsity,_,falsity) :- !.
108 prove_negated_po(disjunct(A,B),Hyp,negdisj(T1,T2)) :- !,
109 (prove_negated_po(A,Hyp,T1) -> prove_negated_po(B,Hyp,T2)).
110 prove_negated_po(conjunct(A,B),Hyp,negconj(T1,T2)) :- !, % could be generated by Rodin
111 (prove_negated_po(A,Hyp,T1) -> true
112 ; prove_negated_po(B,Hyp,T2)). % we could add not(A) as hypothesis,
113 prove_negated_po(negation(Goal),Hyp,negation(PT)) :-!, prove_po(Goal,Hyp,PT).
114 ?prove_negated_po(OP,Hyp,negated_op(PT)) :- negate_op(OP,NOP), prove_po(NOP,Hyp,PT).
115
116
117 simple_value(Nr) :- number(Nr).
118 simple_value('$'(_)).
119 simple_value(boolean_true).
120 simple_value(boolean_false).
121 simple_value(record_field('$'(_),_)).
122 simple_value(value(_)).
123 simple_value(string(_)).
124 simple_value(function(F,_)) :- simple_value(F).
125 simple_value(couple(A,B)) :- simple_value(A), simple_value(B).
126
127 %get_set_of_possible_values(X,Hyps,XSet) :-
128 % if(try_get_set_of_possible_values(X,Hyps,R), XSet=R,
129 % XSet=set_extension([X])). % was typeset
130
131 try_get_set_of_possible_values(Nr,Hyps,R,Hyps) :- number(Nr),!,R=interval(Nr,Nr).
132 try_get_set_of_possible_values(X,Hyps,R,Hyps) :-
133 ? avl_fetch_binop_from_hyps_no_loop_check(X,equal,Hyps,Nr), number(Nr),!, % TODO: also treat is_explicit_value
134 R=interval(Nr,Nr).
135 try_get_set_of_possible_values(X,Hyps,XSet,Hyps2) :-
136 ? avl_fetch_worthwhile_mem_from_hyps(X,Hyps,XSet1,Hyps1),
137 ? (improve_integer_set_precision(X,XSet1,Hyps1,XSet,Hyps2)
138 -> true ; Hyps2=Hyps1, XSet=XSet1).
139 try_get_set_of_possible_values(X,Hyps,Res,Hyps3) :-
140 ? avl_fetch_equal_from_hyps(X,Hyps,X2,Hyps1),
141 quick_not_occurs_check(X,X2),
142 rewrite_local_loop_check(X,try_get_set_of_possible_values,X2,Hyps1,Hyps2),
143 (X2='$'(_) -> X = '$'(_) ; true), % avoid rewriting x -> card(...) -> x; TO DO: better cyclic equality prevention
144 ? try_get_set_of_possible_values(X2,Hyps2,Res,Hyps3), !.
145 try_get_set_of_possible_values(function(Func,Args),Hyps,RangeSet,Hyps2) :- !,
146 ? (get_range_or_superset(Func,Hyps,RangeSet,Hyps2) -> true
147 ; rewrite_function_application(Func,Args,Hyps,Result,Hyps1), % maybe put this first?
148 try_get_set_of_possible_values(Result,Hyps1,RangeSet,Hyps2)).
149 try_get_set_of_possible_values(first(Seq),Hyps,RangeSet,Hyps2) :- !, % first(S) === S(1)
150 ? get_range_or_superset(Seq,Hyps,RangeSet,Hyps2).
151 try_get_set_of_possible_values(last(Seq),Hyps,RangeSet,Hyps2) :- !, % last(S) === S(size(S))
152 get_range_or_superset(Seq,Hyps,RangeSet,Hyps2).
153 % TO DO other sequence operations
154 try_get_set_of_possible_values(couple(A,B),Hyps,cartesian_product(SA,SB),Hyps2) :- !,
155 ? try_get_set_of_possible_values(A,Hyps,SA,Hyps1),
156 ? try_get_set_of_possible_values(B,Hyps1,SB,Hyps2).
157 try_get_set_of_possible_values(max(set_extension([V1,V2|_])),H,'NATURAL',H) :- % max({x,-x}) >= 0
158 ( V1 = unary_minus(V2), \+ number(V1) -> true
159 ; V2 = unary_minus(V1), \+ number(V2) -> true), !. % instead of NATURAL we could try and infer values for V1/V2
160 try_get_set_of_possible_values(max(Set),H,Set,H).
161 try_get_set_of_possible_values(min(Set),H,Set,H).
162 try_get_set_of_possible_values(mu(Set),H,Set,H).
163 try_get_set_of_possible_values(external_function_call(Call,Args),H,Set,H) :-
164 external_function_possible_vals(Call,Args,Set). % treats CHOOSE, MU, ABS, LCM, GCD, ...
165 try_get_set_of_possible_values(max_int,H,'NATURAL1',H).
166 % TO DO: min_int
167 try_get_set_of_possible_values(value(avl_set(A1)),Hyps,value(avl_set(A2)),Hyps) :- !,
168 expand_and_convert_to_avl_set([avl_set(A1)],A2,get_set_of_possible_values,'WD(?)').
169 try_get_set_of_possible_values(add(X,Y),Hyps,Set,Hyps2) :-
170 add_with_number(add(X,Y),A,Nr),
171 ? try_get_set_of_possible_values(A,Hyps,ValA,Hyps2),
172 add_to_value_set(ValA,Nr,Set),!.
173 try_get_set_of_possible_values(minus(A,Nr),Hyps,Set,Hyps2) :- number(Nr), Nr1 is -Nr,
174 ? try_get_set_of_possible_values(A,Hyps,ValA,Hyps2),
175 add_to_value_set(ValA,Nr1,Set),!.
176 % TO DO : add unary_minus, multiplication with nr
177 try_get_set_of_possible_values(Seq,Hyps,Set,Hyps) :-
178 ? infer_sequence_type_of_expr(Seq,Hyps,SeqType),!,
179 (SeqType=seq1 -> Set=seq1(typeset) ; Set=seq(typeset)). % TO DO: examine type of list elements
180 try_get_set_of_possible_values(X,Hyps,XSet,Hyps2) :-
181 ? avl_fetch_binop_from_hyps(X,greater_equal,Hyps,Low,Hyps1), !,
182 ? (avl_fetch_binop_from_hyps(X,less_equal,Hyps1,Up,Hyps2) -> XSet = interval(Low,Up)
183 ; Low=0 -> XSet = 'NATURAL', Hyps2=Hyps1
184 ; number(Low),Low>0 -> XSet= 'NATURAL1', Hyps2=Hyps1). % TO DO: improve precision
185 try_get_set_of_possible_values(X,Hyps,XSet,Hyps2) :-
186 rewrite_integer(X,Hyps,X2,Hyps1),!,
187 try_get_set_of_possible_values(X2,Hyps1,XSet,Hyps2).
188 try_get_set_of_possible_values(size(A),Hyps,XSet,Hyps) :-
189 ? (check_not_empty_set(A,Hyps) -> XSet = 'NATURAL1' ; XSet='NATURAL').
190 try_get_set_of_possible_values(card(A),Hyps,XSet,Hyps) :-
191 ? (check_not_empty_set(A,Hyps) -> XSet = 'NATURAL1' ; XSet='NATURAL').
192 try_get_set_of_possible_values(if_then_else(_,A,B),Hyps,R,Hyps) :-
193 (try_get_set_of_possible_values(A,Hyps,AV,Hyps1)
194 -> try_get_set_of_possible_values(B,Hyps1,BV,Hyps2)),
195 construct_union(AV,BV,Hyps2,R).
196 try_get_set_of_possible_values(modulo(A,B),Hyps1,XSet,Hyps2) :-
197 number(B), B>0,
198 B1 is B-1,
199 XSet1 = interval(0,B1), % value of A mod B must be in 0..B1
200 % note: this also holds in z_or_tla_minor_mode, we have (-3) mod 2 = 1
201 ? (try_get_set_of_possible_values(A,Hyps1,XSet2,Hyps2),
202 maximal_value(XSet2,Up)
203 -> intersect_sets(XSet1,interval(0,Up),XSet)
204 % we were able to reduce the interval further by finding possible upper-bound for A
205 % we could call improve_upper_bound
206 ; Hyps2=Hyps1, XSet=XSet1).
207 try_get_set_of_possible_values(external_function_call(Name,Args),Hyps,R,Hyps) :-
208 external_function_returns_sequence_type(Name,Args,Hyps,_,R).
209
210 %try_get_set_of_possible_values(X,_,_,_) :- print(try_get_set_of_possible_values_failed(X)),nl,fail.
211 % TO DO: more precise representation of open-ended intervals interval(Low,'$infinity'))
212 % TO DO: intersect multiple solutions; e.g., intervals and >=, <= constraints
213
214 maximal_value(interval(_,Up),Up).
215 maximal_value(value(avl_set(A)),Up) :- avl_max(A,int(Up)).
216 % TO DO: add avl_set
217
218
219 is_integer_set(interval(_,_)).
220 is_integer_set('NATURAL').
221 is_integer_set('NATURAL1').
222 is_integer_set('INTEGER').
223 % TO DO: add avl_set
224
225 % detect sets which can profit from narrowing down:
226 is_infinite__or_large_integer_set('NATURAL',0,inf).
227 is_infinite__or_large_integer_set('NATURAL1',1,inf).
228 %is_infinite__or_large_integer_set('INTEGER',-inf,inf).
229 is_infinite__or_large_integer_set(interval(Low,max_int),Low,max_int). % one cannot prove a lot with max_int anyway!?
230
231 % try and improve precision of integer set
232 % limitation: only looks for one other hypotheses; maybe we should do this in well_defs_hyps.pl
233 improve_integer_set_precision(X,XSet1,Hyps1,NewSet,Hyps3) :-
234 is_integer_set(XSet1),
235 ? avl_fetch_worthwhile_mem_from_hyps(X,Hyps1,XSet2,Hyps2),
236 XSet2 \= XSet1,
237 !,
238 ? intersect_sets(XSet1,XSet2,XSet12),
239 try_improve_interval(XSet12,X,Hyps2,NewSet,Hyps3). % TO DO: we could try and find another member
240 % TO DO: also look at less_equal, greater_equal constraints
241 improve_integer_set_precision(X,XSet1,Hyps1,NewSet,Hyps3) :-
242 is_infinite__or_large_integer_set(XSet1,Low,LargeUp),
243 ? avl_fetch_binop_from_hyps(X,less_equal,Hyps1,Up,Hyps2),
244 Up \= LargeUp, % we really improve upon earlier value
245 !,
246 try_improve_interval(interval(Low,Up),X,Hyps2,NewSet,Hyps3).
247 improve_integer_set_precision(X,XSet1,Hyps1,NewSet,Hyps2) :-
248 try_improve_interval(XSet1,X,Hyps1,NewSet,Hyps2).
249
250 try_improve_interval(interval(OldLow,OldUp),X,Hyps1,interval(NewLow,NewUp),Hyps2) :- !,
251 improve_interval(X,OldLow,OldUp,Hyps1,NewLow,NewUp,Hyps2).
252 try_improve_interval(Set,_,Hyps,Set,Hyps).
253
254 % phase 1: try improve upper bound
255 improve_interval(X,OldLow,OldUp,Hyps1,NewLow,NewUp,Hyps3) :-
256 ? improve_upper_bound(X,OldUp,Hyps1,NewUp1,Hyps2),!,
257 improve_interval(X,OldLow,NewUp1,Hyps2,NewLow,NewUp,Hyps3).
258 improve_interval(X,OldLow,Up,Hyps1,NewLow,Up,Hyps2) :-
259 improve_interval2(X,OldLow,Hyps1,NewLow,Hyps2).
260 %
261 improve_upper_bound(X,OldUp,Hyps1,NewUp,Hyps2) :-
262 ? avl_fetch_binop_from_hyps(X,less_equal,Hyps1,Up,Hyps2),
263 order_values(OldUp,Up,NewUp,OldUp),
264 NewUp \= OldUp.
265
266 % now try and improve lower bound:
267 improve_interval2(X,OldLow,Hyps1,NewLow,Hyps3) :-
268 ? improve_lower_bound(X,OldLow,Hyps1,Low1,Hyps2),!,
269 improve_interval2(X,Low1,Hyps2,NewLow,Hyps3).
270 improve_interval2(_,Low,Hyps,Low,Hyps).
271 %
272 improve_lower_bound(X,OldLow,Hyps1,NewLow,Hyps2) :-
273 ? avl_fetch_binop_from_hyps(X,greater_equal,Hyps1,Low,Hyps2),
274 order_values(Low,OldLow,OldLow,NewLow),
275 NewLow \= OldLow.
276
277
278 % try and intersect two sets:
279 intersect_sets(interval(L1,U1),B,Res) :- !, intersect_interval(B,L1,U1,Res).
280 intersect_sets(B,interval(L1,U1),Res) :- intersect_interval(B,L1,U1,Res).
281 intersect_sets('NATURAL1','NATURAL','NATURAL1').
282 intersect_sets('NATURAL','NATURAL1','NATURAL1').
283 % TODO: support avl_set
284
285 intersect_interval(interval(L2,U2),L1,U1,interval(L3,U3)) :-
286 order_values(L1,L2,_,L3), % choose larger value as lower bound
287 order_values(U1,U2,U3,_). % choose smaller value as upper bound
288 intersect_interval('NATURAL1',L1,U1,interval(L3,U1)) :- order_values(L1,1,L3,_).
289 intersect_interval('NATURAL',L1,U1,interval(L3,U1)) :- order_values(L1,0,L3,_).
290
291 % order values for interval intersection
292 order_values(N1,N2,R1,R2) :- number(N1),!, order_aux_nr(N2,N1,R1,R2).
293 order_values(N1,N2,R1,R2) :- number(N2),!, order_aux_nr(N1,N2,R1,R2).
294 order_values(min_int,N2,R1,R2) :- !, R1=min_int,R2=N2.
295 order_values(max_int,N2,R1,R2) :- !, R1=N2,R2=max_int.
296 order_values(N1,N2,N1,N2). % just choose N1
297
298 order_aux_nr(N2,N1,R1,R2) :- number(N2),!,
299 (N2>N1 -> R1=N1,R2=N2 ; R1=N2,R2=N1).
300 order_aux_nr(max_int,N1,R1,R2) :- N1 < 1, !, R1=N1, R2=max_int.
301 order_aux_nr(_N2,N1,N1,N1). % choose the number as the bound
302
303
304
305 add_to_value_set(interval(L,U),Nr,interval(L2,U2)) :-
306 add_nr(L,Nr,L2),
307 (add_nr(U,Nr,U2) -> true ; Nr =< 0, U2=U). % e.g., if U = size(x) we create an over-approximation
308 add_to_value_set('NATURAL',1,'NATURAL1'). % TO DO: extend
309 %add_to_value_set(value(avl_set(A1),Nr,value(avl_set(A2)) :- TO DO: add Nr to all values in A2
310
311 % adding a known number to an arithmetic expression; could be extended
312 % this is mainly for dealing with index arithmetic for arrays
313 add_nr(Nr1,ToAdd,Nr2) :- number(Nr1),!, Nr2 is Nr1+ToAdd.
314 add_nr(minus(Expr,Nr1),ToAdd,Res) :- number(Nr1),!, Nr2 is Nr1-ToAdd,
315 (Nr2=0 -> Res=Expr ; Res= minus(Expr,Nr2)).
316 add_nr(add(Expr,Nr1),ToAdd,Res) :- number(Nr1),!, Nr2 is Nr1+ToAdd,
317 (Nr2=0 -> Res=Expr ; Res= add(Expr,Nr2)).
318 add_nr(add(Nr1,Expr),ToAdd,Res) :- number(Nr1),!, Nr2 is Nr1+ToAdd,
319 (Nr2=0 -> Res=Expr ; Res= add(Expr,Nr2)).
320
321
322 % check if an expression is a sequence
323 check_is_sequence(El,Hyps) :- check_is_sequence(El,Hyps,_).
324 check_is_non_empty_sequence(El,Hyps) :- check_is_sequence(El,Hyps,seq1).
325
326 check_is_sequence(S,_,seq) :- is_empty_set_direct(S),!.
327 check_is_sequence(El,Hyps,RequiredType) :-
328 ? infer_sequence_type_of_expr(El,Hyps,Type),
329 (Type=seq1 -> true ; RequiredType=seq -> true
330 ; check_not_equal_empty_set(El,Hyps,_)), !.
331 check_is_sequence(A,Hyps,RequiredType) :-
332 ? avl_fetch_worthwhile_equal_from_hyps(A,Hyps,Value,Hyps2),
333 check_is_sequence(Value,Hyps2,RequiredType), !.
334 check_is_sequence(domain_restriction(Dom,S),Hyps,Res) :- !,
335 is_interval(Dom,Hyps,1,N),
336 check_is_sequence(S,Hyps,SeqType),
337 (SeqType=seq1, check_leq(1,N,Hyps) -> Res=seq1 ; Res=seq).
338 check_is_sequence(El,Hyps,RequiredType) :-
339 ? avl_fetch_mem_or_struct(El,Hyps,Set,Hyps2),
340 ? is_set_of_sequences_type(Set,Hyps2,Type), % should we move this to subset? dealt with in subset_transitivity_rule
341 % required for :wd Right:seq(BOOL) & (Right/=[] => tail(Right)=res) in test 2018
342 (Type=seq1 -> true ; RequiredType=seq -> true
343 ? ; check_not_equal_empty_set(El,Hyps2,_)),
344 !.
345 ?check_is_sequence(X,Hyps,RequiredType) :- try_get_set_of_possible_values(X,Hyps,XSet,Hyps2),
346 (RequiredType==seq1 -> check_is_subset(XSet,seq1(typeset),Hyps2,_PT)
347 ; check_is_subset(XSet,seq(typeset),Hyps2,_PT)).
348 % check if something is an interval
349 is_interval(Expr,Hyps,A,B) :- simplify_expr_loop(Expr,Hyps,SE), is_interval_aux(SE,A,B).
350 is_interval_aux(interval(A,B),A,B).
351 is_interval_aux(value(CS),A,B) :- nonvar(CS), CS= avl_set(AVL), avl_is_interval(AVL,A,B).
352
353 is_set_of_sequences_type(seq1(_),_,seq1) :- !.
354 is_set_of_sequences_type(seq(_),_,seq) :- !.
355 is_set_of_sequences_type(iseq(_),_,seq) :- !.
356 is_set_of_sequences_type(iseq1(_),_,seq) :- !.
357 is_set_of_sequences_type(perm(A),Hyps,Type) :- !,
358 (check_not_equal_empty_set(A,Hyps,_) -> Type=seq1 ; Type=seq).
359 is_set_of_sequences_type(Func,Hyps,Type) :- % a total function 1..Up --> Range is a sequence
360 get_exact_domain_of_func_or_rel_type(Func,Hyps,Dom,Hyps1),
361 ? check_equal_pattern(Dom,interval(1,Up),Hyps1,Hyps2),
362 % we could call check_equal for Low; relevant for :wd BV=16 & II=1 & BIdx = II..BV & s:BIdx --> BOOL & res=size(s)
363 is_partial_function_type(Func,Hyps2,_),
364 (number(Up), Up>0 % we could call check_leq
365 -> Type=seq1 ; Type=seq).
366
367 % a simple equality check
368 check_equal_pattern(A,Target,Hyps,Hyps1) :-
369 ? check_equal_h(A,Target,not_ground,[],Hyps,Hyps1).
370 check_equal(A,Target,Hyps,Hyps1) :-
371 ? check_equal_h(A,Target,ground,[],Hyps,Hyps1).
372
373 % TargetGround=ground means Target is a ground, fully known expressions and not a pattern with variables
374 check_equal_h(A,Target,_,_,Hyps,Hyps1) :- %write(check_eq(A,Target)),nl,
375 A=Target,!, Hyps1=Hyps.
376 check_equal_h(BOP1,BOP2,TGr,History,Hyps,Hyps2) :-
377 commutative_bin_op(BOP1,F,A1,A2), commutative_bin_op(BOP2,F,B1,B2),
378 (check_equal_h(A1,B1,TGr,History,Hyps,Hyps1)
379 ? -> !, check_equal_h(A2,B2,TGr,History,Hyps1,Hyps2)
380 ? ; check_equal_h(A1,B2,TGr,History,Hyps,Hyps1)
381 ? -> !, check_equal_h(A2,B1,TGr,History,Hyps1,Hyps2)
382 ).
383 check_equal_h(BOP1,BOP2,TGr,History,Hyps,Hyps2) :-
384 non_commutative_bin_op(BOP1,F,A1,A2), non_commutative_bin_op(BOP2,F,B1,B2),
385 check_equal_h(A1,B1,TGr,History,Hyps,Hyps1),!,
386 check_equal_h(A2,B2,TGr,History,Hyps1,Hyps2).
387 check_equal_h(UNOP1,UNOP2,TGr,History,Hyps,Hyps1) :-
388 unary_op(UNOP1,F,A1), unary_op(UNOP2,F,B1),
389 check_equal_h(A1,B1,TGr,History,Hyps,Hyps1),!.
390 % TO DO: records, ...
391 check_equal_h(A,Target,TGr,History,Hyps,Hyps2) :-
392 ? avl_fetch_equal_from_hyps(A,Hyps,A2,Hyps1), nonmember(A2,History),
393 ? check_equal_h(A2,Target,TGr,[A|History],Hyps1,Hyps2).
394 check_equal_h(A,Target,TGr,History,Hyps,Hyps2) :- Target = '$'(_),
395 ? avl_fetch_equal_from_hyps(Target,Hyps,T2,Hyps1), nonmember(T2,History),
396 ? check_equal_h(A,T2,TGr,[A|History],Hyps1,Hyps2).
397 check_equal_h(A,Target,ground,_,Hyps,Hyps) :-
398 avl_fetch_from_hyps(subset(A,Target),Hyps),
399 avl_fetch_from_hyps(subset(Target,A),Hyps).
400 ?check_equal_h(A,Empty,ground,_,Hyps,Hyps) :- is_empty_set_direct(Empty), !, check_empty_set(A,Hyps,_).
401 check_equal_h(Empty,A,ground,_,Hyps,Hyps) :- is_empty_set_direct(Empty), !, check_empty_set(A,Hyps,_).
402
403 commutative_bin_op(add(X,Y),add,X,Y).
404 commutative_bin_op(intersection(X,Y),intersection,X,Y).
405 commutative_bin_op(multiplication(X,Y),multiplication,X,Y).
406 commutative_bin_op(union(X,Y),union,X,Y).
407
408 non_commutative_bin_op(cartesian_product(X,Y),cartesian_product,X,Y). % TODO: better rule
409 non_commutative_bin_op(concat(X,Y),concat,X,Y).
410 non_commutative_bin_op(couple(X,Y),couple,X,Y).
411 non_commutative_bin_op(direct_product(X,Y),direct_product,X,Y).
412 non_commutative_bin_op(domain_restriction(X,Y),domain_restriction,X,Y).
413 non_commutative_bin_op(domain_subtraction(X,Y),domain_subtraction,X,Y).
414 non_commutative_bin_op(div(X,Y),div,X,Y).
415 non_commutative_bin_op(image(X,Y),image,X,Y).
416 non_commutative_bin_op(interval(X,Y),interval,X,Y). % TODO: better rule, see check_not_equal_interval
417 non_commutative_bin_op(iteration(X,Y),iteration,X,Y).
418 non_commutative_bin_op(minus(X,Y),minus,X,Y).
419 non_commutative_bin_op(modulo(X,Y),modulo,X,Y).
420 non_commutative_bin_op(parallel_product(X,Y),parallel_product,X,Y).
421 non_commutative_bin_op(power_of(X,Y),power_of,X,Y).
422 non_commutative_bin_op(range_restriction(X,Y),range_restriction,X,Y).
423 non_commutative_bin_op(range_subtraction(X,Y),range_subtraction,X,Y).
424 non_commutative_bin_op(restrict_front(X,Y),restrict_front,X,Y).
425 non_commutative_bin_op(restrict_tail(X,Y),restrict_tail,X,Y).
426 non_commutative_bin_op(set_subtraction(X,Y),set_subtraction,X,Y).
427
428 unary_op(closure(X),closure,X).
429 unary_op(card(X),card,X).
430 unary_op(domain(X),domain,X).
431 unary_op(identity(X),identity,X).
432 unary_op(fin_subset(X),fin_subset,X).
433 unary_op(fin1_subset(X),fin1_subset,X).
434 unary_op(first(X),first,X).
435 unary_op(first_of_pair(X),first_of_pair,X).
436 unary_op(front(X),front,X).
437 unary_op(iseq(X),iseq,X).
438 unary_op(iseq1(X),iseq1,X).
439 unary_op(last(X),last,X).
440 unary_op(max(X),max,X).
441 unary_op(min(X),min,X).
442 unary_op(perm(X),perm,X).
443 unary_op(pow_subset(X),pow_subset,X).
444 unary_op(pow1_subset(X),pow1_subset,X).
445 unary_op(range(X),range,X).
446 unary_op(reflexive_closure(X),reflexive_closure,X).
447 unary_op(rev(X),rev,X).
448 unary_op(reverse(X),reverse,X).
449 unary_op(second_of_pair(X),second_of_pair,X).
450 unary_op(seq(X),seq,X).
451 unary_op(seq1(X),seq1,X).
452 unary_op(size(X),size,X).
453 unary_op(tail(X),tail,X).
454 unary_op(unary_minus(X),unary_minus,X).
455
456
457 infer_sequence_type_of_expr(sequence_extension([_|_]),_,seq1).
458 infer_sequence_type_of_expr(sorted_set_extension(SList),_,seq1) :-
459 sorted_set_extension_is_seq(SList,1).
460 infer_sequence_type_of_expr(set_extension(List),_,seq1) :- sort(List,SList),
461 sorted_set_extension_is_seq(SList,1).
462 infer_sequence_type_of_expr(insert_tail(_,_),_,seq1).
463 % we do not need to check Seq is a sequence; this will be checked in its own PO, ditto for operators below
464 infer_sequence_type_of_expr(insert_front(_,_),_,seq1).
465 infer_sequence_type_of_expr(concat(A,B),Hyps,R) :-
466 ? ( infer_sequence_type_of_expr(A,Hyps,seq1) -> R=seq1
467 ? ; infer_sequence_type_of_expr(B,Hyps,seq1) -> R=seq1
468 ; R=seq).
469 infer_sequence_type_of_expr(restrict_front(_,_),_,seq).
470 infer_sequence_type_of_expr(restrict_tail(_,_),_,seq).
471 infer_sequence_type_of_expr(rev(A),Hyps,R) :-
472 (infer_sequence_type_of_expr(A,Hyps,seq1) -> R=seq1 ; R=seq).
473 infer_sequence_type_of_expr(front(_),_,seq). % we could call check_not_empty_set(front(A),Hyps)
474 infer_sequence_type_of_expr(tail(_),_,seq). % ditto
475 infer_sequence_type_of_expr(general_concat(_),_,seq).
476 infer_sequence_type_of_expr(value(avl_set(SeqAVL)),_,seq1) :- !, SeqAVL \= empty,
477 safe_is_avl_sequence(SeqAVL).
478 infer_sequence_type_of_expr(if_then_else(Pred,A,B),Hyps,Type) :- !,
479 push_and_rename_normalized_hyp(Pred,Hyps,Hyps1),
480 (hyps_inconsistent(Hyps1)
481 -> push_and_rename_normalized_hyp(negation(Pred),Hyps,Hyps2),
482 infer_sequence_type_of_expr(B,Hyps2,Type)
483 ? ; infer_sequence_type_of_expr(A,Hyps1,S1),
484 push_and_rename_normalized_hyp(negation(Pred),Hyps,Hyps2),
485 (hyps_inconsistent(Hyps2) -> Type=S1
486 ? ; infer_sequence_type_of_expr(B,Hyps2,S2), lub_seq(S1,S2,Type))
487 ).
488 infer_sequence_type_of_expr(external_function_call(Name,Args),Hyps,R) :-
489 external_function_returns_sequence_type(Name,Args,Hyps,R,_).
490 infer_sequence_type_of_expr(S,_,seq) :- is_empty_set_direct(S).
491 infer_sequence_type_of_expr(Expr,Hyps,R) :-
492 ? is_lambda_function_with_domain(Expr,Domain),
493 Domain = interval(1,N),
494 (check_leq(1,N,Hyps) -> R = seq1 ; R=seq).
495 % TO DO: rule for composition
496
497 lub_seq(seq1,seq1,seq1).
498 lub_seq(seq1,seq,seq).
499 lub_seq(seq,seq1,seq).
500 lub_seq(seq,seq,seq).
501
502 external_function_possible_vals('CHOOSE',[Set],Set).
503 external_function_possible_vals('MU',[Set],Set).
504 external_function_possible_vals('ABS',_,'NATURAL').
505 external_function_possible_vals('LCM',_,'NATURAL').
506 external_function_possible_vals('GCD',_,'NATURAL1').
507 external_function_possible_vals('SIGN',_,interval(-1,1)).
508
509 external_function_returns_sequence_type('STRING_CHARS',[Arg],Hyps,Type,FullType) :- !,
510 (check_not_equal(Arg,string(''),Hyps) -> Type=seq1, FullType=seq1(string) ; Type=seq, FullType=seq(string)).
511 external_function_returns_sequence_type('STRING_CODES',[Arg],Hyps,Type,FullType) :- !,
512 (check_not_equal(Arg,string(''),Hyps) -> Type=seq1, FullType=seq1(integer) ; Type=seq, FullType=seq(integer)).
513 external_function_returns_sequence_type(Name,_Args,_Hyps,Type,FullType) :-
514 external_function_returns_sequence_type(Name,Type,FullType).
515
516 :- use_module(probsrc(external_functions), [external_fun_type/3, performs_io/1]).
517 % external functions which return sequences
518 external_function_returns_sequence_type('STRING_SPLIT',Type,FullType) :- !, Type=seq1, FullType=seq1(string).
519 external_function_returns_sequence_type(Name,seq,seq(Type)) :- external_fun_type(Name,_,List),
520 last(List,ReturnType), nonvar(ReturnType), ReturnType=seq(RType),
521 (ground(RType) -> Type = ReturnType ; Type=typeset). % 'REGEX_SEARCH_ALL', 'REGEX_ISEARCH_ALL', ...
522 % TODO: use hyps, e.g., for STRING_CHARS(X) we have type seq1 if X/=""
523
524 % check if a sorted set extension represent a proper sequence
525 sorted_set_extension_is_seq([],_).
526 sorted_set_extension_is_seq([couple(Nr,_)|T],Nr) :- N1 is Nr+1, sorted_set_extension_is_seq(T,N1).
527
528 % --------
529 % DOMAIN
530
531 % compute exact domain
532 % currently there can be multiple solutions for $(_) case below; first one is usually more precise
533 %compute_exact_domain(Value,Hyps2,Res) :- debug:print_quoted_with_max_depth(compute_exact_domain(Value,Hyps2,Res),4),nl,fail.
534
535
536 compute_exact_domain(assertion_expression(_,_,Func),Hyps,Res,Hyps2) :- !,
537 compute_exact_domain(Func,Hyps,Res,Hyps2).
538 compute_exact_domain(closure(Func),Hyps,Res,Hyps2) :- !, % this is closure1, dom(closure1(R)) = dom(R)
539 compute_exact_domain(Func,Hyps,Res,Hyps2).
540 compute_exact_domain(reverse(Func),Hyps,Res,Hyps2) :- !,
541 ? compute_exact_range(Func,Hyps,Res,Hyps2).
542 compute_exact_domain(rev(Func),Hyps,Res,Hyps2) :- !, % reverse of a sequence; domain identical
543 compute_exact_domain(Func,Hyps,Res,Hyps2).
544 compute_exact_domain(identity(Domain),Hyps,Res,Hyps2) :- !, Hyps2=Hyps, Res=Domain.
545 compute_exact_domain(cartesian_product(A,B),Hyps,Res,Hyps) :-
546 ? check_not_empty_set(B,Hyps), !, Res = A. % B/= {} => dom(A * B) = A
547 %compute_exact_domain(restrict_front(_Seq,N),Hyps,Res,Hyps2) :- !,
548 % % WD Condition requires N : 0..size(Seq);
549 % w/o it we loose the info that 1..N is a subset of dom(Seq); hence we comment this out, see test 2471
550 % Hyps2=Hyps, Res = interval(1,N). % TODO: similar rule for restrict_tail
551 compute_exact_domain(Func,Hyps,Res,Hyps2) :-
552 ? compute_exact_domain_direct(Func,Hyps,Res,Hyps2),!. % No recursive application of equal or hyp
553 compute_exact_domain(Func,Hyps,Domain,Hyps2) :-
554 ? avl_fetch_worthwhile_equal_from_hyps(Func,Hyps,Func2,Hyps1),
555 compute_exact_domain(Func2,Hyps1,Domain,Hyps2).
556 %compute_exact_domain(Expr,_,Domain,_) :- print(compute_exact_domain_failed(Expr,_,Domain)),nl,fail.
557
558
559 compute_exact_domain_direct(Func,Hyps,Res,Hyps2) :-
560 ? avl_fetch_mem_or_struct(Func,Hyps,Function,Hyps1), % look for Func : Res --> Range ; e.g. Func:perm(1..10) -> DomSet=1..10
561 % f : _ +-> ( Dom --> _ ) & x:Dom ==> x:dom(f(_))
562 % f : _ +-> ( Dom --> _ ) => dom(f(_)) = Dom
563 ? get_exact_domain_of_func_or_rel_type(Function,Hyps1,Res,Hyps2),!. % is thus also minimal domain
564 compute_exact_domain_direct(Func,Hyps,Res,Hyps3) :- Func = '$'(_), % Look for Func = Value definition
565 ? avl_fetch_equal_from_hyps(Func,Hyps,Value,Hyps2),
566 ? compute_exact_domain(Value,Hyps2,Res,Hyps3).
567 compute_exact_domain_direct(value(CS),Hyps,value(Res),Hyps) :- !, nonvar(CS),
568 domain_of_explicit_set_wf(CS,Res,no_wf_available).
569 compute_exact_domain_direct(overwrite(F1,F2),Hyps,D12,Hyps2) :- !, % dom(F1 <+ F2) = dom(F1) \/ dom(F2)
570 compute_exact_domain(F1,Hyps,D1,Hyps1), compute_exact_domain(F2,Hyps1,D2,Hyps2),
571 construct_union(D1,D2,Hyps2,D12).
572 compute_exact_domain_direct(domain_restriction(S,F),Hyps,intersection(S,D),Hyps2) :- !, % dom(S <| F) = S /\ dom(F)
573 compute_exact_domain(F,Hyps,D,Hyps2). % SIMP_MULTI_DOM_DOMRES
574 compute_exact_domain_direct(domain_subtraction(S,F),Hyps,set_subtraction(D,S),Hyps2) :- !, % dom(S <<| F) = dom(F) - S
575 compute_exact_domain(F,Hyps,D,Hyps2). % SIMP_MULTI_DOM_DOMSUB
576 compute_exact_domain_direct(direct_product(F,G),Hyps,intersection(DF,DG),Hyps2) :- !, % dom(F><G) = dom(F) /\ dom(G)
577 compute_exact_domain(F,Hyps,DF,Hyps1),
578 compute_exact_domain(G,Hyps1,DG,Hyps2).
579 compute_exact_domain_direct(composition(F1,F2),Hyps,Domain,Hyps4) :- !, % dom((F1;F2)) = dom(F1) if ran(F1) <: dom(F2)
580 compute_exact_domain(F1,Hyps,Domain,Hyps2),
581 compute_exact_domain(F2,Hyps2,D2,Hyps3), % or_subset would also be ok
582 (maximal_set(D2,Hyps3) -> Hyps4=Hyps3
583 ? ; get_range_or_superset(F1,Hyps3,R1,Hyps4),
584 ? check_is_subset(R1,D2,Hyps4,_PT)
585 ).
586 compute_exact_domain_direct(union(F,G),Hyps,UnionDFDG,Hyps2) :- !, % dom(F \/ G) = dom(F) \/ dom(G)
587 compute_exact_domain(F,Hyps,DF,Hyps1),
588 compute_exact_domain(G,Hyps1,DG,Hyps2),
589 construct_union(DF,DG,Hyps2,UnionDFDG).
590 compute_exact_domain_direct(sorted_set_extension(List),Hyps,Res,Hyps2) :- !,
591 compute_exact_domain_direct(set_extension(List),Hyps,Res,Hyps2).
592 compute_exact_domain_direct(set_extension(List),Hyps,Res,Hyps) :- !, maplist(get_dom_el,List,Domain),
593 construct_set_extension(Domain,Hyps,Res).
594 ?compute_exact_domain_direct(Expr,Hyps,Domain,Hyps) :- is_lambda_function_with_domain(Expr,Domain),!.
595 compute_exact_domain_direct(Func,Hyps,Domain,Hyps2) :-
596 ? avl_fetch_equal_from_hyps(domain(Func),Hyps,Domain,Hyps2).
597
598 % get domain element of a couple
599 get_dom_el(couple(A,_),A).
600 % get range element of a couple
601 get_ran_el(couple(_,B),B).
602
603 % construct union term with a few optimisations
604 construct_union(empty_set,B,_Hyps,Res) :- !,Res=B.
605 construct_union(set_extension(A),set_extension(B),Hyps,Res) :- !,
606 append(A,B,AB),
607 construct_set_extension(AB,Hyps,Res).
608 construct_union(A,empty_set,_,Res) :- !,Res=A.
609 construct_union(A,B,_,union(A,B)).
610
611 % get maximal domain of a function (i.e., domain or superset thereof)
612 :- if(environ(prob_safe_mode,true)).
613 get_domain_or_superset(F,H,R,H2) :- nonvar(H2),
614 add_internal_error('Instantiated hyps:',get_domain_or_superset(F,H,R,H2)),fail.
615 :- endif.
616 get_domain_or_superset(reverse(Func),Hyps,Res,Hyps2) :- !,
617 ? get_range_or_superset(Func,Hyps,Res,Hyps2).
618 get_domain_or_superset(domain(F),Hyps,Res,Hyps2) :-
619 get_domain_or_superset(F,Hyps,DomF,Hyps1),
620 get_domain_or_superset(DomF,Hyps1,Res,Hyps2).
621 get_domain_or_superset(range(F),Hyps,Res,Hyps2) :-
622 get_range_or_superset(F,Hyps,RanF,Hyps1),
623 get_domain_or_superset(RanF,Hyps1,Res,Hyps2).
624 get_domain_or_superset(comprehension_set(Ids,Pred),Hyps,comprehension_set(NewIds,Pred2),Hyps) :-
625 append(NewIds,['$'(LastID)],Ids), % we project away last identifier
626 NewIds \= [], % otherwise first and unique id is a pair
627 conj_to_list(Pred,Preds,[]),
628 exclude(uses_id(LastID),Preds,Preds2), % filter out all conjuncts using removed variable
629 Preds2 \= [], % otherwise we simply have truth as body
630 list_to_conj(Preds2,Pred2).
631 get_domain_or_superset(Func,Hyps,Res,Hyps3) :- % sometimes rewrites terms to variables
632 ? compute_exact_domain_direct(Func,Hyps,Res,Hyps2),
633 rewrite_local_loop_check(Func,get_domain_or_superset,Res,Hyps2,Hyps3),
634 !.
635 get_domain_or_superset(domain_restriction(A,_),Hyps,Res,Hyps) :- Res=A. % in case compute_exact_domain_direct fails
636 get_domain_or_superset(Func,Hyps,Res,Hyps1) :-
637 function_restriction(Func,LargerFunc),
638 ? get_domain_or_superset(LargerFunc,Hyps,Res,Hyps1).
639 ?get_domain_or_superset(composition(F1,_),Hyps,Res,Hyps1) :- get_domain_or_superset(F1,Hyps,Res,Hyps1).
640 get_domain_or_superset(cartesian_product(A,_),Hyps,Res,Hyps) :- !, Res=A. % dom(A*B) <: A
641 get_domain_or_superset(direct_product(A,B),Hyps,Res,Hyps2) :- % dom(A >< B) = dom(A) /\ dom (B)
642 ? (get_domain_or_superset(A,Hyps,Res,Hyps2) -> true
643 ; get_domain_or_superset(B,Hyps,Res,Hyps2) -> true).
644 get_domain_or_superset(tail(Seq),Hyps,Res,Hyps2) :- !, % dom(tail(S)) <: dom(S)
645 ? get_domain_or_superset(Seq,Hyps,Res,Hyps2).
646 get_domain_or_superset(front(Seq),Hyps,Res,Hyps2) :- !, % dom(front(S)) <: dom(S)
647 ? get_domain_or_superset(Seq,Hyps,Res,Hyps2).
648 get_domain_or_superset(restrict_front(Seq,K),Hyps,Res,Hyps2) :- !, % dom(S /|\ k) <: dom(S)
649 ? (get_domain_or_superset(Seq,Hyps,Res,Hyps2)
650 ; Res = interval(1,K), Hyps2=Hyps % WD Condition requires K : 0..size(Seq)
651 ).
652 get_domain_or_superset(restrict_tail(Seq,_),Hyps,Res,Hyps2) :- !, % dom(S \|/ k) <: dom(S)
653 ? get_domain_or_superset(Seq,Hyps,Res,Hyps2).
654 get_domain_or_superset(Func,Hyps,DomSet,Hyps2) :- simple_value(Func),
655 ? avl_fetch_mem_or_struct(Func,Hyps,FunctionType,Hyps1),
656 get_domain_or_superset_of_func_or_rel_type(FunctionType,Hyps1,DomSet,Hyps2),
657 ? \+ maximal_set(DomSet,Hyps2). % inference useless
658 get_domain_or_superset(Func,Hyps,Domain,Hyps2) :-
659 ? avl_fetch_worthwhile_equal_from_hyps(Func,Hyps,Func2,Hyps1),
660 ? get_domain_or_superset(Func2,Hyps1,Domain,Hyps2).
661 get_domain_or_superset(Func,Hyps,DomSuperSet,Hyps2) :-
662 ? avl_fetch_binop_from_hyps(domain(Func),subset,Hyps,DomSuperSet,Hyps2).
663
664 ?uses_id(ID,Expr) :- occurs(Expr,ID).
665
666 % get exact (thus also minimal) domain of a function type
667 :- if(environ(prob_safe_mode,true)).
668 get_exact_domain_of_func_or_rel_type(F,H,R,H2) :-
669 nonvar(H2), add_internal_error('Instantiated hyps:',get_exact_domain_of_func_or_rel_type(F,H,R,H2)),fail.
670 :- endif.
671 get_exact_domain_of_func_or_rel_type(FunType,Hyps,A,Hyps) :-
672 get_possible_domain_of_func_or_rel_type(FunType,Hyps,A,exact),!.
673 get_exact_domain_of_func_or_rel_type(FunType,Hyps,Domain,Hyps2) :-
674 ? avl_fetch_worthwhile_equal_from_hyps(FunType,Hyps,FunType2,Hyps1), % in case we have a definition like X = 1..n --> R
675 get_exact_domain_of_func_or_rel_type(FunType2,Hyps1,Domain,Hyps2).
676 get_exact_domain_of_func_or_rel_type(sorted_set_extension(F),Hyps,Domain,Hyps2) :- !,
677 get_exact_domain_of_func_or_rel_type(set_extension(F),Hyps,Domain,Hyps2).
678 get_exact_domain_of_func_or_rel_type(set_extension([Func|TF]),Hyps,Domain,Hyps2) :-
679 compute_exact_domain(Func,Hyps,Domain,Hyps2), % now check that all other functions have the same domain
680 ? (member(Func2,TF), \+ compute_exact_domain(Func2,Hyps2,Domain,_) -> fail
681 ; true).
682
683 get_possible_domain_of_func_or_rel_type(iseq(_),_,'NATURAL1',subset).
684 get_possible_domain_of_func_or_rel_type(iseq1(_),_,'NATURAL1',subset).
685 get_possible_domain_of_func_or_rel_type(partial_bijection(A,_),_,A,subset).
686 get_possible_domain_of_func_or_rel_type(partial_function(A,_),_,A,subset).
687 get_possible_domain_of_func_or_rel_type(partial_injection(A,_),_,A,subset).
688 get_possible_domain_of_func_or_rel_type(partial_surjection(A,_),_,A,subset).
689 get_possible_domain_of_func_or_rel_type(perm(A),Hyps,Domain,Type) :-
690 (compute_card_of_set(A,Hyps,CardA,_) % we could do check_finite and use card(A) instead of CardA
691 -> Domain = interval(1,CardA), Type=exact
692 ; check_finite(A,Hyps,_) -> Domain = interval(1,card(A)), Type=exact
693 ; %print(could_not_compute_card_for_perm(A)),nl,
694 Domain = 'NATURAL1', Type=subset
695 ).
696 get_possible_domain_of_func_or_rel_type(relations(A,_),_,A,subset).
697 get_possible_domain_of_func_or_rel_type(pow_subset(cartesian_product(A,_)),_,A,subset).
698 get_possible_domain_of_func_or_rel_type(pow1_subset(cartesian_product(A,_)),_,A,subset).
699 get_possible_domain_of_func_or_rel_type(fin_subset(cartesian_product(A,_)),_,A,subset).
700 get_possible_domain_of_func_or_rel_type(fin1_subset(cartesian_product(A,_)),_,A,subset).
701 get_possible_domain_of_func_or_rel_type(seq(_),_,'NATURAL1',subset).
702 get_possible_domain_of_func_or_rel_type(seq1(_),_,'NATURAL1',subset).
703 get_possible_domain_of_func_or_rel_type(surjection_relation(A,_),_,A,subset).
704 get_possible_domain_of_func_or_rel_type(total_bijection(A,_),_,A,exact).
705 get_possible_domain_of_func_or_rel_type(total_function(A,_),_,A,exact).
706 get_possible_domain_of_func_or_rel_type(total_injection(A,_),_,A,exact).
707 get_possible_domain_of_func_or_rel_type(total_relation(A,_),_,A,exact).
708 get_possible_domain_of_func_or_rel_type(total_surjection_relation(A,_),_,A,exact).
709 get_possible_domain_of_func_or_rel_type(total_surjection(A,_),_,A,exact).
710
711
712 % variation of get_possible_domain_of_func_or_rel_type, which uses Hyps and can deal with set_extensions
713 :- if(environ(prob_safe_mode,true)).
714 get_domain_or_superset_of_func_or_rel_type(F,H,R,H2) :- nonvar(H2),
715 add_internal_error('Instantiated hyps:',get_domain_or_superset_of_func_or_rel_type(F,H,R,H2)),fail.
716 :- endif.
717 get_domain_or_superset_of_func_or_rel_type(sorted_set_extension(List),Hyps,Dom,Hyps2) :- !,
718 get_domain_or_superset_of_func_or_rel_type(set_extension(List),Hyps,Dom,Hyps2).
719 get_domain_or_superset_of_func_or_rel_type(set_extension(List),Hyps,Dom,Hyps2) :- !,
720 % if we have f: {f1,f2,...} => dom(f) <: dom(f1) \/ dom(f2) \/ ...
721 merge_possible_domains_of_list(List,Hyps,empty_set,Dom,Hyps2).
722 get_domain_or_superset_of_func_or_rel_type(Func,Hyps,Res,Hyps) :-
723 get_possible_domain_of_func_or_rel_type(Func,Hyps,D,_),!,Res=D.
724
725 % merge domains of a list of possible functions
726 merge_possible_domains_of_list([],Hyps,Acc,Acc,Hyps).
727 merge_possible_domains_of_list([H|T],Hyps,Acc,Res,Hyps2) :-
728 get_domain_or_superset(H,Hyps,Domain,Hyps1),!,
729 construct_union(Acc,Domain,Hyps1,Acc1),
730 merge_possible_domains_of_list(T,Hyps1,Acc1,Res,Hyps2).
731
732 % RANGE
733 % -----
734
735 % compute range or subset thereof
736
737 compute_exact_range(assertion_expression(_,_,Func),Hyps,Res,Hyps2) :- !,
738 compute_exact_range(Func,Hyps,Res,Hyps2).
739 compute_exact_range(closure(Func),Hyps,Res,Hyps2) :- !, % this is closure1, range(closure1(R)) = ran(R)
740 compute_exact_range(Func,Hyps,Res,Hyps2).
741 compute_exact_range(reverse(Func),Hyps,Res,Hyps2) :-
742 compute_exact_domain(Func,Hyps,Res,Hyps2).
743 compute_exact_range(rev(Func),Hyps,Res,Hyps2) :- % reverse of a sequence: same range
744 compute_exact_range(Func,Hyps,Res,Hyps2).
745 compute_exact_range(identity(Domain),Hyps,Res,Hyps2) :- !, Hyps2=Hyps, Res=Domain.
746 compute_exact_range(Func,Hyps,Res,Hyps2) :-
747 ? compute_exact_range_direct(Func,Hyps,Res,Hyps2),!. % No recursive application of equal or hyp
748 compute_exact_range(Func,Hyps,Res,Hyps2) :- Func = '$'(_),
749 ? avl_fetch_mem_or_struct(Func,Hyps,FunctionType,Hyps2), % Func : _ --> Res
750 get_exact_range_of_func_type_direct(FunctionType,Res).
751 compute_exact_range(Func,Hyps,Range,Hyps2) :-
752 ? avl_fetch_worthwhile_equal_from_hyps(Func,Hyps,Func2,Hyps1),
753 compute_exact_range(Func2,Hyps1,Range,Hyps2).
754 %compute_exact_range(Expr,H,Domain) :- nl,portray_hyps(H),nl,print(compute_range_failed(Expr,_,Domain)),nl,fail.
755 % TO DO: rule for composition (exact case)
756
757
758 compute_exact_range_direct(S,Hyps,empty_set,Hyps) :- is_empty_set_direct(S),!.
759 compute_exact_range_direct(function(Func2,_),Hyps,Res,Hyps2) :-
760 % f : _ +-> ( _ --> Ran ) & x:Ran ==> x:ran(f(_))
761 % f : _ +-> ( _ -->> Ran ) => ran(f(_)) = Ran
762 ? get_range_or_superset(Func2,Hyps,Range,Hyps2),
763 get_exact_range_of_func_type_direct(Range,Res). % is thus also minimal domain
764 compute_exact_range_direct(value(CS),Hyps,value(Res),Hyps) :- !, nonvar(CS), % TO DO: maybe only if small enough
765 range_of_explicit_set_wf(CS,Res,no_wf_available).
766 compute_exact_range_direct(sequence_extension(L),Hyps,Res,Hyps) :- !,
767 construct_set_extension(L,Hyps,Res).
768 compute_exact_range_direct(union(F,G),Hyps,UnionRFRG,Hyps2) :- !, % ran(F \/ G) = ran(F) \/ ran(G)
769 compute_exact_range(F,Hyps,RF,Hyps1),
770 compute_exact_range(G,Hyps1,RG,Hyps2),
771 construct_union(RF,RG,Hyps2,UnionRFRG).
772 compute_exact_range_direct(cartesian_product(A,B),Hyps,Res,Hyps) :-
773 check_not_empty_set(A,Hyps),!, Res=B. % A/={} => ran(A * B) = B
774 compute_exact_range_direct(sorted_set_extension(List),Hyps,Res,Hyps2) :- !,
775 compute_exact_range_direct(set_extension(List),Hyps,Res,Hyps2).
776 compute_exact_range_direct(set_extension(List),Hyps,Res,Hyps) :- !, maplist(get_ran_el,List,Domain),
777 construct_set_extension(Domain,Hyps,Res).
778 compute_exact_range_direct(Func,Hyps,Range,Hyps2) :-
779 ? avl_fetch_equal_from_hyps(range(Func),Hyps,Range,Hyps2).
780
781 % get maximal range of a function (i.e., range or superset thereof)
782 :- if(environ(prob_safe_mode,true)).
783 get_range_or_superset(P,H,R,H1) :- nonvar(H1), add_internal_error('Illegal hyps:',get_range_or_superset(P,H,R,H1)),fail.
784 :- endif.
785 get_range_or_superset(reverse(Func),Hyps,Res,Hyps2) :- !,
786 ? get_domain_or_superset(Func,Hyps,Res,Hyps2).
787 get_range_or_superset(domain(F),Hyps,Res,Hyps2) :-
788 get_domain_or_superset(F,Hyps,DomF,Hyps1),
789 get_range_or_superset(DomF,Hyps1,Res,Hyps2).
790 get_range_or_superset(range(F),Hyps,Res,Hyps2) :-
791 get_range_or_superset(F,Hyps,RanF,Hyps1),
792 get_range_or_superset(RanF,Hyps1,Res,Hyps2).
793 get_range_or_superset(Func,Hyps,Res,Hyps3) :-
794 ? compute_exact_range_direct(Func,Hyps,Res,Hyps2),
795 rewrite_local_loop_check(Func,get_range_or_superset,Res,Hyps2,Hyps3),
796 !. % can be a loop dom(f) = ran(g)
797 get_range_or_superset(function(Func2,_),Hyps,Res,Hyps2) :-
798 % f2 : _ +-> ( _ --> Res ) ==> ran(f2(.)) <: Res
799 ? get_range_or_superset(Func2,Hyps,Range,Hyps1),
800 get_possible_range_of_func_or_rel_type(Range,Hyps1,Res,_,Hyps2).
801 % TODO: try rewrite_function_application(Func,Args,Hyps,Result,Hyps2) ?
802 get_range_or_superset(range_restriction(_,B),Hyps,Res,Hyps) :- Res=B. % in case compute_exact_range_direct fails
803 get_range_or_superset(Func,Hyps,Res,Hyps1) :-
804 function_restriction(Func,LargerFunc),
805 ? get_range_or_superset(LargerFunc,Hyps,Res,Hyps1).
806 get_range_or_superset(Func,Hyps,RangeSet,Hyps2) :- simple_value(Func),
807 ? avl_fetch_mem_or_struct(Func,Hyps,FunctionType,Hyps1),
808 ? get_possible_range_of_func_or_rel_type(FunctionType,Hyps1,RangeSet,_,Hyps2),
809 ? \+ maximal_set(RangeSet,Hyps2). % inference useless.
810 get_range_or_superset(tail(Seq),Hyps,Res,Hyps2) :- !, % ran(tail(S)) <: ran(S)
811 ? get_range_or_superset(Seq,Hyps,Res,Hyps2).
812 get_range_or_superset(front(Seq),Hyps,Res,Hyps2) :- !, % ran(front(S)) <: ran(S)
813 get_range_or_superset(Seq,Hyps,Res,Hyps2).
814 get_range_or_superset(restrict_front(Seq,_),Hyps,Res,Hyps2) :- !, % /|\
815 get_range_or_superset(Seq,Hyps,Res,Hyps2).
816 get_range_or_superset(restrict_tail(Seq,_),Hyps,Res,Hyps2) :- !,
817 get_range_or_superset(Seq,Hyps,Res,Hyps2).
818 get_range_or_superset(concat(Seq1,Seq2),Hyps,Res12,Hyps2) :- !, % ran(S1^S2) = ran(S1) \/ ran(S2)
819 get_range_or_superset(Seq1,Hyps,Res1,Hyps2),
820 get_range_or_superset(Seq2,Hyps,Res2,Hyps2),
821 construct_union(Res1,Res2,Hyps2,Res12).
822 get_range_or_superset(composition(_,Func2),Hyps,Res2,Hyps2) :- !, % ran((F1;F2)) <: ran(F2)
823 ? get_range_or_superset(Func2,Hyps,Res2,Hyps2).
824 get_range_or_superset(cartesian_product(_,B),Hyps,Res,Hyps) :- !, Res=B. % ran(A*B) <: B
825 get_range_or_superset(Func,Hyps,Range,Hyps2) :-
826 ? avl_fetch_worthwhile_equal_from_hyps(Func,Hyps,Func2,Hyps1),
827 ? get_range_or_superset(Func2,Hyps1,Range,Hyps2).
828 get_range_or_superset(Func,Hyps,RangeSuperSet,Hyps2) :-
829 ? avl_fetch_binop_from_hyps(range(Func),subset,Hyps,RangeSuperSet,Hyps2).
830 get_range_or_superset(comprehension_set(IDS,Body),Hyps,RangeSuperSet,Hyps2) :-
831 ? get_lambda_args_and_body(IDS,Body,_,Expr,RestIDs,RestBodyList),
832 add_new_hyp_any_vars(Hyps,RestIDs,Hyps0), % do not infer anything about lambda vars
833 get_clash_renaming_subst(Hyps0,Renaming),
834 l_push_normalized_hyp(RestBodyList,Renaming,Hyps0,Hyps1),
835 (hyps_inconsistent(Hyps1) -> RangeSuperSet = empty_set, Hyps2=Hyps
836 ? ; rename_norm_term(Expr,Renaming,RNExpr),
837 ? try_get_set_of_possible_values(RNExpr,Hyps1,RangeSuperSet,Hyps2)
838 ).
839 % get_range_or_superset(Func,_,_,_) :- print(get_range_or_superset_failed(Func)),nl,fail.
840 % to do: more sequence operations: insert_front, insert_tail
841
842 l_push_normalized_hyp([],_,Hyp,Hyp).
843 l_push_normalized_hyp([H|T],Renaming,Hyp0,Hyp2) :-
844 rename_norm_term(H,Renaming,RenamedH),
845 push_normalized_hyp(RenamedH,Hyp0,Hyp1),
846 l_push_normalized_hyp(T,Renaming,Hyp1,Hyp2).
847
848 % get exact range without equality rewrites
849 get_exact_range_of_func_type_direct(Func,R) :-
850 get_possible_range_of_func_or_rel_type_direct(Func,R,exact).
851 % TO DO: maybe do same treatment for set_extension as in get_exact_domain_of_func_or_rel_type
852
853 % get possible range with equality rewrites
854 get_possible_range_of_func_or_rel_type(Func,Hyps,Range,ResType,Hyps2) :-
855 get_possible_range_of_func_or_rel_type_direct(Func,Range,Type),!, ResType=Type,Hyps2=Hyps.
856 get_possible_range_of_func_or_rel_type(Func,Hyps,Range,ResType,Hyps2) :-
857 ? avl_fetch_worthwhile_equal_from_hyps(Func,Hyps,Func2,Hyps1),
858 get_possible_range_of_func_or_rel_type(Func2,Hyps1,Range,ResType,Hyps2).
859
860 % get possible range without equality rewrites
861 get_possible_range_of_func_or_rel_type_direct(total_function(_,B),B,subset).
862 get_possible_range_of_func_or_rel_type_direct(total_injection(_,B),B,subset).
863 get_possible_range_of_func_or_rel_type_direct(total_surjection(_,B),B,exact).
864 get_possible_range_of_func_or_rel_type_direct(total_bijection(_,B),B,exact).
865 get_possible_range_of_func_or_rel_type_direct(total_relation(_,B),B,subset).
866 get_possible_range_of_func_or_rel_type_direct(total_surjection_relation(_,B),B,exact).
867 get_possible_range_of_func_or_rel_type_direct(partial_function(_,B),B,subset).
868 get_possible_range_of_func_or_rel_type_direct(partial_injection(_,B),B,subset).
869 get_possible_range_of_func_or_rel_type_direct(partial_surjection(_,B),B,exact).
870 get_possible_range_of_func_or_rel_type_direct(partial_bijection(_,B),B,exact).
871 get_possible_range_of_func_or_rel_type_direct(perm(B),B,exact).
872 get_possible_range_of_func_or_rel_type_direct(iseq(B),B,subset).
873 get_possible_range_of_func_or_rel_type_direct(iseq1(B),B,subset).
874 get_possible_range_of_func_or_rel_type_direct(seq(B),B,subset).
875 get_possible_range_of_func_or_rel_type_direct(seq1(B),B,subset).
876 get_possible_range_of_func_or_rel_type_direct(relations(_,B),B,subset).
877 get_possible_range_of_func_or_rel_type_direct(surjection_relation(_,B),B,exact).
878 get_possible_range_of_func_or_rel_type_direct(pow_subset(cartesian_product(_,B)),B,subset).
879 get_possible_range_of_func_or_rel_type_direct(pow1_subset(cartesian_product(_,B)),B,subset).
880 get_possible_range_of_func_or_rel_type_direct(fin_subset(cartesian_product(_,B)),B,subset).
881 get_possible_range_of_func_or_rel_type_direct(fin1_subset(cartesian_product(_,B)),B,subset).
882
883
884 % EXACT REWRITING/SIMPLIFICATION RULES
885
886 % simplifier, useful rules independent of context
887 simplify_expr(A,Hyps,Res) :-
888 simplify_expr(A,Hyps,1,Res). % no repeated applications of rule
889 simplify_expr_loop(A,Hyps,Res) :-
890 simplify_expr(A,Hyps,3,Res). % which value to use here?
891 simplify_expr(A,Hyps,MaxLoop,Res) :-
892 ? rewrite_set_expression_exact(A,Hyps,A2,Hyps2),!,
893 simplify_iter(A2,Hyps2,MaxLoop,Res).
894 simplify_expr(A,Hyps,MaxLoop,Res) :-
895 rewrite_integer(A,Hyps,A2,Hyps2),!,
896 simplify_iter(A2,Hyps2,MaxLoop,Res).
897 simplify_expr(record_field(rec(Fields),Field),Hyps,MaxLoop,SExpr) :-
898 member(field(Field,Expr),Fields),!,
899 simplify_expr(Expr,Hyps,MaxLoop,SExpr).
900 simplify_expr(domain(A),Hyps,MaxLoop,Res) :-
901 simplify_domain(A,SA),!,simplify_expr(SA,Hyps,MaxLoop,Res).
902 simplify_expr(range(A),Hyps,MaxLoop,Res) :-
903 simplify_range(A,SA),!,simplify_expr(SA,Hyps,MaxLoop,Res).
904 simplify_expr(E,_,_,E).
905
906 simplify_iter(A,Hyps,MaxLoop,Res) :- MaxLoop > 1,!,
907 M1 is MaxLoop-1, simplify_expr(A,Hyps,M1,Res).
908 simplify_iter(A,_,_,A).
909
910 simplify_domain(reverse(A),range(A)).
911 simplify_domain(closure(A),domain(A)). % rx : A <-> B <=> closure1(rx) : A <-> B
912 simplify_range(reverse(A),domain(A)).
913 simplify_range(closure(A),range(A)). % rx : A <-> B <=> closure1(rx) : A <-> B
914
915 get_lambda_args_and_body(IDS,Body,LambdaID,LambdaExpr,RestArgs,RestBodyList) :-
916 LambdaID='$'(Lambda),
917 append(RestArgs,[LambdaID],IDS), % TO DO: pass lambda info from typed unnormalized expression!
918 conj_to_list(Body,BodyList,[]),
919 ? select(equal(A,B),BodyList,RestBodyList),
920 ( A=LambdaID, not_occurs(B,Lambda), LambdaExpr=B
921 ; B=LambdaID, not_occurs(A,Lambda), LambdaExpr=A
922 ).
923
924 % just check if something is a lambda function or similar, without computing exact domain
925 is_lambda_function(comprehension_set(IDS,Body)) :- !,
926 ? get_lambda_args_and_body(IDS,Body,_,_,_,_).
927 ?is_lambda_function(Expr) :- is_lambda_function_with_domain(Expr,_).
928
929 % determine if something is a lambda function and determine exact domain:
930 is_lambda_function_with_domain(comprehension_set(IDS,Body),Set) :-
931 ? get_lambda_args_and_body(IDS,Body,_,_,Args,RestBodyList),
932 get_argument_types(Args,Args,RestBodyList,ArgTypes),
933 create_cartesian_product(ArgTypes,Set).
934 is_lambda_function_with_domain(cartesian_product(Domain,Set),Domain) :-
935 singleton_set(Set,_).
936 is_lambda_function_with_domain(set_extension([couple(El,_)]),set_extension([El])).
937 is_lambda_function_with_domain(Set,singleton_set([El])) :- singleton_set(Set,couple(El,_)). % TO DO: longer lists and check no multiple domain elements
938 is_lambda_function_with_domain(sequence_extension(List),interval(1,Len)) :- length(List,Len).
939 % we could treat domain_restriction, domain_subtraction here
940
941 singleton_set(set_extension([El]),El).
942 singleton_set(sorted_set_extension([El]),El).
943
944 conj_to_list(conjunct(A,B)) --> !, conj_to_list(A),conj_to_list(B).
945 conj_to_list(X) --> [X].
946
947 list_to_conj([],truth).
948 list_to_conj([X],Res) :- !, Res=X.
949 list_to_conj([H|T],conjunct(H,R)) :- list_to_conj(T,R).
950
951 :- use_module(probsrc(tools),[map_split_list/4]).
952 % we support Arg:Set and we support an argument not appearing at all (equivalent to Arg:typeset)
953 get_argument_types([],_,[],[]). % no other conjuncts remain in body
954 get_argument_types(['$'(ID1)|T],AllArgs,BodyList,[Set1|TS]) :-
955 map_split_list(typing_predicate_for(ID1,AllArgs),BodyList,TypingSetList,RestBody),
956 create_intersection(TypingSetList,Set1),
957 get_argument_types(T,AllArgs,RestBody,TS).
958
959 % check if we have a typing predicate for a given identifier
960 typing_predicate_for(ID1,AllArgs,member('$'(ID1),Set1),Set1) :- l_not_occurs(Set1,AllArgs).
961 typing_predicate_for(ID1,AllArgs,subset('$'(ID1),SSet1),pow_subset(SSet1)) :- l_not_occurs(SSet1,AllArgs).
962
963 % check if any argument appears in expression; if so we have a link between arguments and no proper type
964 ?l_not_occurs(Expr,AllArgs) :- member('$'(ID),AllArgs), occurs(Expr,ID),!,fail.
965 l_not_occurs(_,_).
966
967 create_intersection([],typeset). % no constraints on identifier: use typeset
968 create_intersection([A],Res) :- !, Res=A.
969 create_intersection([A|T],intersection(A,Rest)) :- create_intersection(T,Rest).
970
971 create_cartesian_product([Type],Res) :- !, Res=Type.
972 create_cartesian_product([Type|T],Res) :- create_cartesian_product3(T,Type,Res).
973
974 create_cartesian_product3([],Res,Res).
975 create_cartesian_product3([Type|T],Acc,Res) :-
976 create_cartesian_product3(T,cartesian_product(Acc,Type),Res).
977 % Note: dom(%(x,y,z).(x:BOOL & y:1..2 & z:BOOL|1)) = (BOOL*(1..2))*BOOL
978
979 % ------------------------
980
981 % Partial Function Check:
982
983 % check if Func : Domain +-> Range
984 ?check_is_partial_function_with_type(Func,_,_,Hyps,empty_set(PT)) :- check_equal_empty_set(Func,Hyps,PT),!.
985 check_is_partial_function_with_type(Func,Domain,Range,Hyps,pfun(PTD,PTR)) :-
986 ? check_is_partial_function(Func,Hyps),!,
987 ? (maximal_set(Domain,Hyps) -> PTD=maximal_domain ; check_is_subset(domain(Func),Domain,Hyps,PTD)),!,
988 ? (maximal_set(Range,Hyps) -> PTR=maximal_range ; check_is_subset(range(Func),Range,Hyps,PTR)).
989
990 % various way to make a function smaller, related to subset
991 function_restriction(domain_subtraction(_,F),F).
992 function_restriction(domain_restriction(_,F),F).
993 function_restriction(range_subtraction(F,_),F).
994 function_restriction(range_restriction(F,_),F).
995 function_restriction(set_subtraction(F,_),F).
996
997 % check if Func : DomTYPE +-> RanTYPE
998 % check if we can deduce from the Hypotheses that something is a partial function
999 check_is_partial_function(Func,Hyps) :-
1000 ? avl_fetch_mem_or_struct(Func,Hyps,Function,Hyps1),
1001 % also deals with function(_) f : _ +-> ( _ +-> _ ) => f(_) : _ +-> _
1002 ? is_partial_function_type(Function,Hyps1,_),!.
1003 check_is_partial_function(reverse(Func),Hyps) :-
1004 ? check_is_injective(Func,Hyps),!.
1005 check_is_partial_function(value(avl_set(AVL)),_) :- !,
1006 nonvar(AVL),
1007 is_avl_partial_function(AVL).
1008 check_is_partial_function(composition(F1,F2),Hyp) :- !,
1009 % composition of two partial functions is a partial function
1010 ? (check_is_partial_function(F1,Hyp)
1011 ? -> check_is_partial_function(F2,Hyp)
1012 ).
1013 check_is_partial_function(overwrite(F1,F2),Hyp) :- !,
1014 % overwrite of two partial functions is a partial function
1015 ? (check_is_partial_function(F1,Hyp)
1016 -> check_is_partial_function(F2,Hyp)
1017 ).
1018 check_is_partial_function(direct_product(F1,F2),Hyp) :- !,
1019 % direct_product of two partial functions is a partial function a:A+->B & b:A+->C => a><b : A+->(B*C)
1020 (check_is_partial_function(F1,Hyp)
1021 -> check_is_partial_function(F2,Hyp)
1022 ).
1023 check_is_partial_function(identity(_),_Hyp) :- !.
1024 check_is_partial_function(Func,Hyp) :- function_restriction(Func,LargerFunc), !,
1025 check_is_partial_function(LargerFunc,Hyp).
1026 check_is_partial_function(intersection(F1,F2),Hyp) :- !,
1027 (check_is_partial_function(F1,Hyp) -> true ; check_is_partial_function(F2,Hyp)).
1028 check_is_partial_function(sorted_set_extension(List),Hyp) :- !,
1029 check_set_extension_is_partial_function(List,Hyp).
1030 check_is_partial_function(set_extension(List),Hyp) :- !,
1031 check_set_extension_is_partial_function(List,Hyp).
1032 check_is_partial_function(Expr,_) :-
1033 ? is_lambda_function(Expr),!. % also treats cartesian_product and sequence_extension
1034 % check_is_partial_function(X,_Hyp) :- is_empty_set_direct(X),!. % covered by infer_sequence_type_of_expr below
1035 check_is_partial_function(Expr,Hyps) :-
1036 ? infer_sequence_type_of_expr(Expr,Hyps,_),!. % any sequence expression is a partial function; e.g. a <- b, front(.)
1037 ?check_is_partial_function(Func,Hyps) :- rewrite_set_expression_exact(Func,Hyps,NewFunc,Hyps2),!,
1038 check_is_partial_function(NewFunc,Hyps2).
1039 check_is_partial_function(union(F1,F2),Hyps) :-
1040 check_is_subset(F1,F2,Hyps,_),!,
1041 check_is_partial_function(F2,Hyps).
1042 check_is_partial_function(union(F1,F2),Hyps) :-
1043 check_is_subset(F2,F1,Hyps,_),!,
1044 check_is_partial_function(F1,Hyps).
1045 check_is_partial_function(union(F1,F2),Hyps) :- !,
1046 check_domain_disjoint(F1,F2,Hyps,Hyps2), % domain must be disjoint, not F1 and F2
1047 check_is_partial_function(F1,Hyps2),
1048 check_is_partial_function(F2,Hyps2).
1049 check_is_partial_function(Func,Hyps) :- % f<:g & g: A +-> B => f : A +-> B
1050 (Op = equal ; Op = subset),
1051 ? avl_fetch_binop_from_hyps(Func,Op,Hyps,Func2,Hyps1),
1052 quick_not_occurs_check(Func,Func2),
1053 ? check_is_partial_function(Func2,Hyps1).
1054
1055 check_domain_disjoint(F1,F2,Hyps,Hyps2) :-
1056 compute_exact_domain(F1,Hyps,DF1,Hyps2),
1057 % example: :prove f:BOOL +-> BOOL & x /: dom(f) => f \/ {x|->TRUE} : BOOL +-> BOOL
1058 is_set_extension(DF1,List1),!,
1059 l_check_not_member_of_set(List1,domain(F2),Hyps2). % we could try and compute domain(F2) first
1060 check_domain_disjoint(F2,F1,Hyps,Hyps2) :-
1061 compute_exact_domain(F1,Hyps,DF1,Hyps2),
1062 is_set_extension(DF1,List1),!,
1063 l_check_not_member_of_set(List1,domain(F2),Hyps2).
1064 check_domain_disjoint(F1,F2,Hyps,Hyps2) :-
1065 ? get_domain_or_superset(F1,Hyps,DomFunc1,Hyps1),
1066 get_domain_or_superset(F2,Hyps1,DomFunc2,Hyps2),
1067 check_disjoint(DomFunc1,DomFunc2,Hyps2).
1068
1069 %check_is_partial_function(Func,_) :- print(check_is_partial_function_failed(Func)),nl,fail.
1070
1071 % check if this is a partial function type or something defined to be equal to a function type
1072 :- if(environ(prob_safe_mode,true)).
1073 is_partial_function_type(P,H,H1) :- nonvar(H1),
1074 add_internal_error('Illegal hyps:',is_partial_function_type(P,H,H1)),fail.
1075 :- endif.
1076 is_partial_function_type(PF,Hyps,Hyps1) :- is_partial_function(PF,_,_),!,Hyps1=Hyps.
1077 is_partial_function_type(range(Func),Hyps,Hyps2) :-
1078 ? get_range_or_superset(Func,Hyps,RanFunc,Hyps1),!,
1079 is_partial_function_type(RanFunc,Hyps1,Hyps2).
1080 is_partial_function_type(domain(Func),Hyps,Hyps2) :-
1081 get_domain_or_superset(Func,Hyps,DomFunc,Hyps1),!,
1082 is_partial_function_type(DomFunc,Hyps1,Hyps2).
1083 is_partial_function_type(sorted_set_extension(Funcs),Hyps,Hyps2) :- !,
1084 is_partial_function_type(set_extension(Funcs),Hyps,Hyps2).
1085 is_partial_function_type(set_extension(Funcs),Hyps,Hyps2) :- !,
1086 ? (member(F,Funcs), \+ check_is_partial_function(F,Hyps) -> fail
1087 ; Hyps2=Hyps). % all elements of Funcs are partial functions
1088 is_partial_function_type(Func,Hyps,Hyps2) :-
1089 ? get_superset(Func,Hyps,SuperSet,Hyps1),!,
1090 ? is_partial_function_type(SuperSet,Hyps1,Hyps2).
1091 is_partial_function_type(PF,Hyps,Hyps2) :-
1092 ? avl_fetch_worthwhile_equal_from_hyps(PF,Hyps,PF2,Hyps1), % in case we have a definition like X = 1..n --> R
1093 ? is_partial_function_type(PF2,Hyps1,Hyps2).
1094
1095 % get worthwhile superset
1096 get_superset(comprehension_set([ID],Body),Hyps,Set,Hyps) :-
1097 ? get_parameter_superset_in_body(ID,[ID],Body,Set).
1098 get_superset(set_subtraction(A,_),Hyps,A,Hyps).
1099 get_superset(intersection(A,B),Hyps,R,Hyps) :- (R=A ; R=B).
1100
1101 is_partial_function(total_function(A,B),A,B).
1102 is_partial_function(partial_function(A,B),A,B).
1103 is_partial_function(total_injection(A,B),A,B).
1104 is_partial_function(partial_injection(A,B),A,B).
1105 is_partial_function(total_surjection(A,B),A,B).
1106 is_partial_function(partial_surjection(A,B),A,B).
1107 is_partial_function(total_bijection(A,B),A,B).
1108 is_partial_function(partial_bijection(A,B),A,B).
1109 is_partial_function(perm(A),'NATURAL1',A).
1110 is_partial_function(seq(B),'NATURAL1',B).
1111 is_partial_function(seq1(B),'NATURAL1',B).
1112 is_partial_function(iseq(B),'NATURAL1',B).
1113 is_partial_function(iseq1(B),'NATURAL1',B).
1114
1115 % if First = f(1,GS) -> we can check if function is total; we could store summary of set_extension in hyps
1116 check_set_extension_is_partial_function([_],_) :- !. % one element set extension is a function
1117 check_set_extension_is_partial_function(List,Hyps) :-
1118 ? maplist(get_explicit_dom_value(Hyps),List,VList),!,
1119 sort(VList,SList),
1120 SList = [couple(First,_)|TS],
1121 check_set_ext_pf(TS,First,Hyps).
1122 check_set_extension_is_partial_function([couple(A,_),couple(B,_)],Hyps) :-
1123 check_not_equal(A,B,Hyps). % TO DO: all_different for longer lists
1124
1125 check_set_ext_pf([],_,_).
1126 check_set_ext_pf([couple(Next,_)|TS],Last,Hyp) :-
1127 Next \= Last,
1128 check_set_ext_pf(TS,Next,Hyp).
1129
1130 ?get_explicit_dom_value(Hyps,couple(Val,RanVal),couple(Val2,RanVal)) :- get_explicit_value(Val,Hyps,Val2).
1131
1132 get_explicit_value(couple(A,B),Hyps,couple(A2,B2)) :- !,
1133 get_explicit_value(A,Hyps,A2), get_explicit_value(B,Hyps,B2).
1134 get_explicit_value(rec(Fields),Hyps,rec(SFields2)) :- !,
1135 maplist(get_field_value(Hyps),Fields,Fields2),
1136 sort(Fields2,SFields2).
1137 ?get_explicit_value(Val,Hyps,R) :- is_explicit_value(Val,AVal,Hyps),!,R=AVal.
1138 get_explicit_value('$'(ID),Hyps,Res) :-
1139 ? avl_fetch_equal_from_hyps('$'(ID),Hyps,Val2,Hyps2),
1140 is_explicit_value(Val2,Res,Hyps2). % should we allow recursion through multiple equations?
1141
1142 % is value which can be compared using Prolog equality
1143 % cf. avl_can_fetch
1144 is_explicit_value(boolean_true,pred_true,_).
1145 is_explicit_value(boolean_false,pred_false,_).
1146 is_explicit_value(Nr,Nr,_) :- number(Nr). % integers and floats
1147 is_explicit_value(integer(Nr),Nr,_) :- integer(Nr). % normally already replaced by norm_expr2
1148 is_explicit_value(string(Atom),Atom,_).
1149 is_explicit_value(real(Atom),Res,_) :- atom(Atom),
1150 construct_real(Atom,term(floating(Res))). % c.f. is_real/1 in kernel_reals
1151 is_explicit_value(couple(A,B),(AV,BV),Hyp) :- is_explicit_value(A,AV,Hyp), is_explicit_value(B,BV,Hyp).
1152 is_explicit_value('$'(ID),'$'(ID),Hyp) :- is_global_constant_id(ID,Hyp).
1153 is_explicit_value(value(R),Nr,_) :- nonvar(R),R=int(Nr), integer(Nr). % TODO: more values, strings, reals, ...
1154
1155
1156 get_field_value(Hyps,field(Name,Val),field(Name,Val2)) :- get_explicit_value(Val,Hyps,Val2).
1157
1158 :- use_module(probsrc(b_global_sets), [lookup_global_constant/2]).
1159 % enumerated set element name
1160 is_global_constant_id(ID,Hyp) :-
1161 lookup_global_constant(ID,_),
1162 \+ is_hyp_var(ID,Hyp). % global enumerated set constant visible
1163
1164 is_enumerated_set(ID,Hyp) :-
1165 enumerated_set(ID),
1166 \+ is_hyp_var(ID,Hyp). % global enumerated set constant visible
1167
1168 % Disjoint check:
1169 check_disjoint(interval(Low1,Up1),interval(Low2,Up2),Hyps) :- !,
1170 (check_less(Up1,Low2,Hyps) -> true ; check_less(Up2,Low1,Hyps) -> true
1171 ; check_less(Up1,Low1,Hyps) -> true ; check_less(Up2,Low2,Hyps) -> true).
1172 check_disjoint(A,B,Hyps) :- %print(disj(A,B)),nl, portray_hyps(Hyps),nl,
1173 ? (check_disjoint_aux(A,B,Hyps) -> true ; check_disjoint_aux(B,A,Hyps)).
1174
1175 ?check_disjoint_aux(S,_,Hyps) :- check_equal_empty_set(S,Hyps,_),!.
1176 check_disjoint_aux(A,B,Hyps) :-
1177 avl_fetch_from_hyps(equal(intersection(A,B),empty_set),Hyps),!.
1178 check_disjoint_aux(domain_subtraction(A,_),B,Hyps) :- !, % A <<| f /\ B = {} if dom(B) <: A
1179 get_domain_or_superset(B,Hyps,DomB,Hyps2),
1180 check_is_subset(DomB,A,Hyps2,_).
1181 check_disjoint_aux(set_subtraction(AA,A),B,Hyps) :- !,
1182 (check_is_subset(B,A,Hyps,_) -> true % x \ A /\ B = {} if B <: A
1183 ; check_disjoint(AA,B,Hyps) -> true). % AA-A /\ B ={} if AA /\ B = {}
1184 check_disjoint_aux(set_extension(As),B,Hyps) :- !, l_check_not_member_of_set(As,B,Hyps).
1185 check_disjoint_aux(sorted_set_extension(As),B,Hyps) :- !, l_check_not_member_of_set(As,B,Hyps).
1186 check_disjoint_aux(domain(Func),B,Hyps) :- !,
1187 ? get_domain_or_superset(Func,Hyps,DomFunc,Hyps2),
1188 check_disjoint(DomFunc,B,Hyps2).
1189 check_disjoint_aux(range(Func),B,Hyps) :- !,
1190 ? get_range_or_superset(Func,Hyps,RanFunc,Hyps2),
1191 ? check_disjoint(RanFunc,B,Hyps2).
1192 check_disjoint_aux(A,B,Hyps) :-
1193 ? avl_fetch_worthwhile_equal_from_hyps(A,Hyps,A1,Hyps1),
1194 ? check_disjoint(A1,B,Hyps1).
1195 % TO DO: move union of set_extension here?
1196
1197 l_check_not_member_of_set([],_,_).
1198 l_check_not_member_of_set([El|T],Set,Hyps) :-
1199 check_not_member_of_set(Set,El,Hyps,_PT),
1200 l_check_not_member_of_set(T,Set,Hyps).
1201
1202 % Injective check:
1203
1204 check_is_injective(Func,Hyps) :-
1205 ? get_type_from_hyps(Func,Hyps,Function,Hyps1),
1206 %print(check_rev_fun(Func,Function)),nl,
1207 is_injective_function_type(Function,Hyps1,_).
1208 check_is_injective(value(avl_set(AVL)),_) :- !,
1209 nonvar(AVL), invert_explicit_set(avl_set(AVL),Inv),
1210 Inv=avl_set(AVL2), is_avl_partial_function(AVL2).
1211 check_is_injective(identity(_),_).
1212 check_is_injective(Set,_) :- singleton_set(Set,_). % TO DO: extend to more than singleton set_extension
1213 check_is_injective(sequence_extension([_]),_). % TO DO: check all elements are different
1214 check_is_injective(Func, Hyps) :-
1215 ? avl_fetch_equal_from_hyps(Func,Hyps,Value,Hyps2),
1216 %print(check_inj_value(Func,Value)),nl,
1217 ? check_is_injective(Value,Hyps2).
1218
1219 % check if this is a partial function type or something defined to be equal to a function type
1220 is_injective_function_type(PF,Hyps,Hyps1) :- is_injective(PF),!,Hyps1=Hyps.
1221 is_injective_function_type(PF,Hyps,Hyps2) :-
1222 avl_fetch_worthwhile_equal_from_hyps(PF,Hyps,PF2,Hyps1), % in case we have a definition like X = 1..n --> R
1223 is_injective_function_type(PF2,Hyps1,Hyps2).
1224
1225 is_injective(total_injection(_,_)).
1226 is_injective(partial_injection(_,_)).
1227 is_injective(total_bijection(_,_)).
1228 is_injective(partial_bijection(_,_)).
1229 is_injective(iseq(_)).
1230 is_injective(iseq1(_)).
1231
1232 % A /<: B <=> A/<<: B & A /= B
1233
1234 check_not_subset(Sub,Super,Hyps,not_subset_interval) :- % R..S /<: X..Y
1235 is_interval(Sub,Hyps,R,S),
1236 is_interval(Super,Hyps,X,Y),!,
1237 check_not_subset_interval(R,S,X,Y,Hyps).
1238 check_not_subset(A,B,Hyps,PT) :-
1239 ? check_not_is_subset_strict(A,B,Hyps,PT),!,
1240 check_not_equal(A,B,Hyps).
1241
1242 check_not_subset_interval(R,S,X,Y,Hyps) :-
1243 check_not_empty_interval(R,S,Hyps), !, % empty set is always a subset
1244 (check_less(Y,S,Hyps) -> true % interval extends right beyond Y
1245 ; check_less(R,X,Hyps) -> true % interval extends left beyond X
1246 ).
1247
1248 check_not_empty_interval(Low,Up,Hyps) :- check_leq(Low,Up,Hyps).
1249
1250 % check_not_is_subset_strict(A,B,Hyps,PT) check if A is not a strict subset of B
1251 % not really used for WD proofs at the moment; mainly as top-level goal in prove_po
1252 % (now used for proving set_subtraction is not empty; test 2469)
1253 % probably quite a few more rules necessary to make it useful
1254 check_not_is_subset_strict(A,B,Hyps,hyp) :-
1255 avl_fetch_from_hyps(not_subset_strict(A,B),Hyps),!. % hyp; currently not marked as useful by default!
1256 check_not_is_subset_strict(A,B,Hyps,hyp2) :-
1257 avl_fetch_from_hyps(not_subset(A,B),Hyps),!. % not(A <: B) => not (A<<:B)
1258 check_not_is_subset_strict(A,B,Hyps,equal(PT)) :-
1259 check_equal(A,B,Hyps,PT),!. % A=B => not (A<<:B)
1260 check_not_is_subset_strict(_,B,Hyps,empty_set(PT)) :- % A /<<: {}
1261 ? check_equal_empty_set(B,Hyps,PT).
1262 check_not_is_subset_strict(Sub,Super,Hyps,not_subset_interval) :- % R..S /<: X..Y => R..S /<<: X..Y
1263 is_interval(Sub,Hyps,R,S),
1264 is_interval(Super,Hyps,X,Y),!,
1265 check_not_subset_interval(R,S,X,Y,Hyps).
1266 check_not_is_subset_strict(MAX,_,Hyps,maximal_set) :- % MAX /<<: B
1267 maximal_set(MAX,Hyps),!.
1268 check_not_is_subset_strict(A,B,Hyps,not_empty_singleton(PT)) :- % x <<: {A} <=> x={}
1269 singleton_set(B,_),!,
1270 ? check_not_equal_empty_set(A,Hyps,PT).
1271 check_not_is_subset_strict(A,B,Hyps,infinite_sub(PT)) :-
1272 infinite_integer_set(A,Hyps), % TODO: accept more infinite sets
1273 check_finite(B,Hyps,PT),!.
1274 check_not_is_subset_strict(A,B,Hyps,superset_eq1(PT)) :-
1275 (Operator = equal ; Operator = superset), % A :> S2 & S2 /<<: B => A /<<: B
1276 ? avl_fetch_binop_from_hyps(A,Operator,Hyps,S2,Hyps2),
1277 rewrite_local_loop_check(A,check_not_is_subset_strict,S2,Hyps2,Hyps3),
1278 check_not_is_subset_strict(S2,B,Hyps3,PT),!.
1279 check_not_is_subset_strict(A,B,Hyps,subset_eq2(PT)) :-
1280 (Operator = equal ; Operator = subset), % B <: S2 & A /<<: S2 => A /<<: B
1281 ? avl_fetch_binop_from_hyps(B,Operator,Hyps,S2,Hyps2),
1282 rewrite_local_loop_check(B,check_not_is_subset_strict,S2,Hyps2,Hyps3),
1283 check_not_is_subset_strict(A,S2,Hyps3,PT),!.
1284 %check_not_is_subset_strict(A,B,H,_) :- print(check_not_is_subset_strict_failed(A,B)),nl, portray_hyps(H),nl,fail.
1285
1286
1287 check_is_subset_strict(A,B,Hyp,empty_singleton(PT)) :- % x <<: {A} <=> x={}
1288 singleton_set(B,_),!,
1289 check_equal_empty_set(A,Hyp,PT).
1290 check_is_subset_strict(A,B,Hyp,PT) :- % A <<: B <=> A <: B & A /= B
1291 ? check_is_subset(A,B,Hyp,PT),!,
1292 check_not_equal(A,B,Hyp).
1293
1294 % check if something is a subset of something else
1295 check_is_subset(H,H,_,equal).
1296 check_is_subset(A,B,Hyps,hyp) :-
1297 avl_fetch_from_hyps(subset(A,B),Hyps),!. % hyp
1298 check_is_subset(_,MAX,Hyps,maximal_set) :- maximal_set(MAX,Hyps),!.
1299 ?check_is_subset(S,_,Hyps,empty_set(PT)) :- check_equal_empty_set(S,Hyps,PT),!. % {} <: B
1300 check_is_subset(cartesian_product(A,B),cartesian_product(A2,B2),Hyps,cart(PTA,PTB)) :- !,
1301 % A <: A2 & B <: B2 => (A*B) <: (A2*B2)
1302 ? (check_is_subset(A,A2,Hyps,PTA)
1303 ? -> check_is_subset(B,B2,Hyps,PTB)).
1304 check_is_subset('NATURAL1','NATURAL',_,nat1_nat) :- !.
1305 ?check_is_subset(interval(L,U),B,Hyps,interval(PT)) :- !, check_subset_interval(B,L,U,Hyps,PT).
1306 check_is_subset(intersection(A,B),Super,Hyps,intersection(PT)) :- !,
1307 ? ( check_is_subset(A,Super,Hyps,PT) -> true ; check_is_subset(B,Super,Hyps,PT)).
1308 check_is_subset(union(A,B),Super,Hyps,union(PTA,PTB)) :- !,
1309 ? ( check_is_subset(A,Super,Hyps,PTA) -> check_is_subset(B,Super,Hyps,PTB)).
1310 check_is_subset(domain_subtraction(_,B),Super,Hyps,dom_sub(PT)) :- !,check_is_subset(B,Super,Hyps,PT).
1311 check_is_subset(domain_restriction(_,B),Super,Hyps,dom_res(PT)) :- !,check_is_subset(B,Super,Hyps,PT).
1312 check_is_subset(range_subtraction(A,_),Super,Hyps,ran_sub(PT)) :- !,check_is_subset(A,Super,Hyps,PT).
1313 ?check_is_subset(range_restriction(A,_),Super,Hyps,ran_res(PT)) :- !,check_is_subset(A,Super,Hyps,PT).
1314 ?check_is_subset(set_subtraction(A,_),Super,Hyps,set_sub(PT)) :- !,check_is_subset(A,Super,Hyps,PT).
1315 check_is_subset(value(avl_set(AVL)),B,Hyps,avl) :- !,check_subset_avl(B,AVL,Hyps).
1316 check_is_subset(A,B,Hyps,subset_eq(PT)) :-
1317 (Operator = equal ; Operator = subset), % for subset_strict we also have subset in Hyps
1318 ? avl_fetch_binop_from_hyps(A,Operator,Hyps,S2,Hyps2),
1319 rewrite_local_loop_check(A,check_is_subset,S2,Hyps2,Hyps3),
1320 ? check_is_subset(S2,B,Hyps3,PT),!.
1321 check_is_subset(A,B,Hyps,subset_eq_r(PT)) :-
1322 ? avl_fetch_binop_from_hyps(B,equal,Hyps,S2,Hyps2), % also superset?
1323 rewrite_local_loop_check(B,check_is_subset,S2,Hyps2,Hyps3),
1324 ? check_is_subset(A,S2,Hyps3,PT),!.
1325 check_is_subset('$'(ID),B,Hyps,eq(ID,PT)) :-
1326 ? get_type_from_hyps('$'(ID),Hyps,Set,Hyps2),
1327 extract_element_super_set_type(Set,Hyps2,S2),
1328 rewrite_local_loop_check(ID,check_is_subset,S2,Hyps2,Hyps3),
1329 ? check_is_subset(S2,B,Hyps3,PT),!.
1330 check_is_subset(domain(Func),B,Hyps,domain(PT)) :-
1331 ? get_domain_or_superset(Func,Hyps,DomFunc,Hyps2),
1332 %rewrite_local_loop_check(domain(Func),check_is_subset,DomFunc,Hyps2,Hyps3),
1333 ? check_is_subset(DomFunc,B,Hyps2,PT),!.
1334 check_is_subset(range(Func),B,Hyps,range(PT)) :-
1335 ? get_range_or_superset(Func,Hyps,RanFunc,Hyps2),
1336 %rewrite_local_loop_check(range(Func),check_is_subset,RanFunc,Hyps2,Hyps3),
1337 ? check_is_subset(RanFunc,B,Hyps2,PT),!.
1338 check_is_subset(function(Func,_),B,Hyps,function_range(PT)) :- !,
1339 ? get_range_or_superset(Func,Hyps,RanFunc,Hyps2), % f : _ +-> POW(Ran) & Ran <: B => f(.) <: B
1340 subset_transitivity_rule(RanFunc,pow_subset(B),A2,B2), % extract pow_subset from Range
1341 ? check_is_subset(A2,B2,Hyps2,PT).
1342 check_is_subset(image(Func,_),B,Hyps,image(PT)) :- % or B=range(Range)
1343 (B = range(FuncB),check_equal(Func,FuncB,Hyps,_) -> !, PT=range_of_same_func % f[.] <: ran(f)
1344 ? ; get_range_or_superset(Func,Hyps,Range,Hyps2) -> !, check_is_subset(Range,B,Hyps2,PT)).
1345 ?check_is_subset(A,B,Hyps,transitivity(PT)) :- subset_transitivity_rule(A,B,A2,B2),
1346 !, % unary subset rules like POW(A2) <: POW(B2) if A2 <: B2
1347 ? check_is_subset(A2,B2,Hyps,PT).
1348 ?check_is_subset(A,B,Hyps,transitivity(PT1,PT2)) :- subset_bin_transitivity_rule(A,B,A1,A2,B1,B2),
1349 !, % binary subset rules like A1+->B1 <: A2+->B2 if A1 <:B1 & A2 <: B2
1350 ? (check_is_subset(A1,B1,Hyps,PT1) -> check_is_subset(A2,B2,Hyps,PT2)).
1351 check_is_subset(sorted_set_extension(List),B,Hyps,PT) :- !,
1352 ? check_is_subset(set_extension(List),B,Hyps,PT).
1353 check_is_subset(set_extension(List),B,Hyps,set_extension) :-
1354 simplify_expr(B,Hyps,BS), % simplify expression once
1355 %portray_hyps(Hyps),nl,
1356 l_check_is_member(List,BS,Hyps).
1357 check_is_subset(Sub,union(A,B),Hyps,sub_union(PT)) :- !,
1358 ? ( check_is_subset(Sub,A,Hyps,PT) -> true ; check_is_subset(Sub,B,Hyps,PT)).
1359 % get_set_of_possible_values; treat sequence_extension
1360 check_is_subset(comprehension_set([ID],Pred),B,Hyps,comprehension_set(PT)) :-
1361 ? get_conjunct(Pred,Conjunct), % TODO: also allow comprehension sets with multiple ids?
1362 get_member(Conjunct,ID,A),
1363 % we could do findall and then union
1364 ID = $(ID1), \+ occurs(A,ID1),
1365 ? check_is_subset(A,B,Hyps,PT).
1366 % check_is_subset(A,B,_,_) :- print(check_is_subset_failed(A,B)),nl,nl,fail.
1367
1368 get_member(member(LHS,RHS),LHS,RHS).
1369 get_member(subset(LHS,RHS),LHS,pow_subset(RHS)).
1370 get_member(subset_strict(LHS,RHS),LHS,pow_subset(RHS)).
1371
1372
1373 l_check_is_member([],_,_).
1374 l_check_is_member([El|T],B,Hyps) :-
1375 ? check_member_of_set(B,El,Hyps,_ProofTree),!,
1376 l_check_is_member(T,B,Hyps).
1377
1378 % extract set type of the elements of a set: x: POW(A) ==> x<:A
1379 extract_element_super_set_type(FuncType,Hyps,cartesian_product(A,B)) :-
1380 get_possible_domain_of_func_or_rel_type(FuncType,Hyps,A,_),!,
1381 get_possible_range_of_func_or_rel_type_direct(FuncType,B,_).
1382 extract_element_super_set_type(fin_subset(A),_,A).
1383 extract_element_super_set_type(fin1_subset(A),_,A).
1384 extract_element_super_set_type(pow_subset(A),_,A).
1385 extract_element_super_set_type(pow1_subset(A),_,A).
1386
1387
1388 % simple not member of set check
1389 check_not_member_of_set(Set,_,Hyps,empty_set) :- check_equal_empty_set(Set,Hyps,_),!.
1390 check_not_member_of_set(Set,El,Hyps,hyp) :-
1391 avl_fetch_from_hyps(not_member(El,Set),Hyps),!. % hyp
1392 check_not_member_of_set(if_then_else(Pred,A,B),El,Hyps,if_then_else(PTA,PTB)) :-
1393 push_and_rename_normalized_hyp(Pred,Hyps,Hyps1),
1394 (hyps_inconsistent(Hyps1) -> true ; check_not_member_of_set(A,El,Hyps1,PTA) -> true),
1395 push_and_rename_normalized_hyp(negation(Pred),Hyps,Hyps2),
1396 (hyps_inconsistent(Hyps2) -> true ; check_not_member_of_set(B,El,Hyps2,PTB) -> true),!.
1397 check_not_member_of_set(intersection(A,B),El,Hyps,inter(PT)) :-
1398 (check_not_member_of_set(A,El,Hyps,PT) -> true ; check_not_member_of_set(B,El,Hyps,PT)),!.
1399 check_not_member_of_set(set_subtraction(A,B),El,Hyps,inter(PT)) :-
1400 ? (check_not_member_of_set(A,El,Hyps,PT) -> true ; check_member_of_set(B,El,Hyps,PT)),!.
1401 check_not_member_of_set(union(A,B),El,Hyps,inter(PTA,PTB)) :-
1402 ? (check_not_member_of_set(A,El,Hyps,PTA) -> check_not_member_of_set(B,El,Hyps,PTB)),!.
1403 check_not_member_of_set(overwrite(A,B),El,Hyps,overwrite(PTA,PTB)) :-
1404 (check_not_member_of_set(A,El,Hyps,PTA) -> check_not_member_of_set(B,El,Hyps,PTB)),!.
1405 check_not_member_of_set('NATURAL1',El,Hyps,nat1) :-
1406 check_leq(El,0,Hyps).
1407 check_not_member_of_set('NATURAL',El,Hyps,nat1) :-
1408 check_leq(El,-1,Hyps).
1409 check_not_member_of_set(interval(From,To),El,Hyps,interval) :-
1410 (check_leq(El,minus(From,1),Hyps) -> true
1411 ; check_leq(add(To,1),El,Hyps) -> true). % TODO: or interval empty
1412 check_not_member_of_set(domain(Func),El,Hyps,not_in_domain(PT)) :-
1413 ? check_not_member_of_domain(Func,El,Hyps,PT),!.
1414 check_not_member_of_set(range(Func),El,Hyps,not_in_range(PT)) :-
1415 check_not_member_of_range(Func,El,Hyps,PT),!.
1416 check_not_member_of_set(relations(A,B),closure(RX),Hyps,closure1_not_el_relations(PT)) :- !,
1417 % rx : A <-> B <=> closure1(rx) : A <-> B
1418 check_not_member_of_set(relations(A,B),RX,Hyps,PT).
1419 check_not_member_of_set(Set,couple(From,_),Hyps,not_in_dom(PT)) :-
1420 % x /: dom(f) => x|->y /: f
1421 avl_fetch_binop_from_hyps(From,not_member,Hyps,Set2,Hyps2),
1422 check_is_subset(domain(Set),Set2,Hyps2,PT),
1423 !.
1424 check_not_member_of_set(Set,couple(_,To),Hyps,not_in_range) :-
1425 avl_fetch_from_hyps(not_member(To,range(Set)),Hyps), % y /: ran(f) => x|->y /: f
1426 !. % TODO: generalise this rule somewhat, see domain above
1427 check_not_member_of_set(A,El,Hyps,eq(ProofTree)) :-
1428 ? avl_fetch_worthwhile_equal_from_hyps(A,Hyps,Value,Hyps2),
1429 rewrite_local_loop_check(A,check_member_of_set,Value,Hyps2,Hyps3),
1430 ? check_not_member_of_set(Value,El,Hyps3,ProofTree).
1431 check_not_member_of_set(Set,El,Hyps,not_in_set_extension) :-
1432 is_set_extension(Set,List),
1433 check_not_member_of_list(List,El,Hyps).
1434 %check_not_member_of_set(Set,El,Hyps,_) :- print(not_mem_failed(Set,El)),nl,fail.
1435 % TO DO: process equalities, set_extension?, value(avl_set(AVL)), ...
1436
1437 % check if an element is not in the domain of a function
1438 check_not_member_of_domain(domain_subtraction(DS,Func),El,Hyps,not_dom_sub(PT)) :-
1439 (check_member_of_set(DS,El,Hyps,PT) -> true
1440 ; check_not_member_of_domain(Func,El,Hyps,PT)).
1441 check_not_member_of_domain(domain_restriction(DS,Func),El,Hyps,not_dom_sub(PT)) :-
1442 (check_not_member_of_set(DS,El,Hyps,PT) -> true
1443 ; check_not_member_of_domain(Func,El,Hyps,PT)).
1444 check_not_member_of_domain(Func,El,Hyps,PT) :-
1445 ? get_domain_or_superset(Func,Hyps,DomFunc,Hyps1),
1446 check_not_member_of_set(DomFunc,El,Hyps1,PT).
1447
1448 % check if an element is not in the domain of a function
1449 check_not_member_of_range(range_subtraction(Func,DS),El,Hyps,not_dom_sub(PT)) :-
1450 (check_member_of_set(DS,El,Hyps,PT) -> true
1451 ; check_not_member_of_range(Func,El,Hyps,PT)).
1452 check_not_member_of_range(range_restriction(Func,DS),El,Hyps,not_dom_sub(PT)) :-
1453 (check_not_member_of_set(DS,El,Hyps,PT) -> true
1454 ; check_not_member_of_range(Func,El,Hyps,PT)).
1455 check_not_member_of_range(Func,El,Hyps,PT) :-
1456 ? get_range_or_superset(Func,Hyps,RanFunc,Hyps1),!,
1457 check_not_member_of_set(RanFunc,El,Hyps1,PT).
1458
1459
1460
1461 % check that an element does not occur in a list of values/expressions
1462 check_not_member_of_list([],_,_).
1463 check_not_member_of_list([H|T],El,Hyps) :-
1464 check_not_equal(H,El,Hyps),
1465 check_not_member_of_list(T,El,Hyps).
1466
1467 is_set_extension(set_extension(List),List).
1468 is_set_extension(sorted_set_extension(List),List).
1469
1470
1471 % check_member_of_set(Set,Element,Hyps,ProofTree)
1472 % check_member_of_set(A,B,_H,_ProofTree) :- print(check_member_of_set(A,B)),nl,fail.
1473 ?check_member_of_set(Set,_,Hyps,maximal_set) :- maximal_set(Set,Hyps), !.
1474 check_member_of_set(Set,if_then_else(Pred,A,B),Hyps,if(P1,P2)) :- !, % if-then-else expression
1475 push_and_rename_normalized_hyp(Pred,Hyps,Hyps1),
1476 (hyps_inconsistent(Hyps1) -> true ; check_member_of_set(Set,A,Hyps1,P1) -> true),
1477 push_and_rename_normalized_hyp(negation(Pred),Hyps,Hyps2),
1478 (hyps_inconsistent(Hyps2) -> true ; check_member_of_set(Set,B,Hyps2,P2) -> true).
1479 check_member_of_set(Set,El,Hyps,hyp) :-
1480 % we could do avl_fetch_binop_from_hyps(El,member,Hyps,Set2,Hyps2), and check_subset(Set2,Set)
1481 avl_fetch_from_hyps(member(El,Set),Hyps),!. % hyp
1482 % TO DO: sometimes value(El) stored !
1483 check_member_of_set(sorted_set_extension(List),El,Hyps,PT) :- !, % ordsets:ord_member(El,List),!.
1484 check_member_of_set(set_extension(List),El,Hyps,PT).
1485 ?check_member_of_set(set_extension(List),El,Hyps,set_extension) :- member(El2,List),
1486 ? check_equal(El,El2,Hyps,_),!. % TO DO: avoid multiple equality rewriting of El for long lists ?
1487 check_member_of_set(partial_function(T1,T2),El,Hyps,partial_function(PT)) :-
1488 check_is_partial_function_with_type(El,T1,T2,Hyps,PT).
1489 check_member_of_set(total_function(T1,T2),El,Hyps,total_function(PT,PTDom)) :-
1490 check_is_partial_function_with_type(El,T1,T2,Hyps,PT),!,
1491 simplify_expr(domain(El),Hyps,DomEl),
1492 ? check_is_subset(T1,DomEl,Hyps,PTDom).
1493 check_member_of_set(relations(A,B),closure(RX),Hyps,closure1_el_relations(PT)) :- !,
1494 % rx : A <-> B <=> closure1(rx) : A <-> B
1495 check_member_of_set(relations(A,B),RX,Hyps,PT).
1496 check_member_of_set(range(Func),El,Hyps,mem_range(PT)) :-
1497 ? check_member_of_range(El,Func,Hyps,PT),!. % check before function application below, can do symbolic range check
1498 check_member_of_set(image(Func,Set),El,Hyps,mem_range_for_image(PT0,PT1)) :-
1499 % El:ran(F) & dom(F) <: S => El:F[S]
1500 check_member_of_set(range(Func),El,Hyps,PT0),!,
1501 check_is_subset(domain(Func),Set,Hyps,PT1).
1502 check_member_of_set(A,ElFunc,Hyps,typing_membership(PT)) :-
1503 ? get_type_from_hyps(ElFunc,Hyps,Range,Hyps2), % !, % moving cut later proves on additional PO for test 2039
1504 % e.g. f(.) : A if ran(f) <: Range & Range <: A
1505 %rewrite_local_loop_check(A,check_member_of_set,Range,Hyps2,Hyps3),
1506 ? check_is_subset(Range,A,Hyps2,PT),!.
1507 check_member_of_set(A,El,Hyps,eq(ProofTree)) :-
1508 ? avl_fetch_worthwhile_equal_from_hyps(A,Hyps,Value,Hyps2),
1509 rewrite_local_loop_check(A,check_member_of_set,Value,Hyps2,Hyps3),
1510 ? check_member_of_set(Value,El,Hyps3,ProofTree).
1511 ?check_member_of_set(interval(L,U),El,Hyps,interval(PT)) :- !, check_in_interval(El,L,U,Hyps,PT).
1512 check_member_of_set('NATURAL1',El,Hyps,nat1(PT)) :- !, check_subset_interval('NATURAL1',El,El,Hyps,PT).
1513 check_member_of_set('NATURAL',El,Hyps,nat(PT)) :- !, check_subset_interval('NATURAL',El,El,Hyps,PT).
1514 check_member_of_set(union(A,B),El,Hyps,union(PTA,PTB)) :- !,
1515 ? (check_member_of_set(A,El,Hyps,PTA) -> true ; check_member_of_set(B,El,Hyps,PTB)).
1516 check_member_of_set(intersection(A,B),El,Hyps,intersection(PTA,PTB)) :- !,
1517 (check_member_of_set(A,El,Hyps,PTA) -> check_member_of_set(B,El,Hyps,PTB)).
1518 check_member_of_set(set_subtraction(A,B),El,Hyps,set_subtraction(PTA,PTB)) :- !,
1519 ? (check_member_of_set(A,El,Hyps,PTA) -> check_not_member_of_set(B,El,Hyps,PTB)).
1520 check_member_of_set(pow_subset(T1),El,Hyps,pow(PT)) :- !,
1521 check_is_subset(El,T1,Hyps,PT).
1522 check_member_of_set(fin_subset(T1),El,Hyps,fin(PT1,PT2)) :- !,
1523 check_is_subset(El,T1,Hyps,PT1),!,
1524 check_finite(El,Hyps,PT2).
1525 check_member_of_set(pow1_subset(T1),El,Hyps,pow1(PT)) :- !,
1526 ? check_not_empty_set(El,Hyps),!,
1527 check_is_subset(El,T1,Hyps,PT).
1528 check_member_of_set(fin1_subset(T1),El,Hyps,fin1(PT1,PT2)) :- !,
1529 check_not_empty_set(El,Hyps),!,
1530 check_is_subset(El,T1,Hyps,PT1),!,
1531 check_finite(El,Hyps,PT2).
1532 check_member_of_set(seq(T1),El,Hyps,seq(PT)) :- !,
1533 check_is_sequence(El,Hyps),!,
1534 check_is_subset(range(El),T1,Hyps,PT).
1535 check_member_of_set(seq1(T1),El,Hyps,seq1(PT)) :- !,
1536 check_is_non_empty_sequence(El,Hyps),!,
1537 check_is_subset(range(El),T1,Hyps,PT).
1538 check_member_of_set(cartesian_product(T1,T2),couple(El1,El2),Hyps,cart(PT1,PT2)) :- !,
1539 ? check_member_of_set(T1,El1,Hyps,PT1),!,
1540 ? check_member_of_set(T2,El2,Hyps,PT2).
1541 check_member_of_set(value(avl_set(AVL)),El,Hyps,PT) :-
1542 (avl_can_fetch(El,BVal) -> !,PT=avl_fetch(El),avl_fetch(BVal,AVL)
1543 ; avl_is_interval(AVL,Min,Max) -> !, PT=avl_interval(PT2),
1544 % useful is El is not a number, but e.g. an arithmetic expression
1545 % print(avl_interval(Min,Max,El)),nl,
1546 check_integer(El,check_member_of_set_avl_interval),
1547 ? check_in_interval(El,Min,Max,Hyps,PT2)
1548 ).
1549 check_member_of_set(A,El,Hyps,rewrite(PT)) :- rewrite_set_expression_exact(A,Hyps,A2,Hyps2),!,
1550 ? check_member_of_set(A2,El,Hyps2,PT).
1551 check_member_of_set(domain(Func),Index,Hyps,mem_domain(PT)) :-
1552 ? check_member_of_domain(Index,Func,Hyps,PT),!.
1553 check_member_of_set(Set,X,Hyps,value_set(PT)) :-
1554 ? try_get_set_of_possible_values(X,Hyps,XSet,Hyps2), % also covers min(Set), max(Set), mu(Set), CHOOSE(Set)
1555 ? check_is_subset(XSet,Set,Hyps2,PT),!.
1556 %check_member_of_set(Set,X,Hyps,eq(PT)) :- Set = '$'(_),
1557 % avl_fetch_equal_from_hyps(Set,Hyps,Set2,Hyps2), % maybe perform direct rewrite ancestor cycle check here
1558 % check_member_of_set(Set2,X,Hyps2,PT),!.
1559 check_member_of_set(Set,X,Hyps,trans(PT)) :-
1560 ? avl_fetch_binop_from_hyps(Set,superset,Hyps,SubSet,Hyps2), % X:B & B <: A => X:A
1561 ? check_member_of_set(SubSet,X,Hyps2,PT),!.
1562 check_member_of_set(Set,ID,Hyps,member_subset(PT)) :-
1563 ? avl_fetch_worthwhile_member_from_hyps(ID,Hyps,SubSet,Hyps2), %write(sub(ID,SubSet,Set)),nl,
1564 check_is_subset(SubSet,Set,Hyps2,PT).
1565 %check_member_of_set(A,B,_H,_ProofTree) :- write(check_member_of_set_failed(A,B)),nl,fail.
1566
1567
1568 :- use_module(probsrc(kernel_reals),[construct_real/2]).
1569 % check if we can fetch an expression as a B value (second arg) in an AVL set
1570 avl_can_fetch(El,Res) :- number(El),!, Res=int(El).
1571 avl_can_fetch(boolean_true,pred_true).
1572 avl_can_fetch(boolean_false,pred_false).
1573 avl_can_fetch(real(Atom),R) :- construct_real(Atom,R).
1574 avl_can_fetch(string(S),string(S)) :- ground(S).
1575 avl_can_fetch(couple(A,B),(VA,VB)) :- avl_can_fetch(A,VA), avl_can_fetch(B,VB).
1576
1577 check_member_of_domain(El,reverse(Func2),Hyps,reverse(PT)) :- !,
1578 check_member_of_range(El,Func2,Hyps,PT).
1579 check_member_of_domain(El,Func,Hyps,hyp) :-
1580 avl_fetch_from_hyps(member(El,domain(Func)),Hyps),!. % hyp, already checked in check_member_of_set
1581 check_member_of_domain(Index,Func,Hyps,size_in_dom_seq) :- % x:seq1(T) => size(x) : dom(x)
1582 ? index_in_non_empty_sequence(Index,Func,Hyps),
1583 check_is_non_empty_sequence(Func,Hyps),!.
1584 % TO DO: f~(x) : dom(f) ??
1585 check_member_of_domain(El,union(A,B),Hyps,dom_of_union(PT)) :-
1586 check_member_of_union(domain(A),domain(B),El,Hyps,PT).
1587 check_member_of_domain(El,overwrite(A,B),Hyps,dom_of_overwrite(PT)) :-
1588 ? check_member_of_union(domain(A),domain(B),El,Hyps,PT).
1589 check_member_of_domain(El,direct_product(A,B),Hyps,dom_of_direct_product(PT)) :- % dom(A >< B) = dom(A) /\ dom (B)
1590 check_member_of_set(domain(A),El,Hyps,PT),
1591 check_member_of_set(domain(B),El,Hyps,PT).
1592 check_member_of_domain(El,A,Hyps,rewrite(PT)) :- rewrite_set_expression_exact(A,Hyps,A2,Hyps2),!,
1593 check_member_of_domain(El,A2,Hyps2,PT).
1594 check_member_of_domain(El,Func,Hyps,dom_of_subset(PT)) :- % Func2 <: Func & El:dom(Func2) => El:dom(Func)
1595 % counter part of rule with superset for check_member_of_set
1596 (Op = equal ; Op = superset),
1597 ? avl_fetch_binop_from_hyps(Func,Op,Hyps,Func2,Hyps1),
1598 rewrite_local_loop_check(Func,check_member_of_domain,Func2,Hyps1,Hyps2),
1599 check_member_of_set(domain(Func2),El,Hyps2,PT).
1600 check_member_of_domain(El,comprehension_set(IDS,Body),Hyps,dom_of_lambda(PTs)) :-
1601 ? get_lambda_args_and_body(IDS,Body,_,_,Args,RestBodyList),
1602 %nl,print(lambda(Args,El,RestBodyList)),nl,
1603 ? generate_funapp_binding(Args,El,Subst),
1604 % we rename the local variables of the comprehension set; no need to call add_new_hyp_any_vars
1605 l_rename_and_prove_goals(RestBodyList,Subst,Hyps,PTs).
1606 check_member_of_domain(El,restrict_front(_,K),Hyps,dom_of_restrict_front(PT)) :-
1607 check_member_of_set(interval(1,K),El,Hyps,PT). % WD Condition requires K : 0..size(Seq)
1608 check_member_of_domain(El,if_then_else(Pred,A,B),Hyps,if_then_else(PT1,PT2)) :-
1609 push_and_rename_normalized_hyp(Pred,Hyps,Hyps1),
1610 (hyps_inconsistent(Hyps1) -> true ; check_member_of_domain(El,A,Hyps1,PT1) -> true),
1611 push_and_rename_normalized_hyp(negation(Pred),Hyps,Hyps2),
1612 (hyps_inconsistent(Hyps2) -> true ; check_member_of_domain(El,B,Hyps2,PT2) -> true).
1613 %check_member_of_domain(Index,Func,Hyps,_) :- write(check_member_of_domain_failed(Index,Func)),nl,fail.
1614
1615 % we could do intersection, subtraction
1616
1617 % check if an element is an element of a union of two sets
1618 check_member_of_union(Set1,_,El,Hyps,PT) :- check_member_of_set(Set1,El,Hyps,PT),!.
1619 check_member_of_union(_,Set2,El,Hyps,PT) :- check_member_of_set(Set2,El,Hyps,PT),!.
1620 check_member_of_union(Set1,Set2,El,Hyps,union(PT1,PT2)) :-
1621 % x : A \/ B & A <: S1 & B <: S2 => x : S1 \/ S2
1622 ? avl_fetch_mem_from_hyps(El,Hyps,union(A,B),Hyps2), % TO DO: other conditions ?
1623 (check_is_subset(A,Set1,Hyps2,PT1) -> check_is_subset(B,Set2,Hyps2,PT2)
1624 ? ; check_is_subset(A,Set2,Hyps2,PT1) -> check_is_subset(B,Set1,Hyps2,PT2)).
1625
1626 generate_funapp_binding(['$'(X)],El,[rename(X,El)]).
1627 generate_funapp_binding(['$'(X),'$'(Y)],couple(El1,El2),[rename(X,El1),rename(Y,El2)]).
1628 generate_funapp_binding(['$'(X),'$'(Y),'$'(Z)],couple(couple(El1,El2),El3),[rename(X,El1),rename(Y,El2),rename(Z,El3)]).
1629 % TO DO: create substitution for more arguments and other parameters
1630
1631
1632 ?check_member_of_range(El,reverse(Func2),Hyps,reverse(PT)) :- !,check_member_of_domain(El,Func2,Hyps,PT).
1633 check_member_of_range(El,Func,Hyps,hyp) :-
1634 avl_fetch_from_hyps(member(El,range(Func)),Hyps),!. % hyp, already checked in check_member_of_set
1635 check_member_of_range(El,A,Hyps,rewrite(PT)) :- rewrite_set_expression_exact(A,Hyps,A2,Hyps2),!,
1636 check_member_of_range(El,A2,Hyps2,PT).
1637 check_member_of_range('$'(ID),Func2,Hyps,PT) :-
1638 ? avl_fetch_worthwhile_equal_from_hyps('$'(ID),Hyps,Value,Hyps2),
1639 ? check_member_of_range(Value,Func2,Hyps2,PT).
1640 check_member_of_range(function(Func1,_),Func2,Hyps,func_app_in_range) :- % f(.) : ran(f)
1641 check_equal(Func1,Func2,Hyps,_).
1642 check_member_of_range(El,if_then_else(Pred,A,B),Hyps,if_then_else(PT1,PT2)) :-
1643 push_and_rename_normalized_hyp(Pred,Hyps,Hyps1),
1644 (hyps_inconsistent(Hyps1) -> true ; check_member_of_range(El,A,Hyps1,PT1) -> true),
1645 push_and_rename_normalized_hyp(negation(Pred),Hyps,Hyps2),
1646 (hyps_inconsistent(Hyps2) -> true ; check_member_of_range(El,B,Hyps2,PT2) -> true).
1647
1648
1649 % subset transitivity for unary operators:
1650 subset_transitivity_rule(pow_subset(A),pow_subset(B),A,B).
1651
1652 subset_transitivity_rule(pow1_subset(A),pow1_subset(B),A,B).
1653 subset_transitivity_rule(pow1_subset(A),pow_subset(B),A,B).
1654
1655 subset_transitivity_rule(fin_subset(A),fin_subset(B),A,B).
1656 subset_transitivity_rule(fin_subset(A),pow_subset(B),A,B).
1657
1658 subset_transitivity_rule(fin1_subset(A),fin1_subset(B),A,B).
1659 subset_transitivity_rule(fin1_subset(A),fin_subset(B),A,B).
1660 subset_transitivity_rule(fin1_subset(A),pow1_subset(B),A,B).
1661 subset_transitivity_rule(fin1_subset(A),pow_subset(B),A,B).
1662
1663 subset_transitivity_rule(seq(A),seq(B),A,B).
1664 subset_transitivity_rule(seq(A),partial_function(typeset,B),A,B).
1665
1666 subset_transitivity_rule(seq1(A),seq1(B),A,B).
1667 subset_transitivity_rule(seq1(A),seq(B),A,B).
1668 subset_transitivity_rule(seq1(A),partial_function(typeset,B),A,B).
1669
1670 subset_transitivity_rule(iseq(A),iseq(B),A,B).
1671 subset_transitivity_rule(iseq(A),seq(B),A,B).
1672 subset_transitivity_rule(iseq(A),partial_function(typeset,B),A,B).
1673
1674 subset_transitivity_rule(iseq1(A),iseq1(B),A,B).
1675 subset_transitivity_rule(iseq1(A),iseq(B),A,B).
1676 subset_transitivity_rule(iseq1(A),seq1(B),A,B).
1677 subset_transitivity_rule(iseq1(A),seq(B),A,B).
1678 subset_transitivity_rule(iseq1(A),partial_function(typeset,B),A,B).
1679
1680 % subset_transitivity_rule(perm(A),perm(B),A,B). % this does not hold perm({}) = { [] }, perm({TRUE}) = {[TRUE]}
1681 subset_transitivity_rule(perm(A),iseq(B),A,B).
1682 subset_transitivity_rule(perm(A),seq(B),A,B).
1683 subset_transitivity_rule(perm(A),partial_function(typeset,B),A,B).
1684
1685
1686 subset_transitivity_rule(range(A),domain(reverse(B)),A,B).
1687 subset_transitivity_rule(range(A),range(B),A,B).
1688 subset_transitivity_rule(range(reverse(A)),domain(B),A,B).
1689 subset_transitivity_rule(domain(reverse(A)),range(B),A,B).
1690 subset_transitivity_rule(domain(A),domain(B),A,B). % dom(A) <: dom(B) if A <:B
1691 subset_transitivity_rule(domain(A),range(reverse(B)),A,B).
1692 subset_transitivity_rule(reverse(A),reverse(B),A,B).
1693 subset_transitivity_rule(rev(A),rev(B),A,B).
1694 subset_transitivity_rule(identity(A),identity(B),A,B).
1695
1696 % TO DO: add rules for more binary operators, like surjective relations, ...
1697 subset_bin_transitivity_rule(relations(A1,A2),relations(B1,B2),A1,A2,B1,B2). % <->
1698 subset_bin_transitivity_rule(total_relation(A1,A2),relations(B1,B2),A1,A2,B1,B2). % <<->
1699 subset_bin_transitivity_rule(total_relation(A1,A2),total_relation(B1,B2),A1,A2,B1,B2) :- A1=B1.
1700 subset_bin_transitivity_rule(partial_function(A1,A2),relations(B1,B2),A1,A2,B1,B2). % +->
1701 subset_bin_transitivity_rule(partial_function(A1,A2),partial_function(B1,B2),A1,A2,B1,B2).
1702 subset_bin_transitivity_rule(partial_injection(A1,A2),partial_function(B1,B2),A1,A2,B1,B2). % >+>
1703 subset_bin_transitivity_rule(partial_injection(A1,A2),partial_injection(B1,B2),A1,A2,B1,B2).
1704 subset_bin_transitivity_rule(partial_surjection(A1,A2),partial_function(B1,B2),A1,A2,B1,B2). % -+>>
1705 subset_bin_transitivity_rule(partial_surjection(A1,A2),partial_surjection(B1,B2),A1,A2,B1,B2) :- A2=B2.
1706 subset_bin_transitivity_rule(partial_bijection(A1,A2),partial_function(B1,B2),A1,A2,B1,B2). % >+>>
1707 subset_bin_transitivity_rule(total_function(A1,A2),partial_function(B1,B2),A1,A2,B1,B2). % -->
1708 subset_bin_transitivity_rule(total_function(A1,A2),total_function(B1,B2),A1,A2,B1,B2) :- A1=B1.
1709 subset_bin_transitivity_rule(total_injection(A1,A2),partial_function(B1,B2),A1,A2,B1,B2). % >->
1710 subset_bin_transitivity_rule(total_injection(A1,A2),total_function(B1,B2),A1,A2,B1,B2) :- A1=B1.
1711 subset_bin_transitivity_rule(total_surjection(A1,A2),partial_function(B1,B2),A1,A2,B1,B2). % -->>
1712 subset_bin_transitivity_rule(total_surjection(A1,A2),total_function(B1,B2),A1,A2,B1,B2) :- A1=B1.
1713 subset_bin_transitivity_rule(total_bijection(A1,A2),partial_function(B1,B2),A1,A2,B1,B2). % >+>>
1714 subset_bin_transitivity_rule(total_bijection(A1,A2),partial_injection(B1,B2),A1,A2,B1,B2).
1715 subset_bin_transitivity_rule(total_bijection(A1,A2),partial_surjection(B1,B2),A1,A2,B1,B2) :- A2=B2.
1716 subset_bin_transitivity_rule(total_bijection(A1,A2),total_function(B1,B2),A1,A2,B1,B2) :- A1=B1.
1717 subset_bin_transitivity_rule(total_bijection(A1,A2),total_injection(B1,B2),A1,A2,B1,B2) :- A1=B1.
1718 subset_bin_transitivity_rule(total_bijection(A1,A2),total_surjection(B1,B2),A1,A2,B1,B2) :- A1=B1, A2=B2.
1719 subset_bin_transitivity_rule(image(A1,A2),image(B1,B2),A1,A2,B1,B2). % A1[A2] <: B1[B2] if A1 <: B1 & A2 <: B2
1720 subset_bin_transitivity_rule(domain_restriction(A1,A2),domain_restriction(B1,B2),A1,A2,B1,B2). % A1 <| A2 <: B1 <| B2 if A1 <: B1 & A2 <: B2
1721 subset_bin_transitivity_rule(range_restriction(A1,A2),range_restriction(B1,B2),A1,A2,B1,B2).
1722 subset_bin_transitivity_rule(domain_subtraction(A1,A2),domain_subtraction(B1,B2),B1,A2,A1,B2). % A1 <<| A2 <: B1 <<| B2 if B1 <: A1 & A2 <: B2
1723 subset_bin_transitivity_rule(range_subtraction(A1,A2),range_subtraction(B1,B2),A1,B2,A2,B1). % A1 |>> A2 <: B1|>> B2 if A1 <: B1 & B2 <: A2
1724 %subset_bin_transitivity_rule(A,B,A1,A2,B1,B2) :- write(subset_bin_transitivity_rule(A,B,A1,A2,B1,B2)),nl,fail.
1725 % TO DO: add more
1726
1727 % TO DO: instead of is_set_of_sequences_type
1728 %subset_mixed_transitivity_rule(total_function(A1,A2),seq(B2),A2,B2) :- is_interval(A1).
1729
1730 check_in_interval(El,Min,Max,Hyps,in_interval(PT1,PT2)) :-
1731 expr_is_member_of_set(El,Set,PT1),!, % TODO: should we treat min/max as well here??
1732 check_is_subset(Set,interval(Min,Max),Hyps,PT2).
1733 check_in_interval(El,Min,Max,Hyps,PT) :-
1734 ? check_subset_interval(interval(Min,Max),El,El,Hyps,PT). % calls check_sub_intervals(Min,Max,El,El,Hyps)
1735
1736 expr_is_member_of_set(mu(Set),Set,mu).
1737 expr_is_member_of_set(external_function_call(Call,[Set]),Set,ext_call(Call)) :-
1738 (Call = 'CHOOSE' -> true ; Call = 'MU').
1739
1740 % check if an interval is a subset of the first argument
1741 check_subset_interval(union(A,B),L1,U1,Hyps,union(PT)) :- !,
1742 % TO DO: try and merge A,B : union(interval(1,10),set_extension([11]))
1743 (check_subset_interval(A,L1,U1,Hyps,PT) -> true ; check_subset_interval(B,L1,U1,Hyps,PT)).
1744 check_subset_interval(sorted_set_extension(L),L1,U1,Hyps,PT) :- !,
1745 check_subset_interval(set_extension(L),L1,U1,Hyps,PT).
1746 check_subset_interval(set_extension(L),L1,U1,Hyps,set_extension(Nr)) :- !,
1747 % TO DO: maybe merge L into an interval
1748 ? nth1(Nr,L,El), check_sub_intervals(L1,U1,El,El,Hyps),!.
1749 check_subset_interval(intersection(A,B),L1,U1,Hyps,inter(PTA,PTB)) :- !,
1750 % L1..U1 <: A /\ B if L1..U1 <: A & L1..U1 <: B
1751 (check_subset_interval(A,L1,U1,Hyps,PTA) -> check_subset_interval(B,L1,U1,Hyps,PTB)).
1752 check_subset_interval(interval(L2,U2),L1,U1,Hyps,interval) :-
1753 ? !,check_sub_intervals(L1,U1,L2,U2,Hyps).
1754 check_subset_interval('NATURAL',L1,_,Hyps,nat) :- !, check_leq(0,L1,Hyps).
1755 check_subset_interval('NATURAL1',L1,_,Hyps,nat1) :- !, check_leq(1,L1,Hyps).
1756 check_subset_interval(value(avl_set(A)),L1,U1,Hyps,avl(PT)) :- !,
1757 (number(L1), number(U1)
1758 -> PT=in(L1,U1),
1759 ? check_interval_in_custom_set(L1,U1,avl_set(A),no_wf_available)
1760 ; avl_min(A,int(L2)), avl_max(A,int(U2)), PT=min_max(L2,U2,PT2),
1761 check_subset_interval(interval(L2,U2),L1,U1,Hyps,PT2)
1762 ).
1763 check_subset_interval(A,L1,U1,Hyps,rewrite(PT)) :- rewrite_set_expression_exact(A,Hyps,A2,Hyps2),!,
1764 ? check_subset_interval(A2,L1,U1,Hyps2,PT).
1765 check_subset_interval(domain(Expr),Low,Up,Hyps,dom_seq1) :- % a special rule when using SEQ(1) rather than first(SEQ)
1766 (check_leq(1,Low,Hyps), check_leq(Up,size(Expr),Hyps) % 1..size(s) <: dom(s)
1767 -> check_is_sequence(Expr,Hyps)
1768 ? ; index_in_non_empty_sequence(Low,Expr,Hyps),
1769 ? index_in_non_empty_sequence(Up,Expr,Hyps) % 1..1 or size(s)..size(s) <: dom(s) if s:seq1(.)
1770 -> check_is_non_empty_sequence(Expr,Hyps)
1771 ).
1772 check_subset_interval(range(reverse(Expr)),Low,Up,Hyps,PT) :- !,
1773 check_subset_interval(domain(Expr),Low,Up,Hyps,PT).
1774 check_subset_interval(A,Low,Up,Hyps,eq(PT)) :-
1775 ? avl_fetch_worthwhile_equal_from_hyps(A,Hyps,A2,Hyps2),
1776 rewrite_local_loop_check(A,check_subset_interval,A2,Hyps2,Hyps3),
1777 ? check_subset_interval(A2,Low,Up,Hyps3,PT).
1778 %check_subset_interval(A,L1,U1,_,_) :- print(check_subset_interval_failed(A,L1,U1)),nl,fail.
1779
1780 % s:seq1(.) => 1:dom(s) & size(s):dom(s)
1781 index_in_non_empty_sequence(1,_,_).
1782 index_in_non_empty_sequence(card(E),E,_).
1783 index_in_non_empty_sequence(size(E),E,_).
1784 index_in_non_empty_sequence('$'(X),E,Hyps) :-
1785 ? avl_fetch_equal_from_hyps('$'(X),Hyps,Y,Hyps2),
1786 rewrite_local_loop_check(X,index_in_non_empty_sequence,Y,Hyps2,Hyps3),
1787 ? index_in_non_empty_sequence(Y,E,Hyps3).
1788 index_in_non_empty_sequence(X,E,Hyps) :- \+ useful_value(X), % do not rewrite 10 to interval(10,10)
1789 ? try_get_set_of_possible_values(X,Hyps,XSet,Hyps2),
1790 rewrite_local_loop_check(X,index_in_non_empty_sequence,XSet,Hyps2,Hyps3),
1791 ? all_in_non_empty_sequence(XSet,E,Hyps3).
1792
1793 all_in_non_empty_sequence(interval(A,B),E,Hyps) :-
1794 ? index_in_non_empty_sequence(A,E,Hyps),
1795 ? index_in_non_empty_sequence(B,E,Hyps).
1796 % TODO: avl_set, ...
1797
1798 % check if L1..U1 <: L2..U2
1799 check_sub_intervals(L1,L1,L2,U2,Hyps) :- (L1=L2 ; L1=U2),!,
1800 ? check_not_empty_set(interval(L2,U2),Hyps).
1801 check_sub_intervals(L1,U1,L2,U2,Hyps) :- % L1..U1 <: L2..U2 if L2 <= L1 & U1 <= U2
1802 ? check_leq(L2,L1,Hyps),!,
1803 ? check_leq(U1,U2,Hyps).
1804
1805
1806
1807 % some exact rewrite steps
1808 ?rewrite_set_expression_exact(domain(A),Hyps,Res,Hyps2) :- compute_exact_domain(A,Hyps,Dom,Hyps2),!,
1809 %print(rewrote(domain(A))),nl, print(Dom),nl,
1810 (A='$'(ID) -> not_occurs(Dom,ID) ; true), % prevent silly rewrites
1811 Res=Dom.
1812 ?rewrite_set_expression_exact(range(A),Hyps,Res,Hyps2) :- compute_exact_range(A,Hyps,Ran,Hyps2),!,
1813 %print(rewrote(range(A))),nl, print(Ran),nl,
1814 (A='$'(ID) -> not_occurs(Ran,ID) ; true), % prevent silly rewrites
1815 Res=Ran.
1816 rewrite_set_expression_exact(intersection(A,B),Hyps,Res,Hyps) :-
1817 (is_empty_set_direct(A) -> Res=empty_set ; is_empty_set_direct(B) -> Res=empty_set).
1818 rewrite_set_expression_exact(set_subtraction(A,B),Hyps,Res,Hyps) :-
1819 (is_empty_set_direct(A) -> Res=empty_set ; is_empty_set_direct(B) -> Res=A).
1820 rewrite_set_expression_exact(union(A,B),Hyps,Res,Hyps1) :-
1821 (check_equal(A,B,Hyps,Hyps1) -> Res=A
1822 ; Hyps1=Hyps, merge_set_extensions(union(A,B),List,[]),
1823 construct_set_extension(List,Hyps,Res)).
1824 rewrite_set_expression_exact(value(closure(P,T,B)),Hyps,Res,Hyps) :- nonvar(P),
1825 is_interval_closure(P,T,B,LOW,UP), number(LOW),number(UP),!,
1826 Res = interval(LOW,UP).
1827 rewrite_set_expression_exact(assertion_expression(_,_,Expr),Hyps,Res,Hyps2) :- % TO DO: add Predicate to Hyps ?
1828 (rewrite_set_expression_exact(Expr,Hyps,Expr2,Hyps2) -> Res=Expr2
1829 ; Res=Expr, Hyps2=Hyps).
1830 rewrite_set_expression_exact(Expr,Hyps,Res,Hyps) :-
1831 ? eval_bvalue_from_norm_expr(Expr,Val),!, Res=value(Val).
1832 % Note one can have equalities like f = f~~ (in FunLawsWithLambda.mch); hence important to pass Hyps for cycle detection
1833
1834 % rewrite relational image operator
1835 rewrite_rel_image(Rel,Set,Hyps,value(ResVal),Hyps) :-
1836 get_bvalue_from_norm_expr(Rel,RelVal), get_bvalue_from_norm_expr(Set,SetVal),
1837 eval_binary_operator(image,RelVal,SetVal,ResVal).
1838
1839
1840 eval_unary_operator(reverse,Arg,Res) :- bsets_clp:invert_relation_wf(Arg,Res,no_wf_available).
1841 eval_binary_operator(image,RelVal,SetVal,Res) :- bsets_clp:image_wf(RelVal,SetVal,Res,no_wf_available).
1842
1843 % try and convert a normed AST expression to a valid B value
1844 get_bvalue_from_norm_expr(boolean_true,pred_true).
1845 get_bvalue_from_norm_expr(boolean_false,pred_false).
1846 get_bvalue_from_norm_expr(Nr,int(Nr)) :- integer(Nr).
1847 get_bvalue_from_norm_expr(value(V),V).
1848 ?get_bvalue_from_norm_expr(set_extension(List),Result) :- maplist(get_bvalue_from_norm_expr,List,Result).
1849 get_bvalue_from_norm_expr(sorted_set_extension(List),Result) :- maplist(get_bvalue_from_norm_expr,List,Result).
1850 ?get_bvalue_from_norm_expr(Expr,Res) :- eval_bvalue_from_norm_expr(Expr,Res).
1851
1852 ?eval_bvalue_from_norm_expr(reverse(Rel),ResVal) :- get_bvalue_from_norm_expr(Rel,RelVal),
1853 eval_unary_operator(reverse,RelVal,ResVal).
1854 ?eval_bvalue_from_norm_expr(image(Rel,Set),ResVal) :- get_bvalue_from_norm_expr(Rel,RelVal),
1855 ? get_bvalue_from_norm_expr(Set,SetVal),
1856 eval_binary_operator(image,RelVal,SetVal,ResVal).
1857
1858
1859 % try and rewrite function applications for comprehension_sets
1860 rewrite_function_application(comprehension_set([$(PARA),$(LAMBDARES)],Body),Arg,Hyps,Result,Hyps) :-
1861 get_conjunct(Body,equal(A,B)),
1862 sym_unify(A,B,$(LAMBDARES),RESEXPR),
1863 \+ occurs(RESEXPR,LAMBDARES),
1864 % TODO: support more than one argument and hadd rest of body to hyps
1865 !,
1866 rename_norm_term(RESEXPR,[rename(PARA,Arg)],Result).
1867 rewrite_function_application(Function,Arg,Hyps,Result,Hyps2) :-
1868 ? avl_fetch_binop_from_hyps(Function,equal,Hyps,Value,Hyps1),
1869 rewrite_function_application(Value,Arg,Hyps1,Result,Hyps2).
1870
1871 get_conjunct(conjunct(A,B),C) :- !, (get_conjunct(A,C) ; get_conjunct(B,C)).
1872 get_conjunct(C,C).
1873
1874 merge_set_extensions(empty_set) --> [].
1875 merge_set_extensions(empty_sequence) --> [].
1876 merge_set_extensions(set_extension(L)) --> L.
1877 merge_set_extensions(sorted_set_extension(L)) --> L.
1878 merge_set_extensions(union(A,B)) --> merge_set_extensions(A), merge_set_extensions(B).
1879
1880 % check if AVL is a subset of the first argument
1881 check_subset_avl(union(A,B),AVL1,Hyps) :- !, % TO DO: try and merge A,B
1882 ? (check_subset_avl(A,AVL1,Hyps) -> true ; check_subset_avl(B,AVL1,Hyps)).
1883 check_subset_avl(intersection(A,B),AVL1,Hyps) :- !, % AVL <: A /\ B if AVL <: A & AVL <: B
1884 (check_subset_avl(A,AVL1,Hyps) -> check_subset_avl(B,AVL1,Hyps)).
1885 check_subset_avl(interval(L2,U2),AVL,_) :- number(L2),number(U2),!,
1886 check_avl_in_interval(AVL,L2,U2).
1887 check_subset_avl(value(avl_set(AVL2)),AVL1,_) :- !, check_avl_subset(AVL1,AVL2).
1888 check_subset_avl(seq(MAX),AVL,Hyps) :- maximal_set(MAX,Hyps), !, is_avl_set_of_sequences(AVL,seq).
1889 check_subset_avl(seq1(MAX),AVL,Hyps) :- maximal_set(MAX,Hyps), !, is_avl_set_of_sequences(AVL,seq1).
1890 check_subset_avl(seq(seq(MAX)),AVL,Hyps) :- maximal_set(MAX,Hyps),
1891 % comes from general concat
1892 custom_explicit_sets:is_one_element_avl(AVL,Element), % usually one value from try_get_set_of_possible_values
1893 is_sequence(Element,seq),
1894 expand_custom_set_to_list(Element,ListOfSeqs),
1895 maplist(is_subsequence,ListOfSeqs).
1896 check_subset_avl(A,AVL,Hyps) :- rewrite_set_expression_exact(A,Hyps,A2,Hyps2),!,
1897 check_subset_avl(A2,AVL,Hyps2).
1898 check_subset_avl(A,AVL,Hyps) :-
1899 ? avl_fetch_worthwhile_equal_from_hyps(A,Hyps,A2,Hyps2),
1900 rewrite_local_loop_check(A,check_subset_avl,A2,Hyps2,Hyps3),
1901 check_subset_avl(A2,AVL,Hyps3).
1902 %check_subset_avl(A,AVL,_) :- print(check_subset_avl_failed(A,AVL)),nl,fail.
1903
1904 is_subsequence((int(_Index),Sequence)) :- is_sequence(Sequence,seq).
1905
1906 is_sequence(avl_set(SeqAVL),_) :- safe_is_avl_sequence(SeqAVL).
1907 is_sequence([],seq).
1908
1909 % check if all elements of the AVL are sequences
1910 is_avl_set_of_sequences(AVL,SeqType) :- avl_height(AVL,Height), Height<7,
1911 expand_custom_set_to_list(avl_set(AVL),ListOfSeqs),
1912 l_is_sequence(ListOfSeqs,SeqType).
1913 l_is_sequence([],_).
1914 l_is_sequence([S1|T],SeqType) :- is_sequence(S1,SeqType), l_is_sequence(T,SeqType).
1915
1916
1917 :- use_module(probsrc(b_global_sets),[b_global_set/1]).
1918 maximal_set('INTEGER',_). % integer_set('INTEGER') ?
1919 maximal_set(real_set,_).
1920 maximal_set(string_set,_).
1921 maximal_set(bool_set,_).
1922 maximal_set('typeset',_).
1923 maximal_set(cartesian_product(A,B),Hyps) :- % SIMP_CPROD_EQUAL_TYPE
1924 ? maximal_set(A,Hyps), maximal_set(B,Hyps).
1925 maximal_set(relations(A,B),Hyps) :- % SIMP_TYPE_EQUAL_REL
1926 maximal_set(A,Hyps), maximal_set(B,Hyps).
1927 maximal_set(set_subtraction(A,B),Hyps) :- % SIMP_SETMINUS_EQUAL_TYPE
1928 ? maximal_set(A,Hyps), check_equal_empty_set(B,Hyps,_).
1929 ?maximal_set(pow_subset(A),Hyps) :- maximal_set(A,Hyps).
1930 ?maximal_set('$'(ID),Hyps) :- is_global_set_id(ID,Hyps).
1931 maximal_set(value(avl_set(AVL)),_) :-
1932 quick_definitely_maximal_set_avl(AVL).
1933 maximal_set(set_extension(A),Hyps) :- maximal_set_extension(A,Hyps).
1934 % sorted_set_extension is never maximal
1935 maximal_set(comprehension_set(_,truth),_).
1936 %maximal_set(X,_) :- print(max_fail(X)),nl,fail.
1937
1938 construct_set_extension([],_,Res) :- !, Res=empty_set.
1939 construct_set_extension(L,Hyps,Res) :- maximal_set_extension(L,Hyps),!, Res='typeset'.
1940 construct_set_extension(L,_,sorted_set_extension(SL)) :-
1941 %length(L,Len), format('Construct set_extension ~w~n',[Len]),
1942 sort(L,SL).
1943
1944 maximal_set_extension([boolean_true|T],_) :- !, member(boolean_false,T).
1945 maximal_set_extension([boolean_false|T],_) :- !, member(boolean_true,T).
1946 maximal_set_extension(['$'(ID)|T],Hyps) :-
1947 is_global_constant_id(ID,Hyps),
1948 sort(['$'(ID)|T],Sorted),
1949 maplist(is_glob_const_id(Hyps),Sorted), % all elements are global constants
1950 lookup_global_constant(ID,fd(_,GlobalSet)),
1951 enumerated_set(GlobalSet),b_global_set_cardinality(GlobalSet,Size),
1952 length(Sorted,Size).
1953 %maximal_set_extension(X,_) :- print(maximal_failed(X)),nl,fail.
1954
1955 is_glob_const_id(Hyps,'$'(ID)) :- is_global_constant_id(ID,Hyps).
1956
1957
1958 is_global_set_id(ID,Hyps) :-
1959 ? b_global_set(ID),
1960 \+ is_hyp_var(ID,Hyps). % global enumerated set visible
1961
1962 % often called with 0 or 1 in first position
1963 check_leq(I,I,_) :- !.
1964 check_leq(if_then_else(Pred,A1,A2),B,Hyp) :- !,
1965 push_and_rename_normalized_hyp(Pred,Hyp,Hyp1),
1966 (hyps_inconsistent(Hyp1) -> true ; check_leq(A1,B,Hyp1) -> true),
1967 push_and_rename_normalized_hyp(negation(Pred),Hyp,Hyp2),
1968 (hyps_inconsistent(Hyp2) -> true ; check_leq(A2,B,Hyp2) -> true).
1969 check_leq(N1,N2,_) :- number(N1), number(N2), !, N1 =< N2.
1970 check_leq(N1,N2,hyp_rec(AVL,_)) :-
1971 (avl_fetch(less_equal(N1,N2),AVL)
1972 -> true
1973 ; avl_fetch(equal(N1,N2),AVL)),!.
1974 check_leq(min(List),N2,Hyps) :- !,
1975 member(N1,List), check_leq(N1,N2,Hyps),!.
1976 check_leq(min_int,N2,Hyps) :- !, % we could look up the value of MININT; but largest possible value is -1
1977 MININT is -1,
1978 check_leq(MININT,N2,Hyps).
1979 check_leq(N1,max_int,Hyps) :- !, % we could look up the value of MAXINT; but smallest possible value is 1
1980 MAXINT = 1,
1981 check_leq(N1,MAXINT,Hyps).
1982 check_leq(N1,N2,Hyps) :-
1983 rewrite_integer(N2,Hyps,RN2,Hyps2),!,
1984 check_leq(N1,RN2,Hyps2).
1985 check_leq(add(N1,1),N2,Hyps) :-
1986 ? check_not_equal(N1,N2,Hyps),
1987 !, % N1+1 <= N2 if N1 <= N2 & N1 \= N2 ; happens quite often in array traversals
1988 ? check_leq(N1,N2,Hyps).
1989 check_leq(N1,minus(N2,1),Hyps) :- % variation of rule above
1990 ? check_not_equal(N1,N2,Hyps),
1991 !, % N1 <= N2-1 if N1 <= N2 & N1 \= N2 ; happens in array traversals
1992 check_leq(N1,N2,Hyps).
1993 check_leq(Nr,X,Hyps) :-
1994 \+ number(X),
1995 ? try_get_set_of_possible_values(X,Hyps,SetX,Hyps2),
1996 ? check_all_values_geq_val(SetX,Nr,Hyps2),!.
1997 check_leq(Nr,X,Hyps) :- number(Nr), !,
1998 ? check_leq_nr(Nr,X,Hyps).
1999 check_leq(N1,N2,Hyps) :- rewrite_integer(N1,Hyps,RN1,Hyps2),!,
2000 check_leq(RN1,N2,Hyps2).
2001 check_leq(Add,N2,Hyps) :- % A+N1 <= N2 <=> A <= N2-N1
2002 number(N2),
2003 add_with_number(Add,A,N1),!,
2004 N21 is N2-N1,
2005 check_leq(A,N21,Hyps).
2006 check_leq(Mul,N2,Hyps) :- % A*N1 <= N2 if A <= N2/N1 if N1>0 and N2 mod N1=0
2007 number(N2),
2008 mul_with_number(Mul,Hyps,A,N1),
2009 % symmetrical case to check_leq_nr(N1,Mul,Hyps), with N1=-N2
2010 !,
2011 ( N1=0 -> check_leq(0,N2,Hyps)
2012 ; N1>0 -> N21 is N2 div N1, % A <= 1.5 means we have to have A <= 1;
2013 % A <= -1.5 means we have to have A <= -2 -3 div 2 =:= -2
2014 check_leq(A,N21,Hyps)
2015 ; cdiv(N2,N1,N21), % A >= 1.5 means we have to have A >= 2 ; cdiv
2016 check_leq(N21,A,Hyps)
2017 ).
2018 check_leq(div(A,N1),N2,Hyps) :-
2019 number(N1),number(N2), N1>0,
2020 !,
2021 (N2=0 -> N12 is N2-1 % A/4 <= 0 <=> A <= 3
2022 ; N2 >= 0 -> N12 is (N2+1)*N1-1 % A/4 <= 10 <=> A <= 49 % A/N1 <= N2 <=> A <= (N1+1)*N2-1
2023 ; N12 is N2*N1 % A/4 <= -10 <=> A <= -40
2024 ),
2025 check_leq(A,N12,Hyps).
2026 check_leq(div(A1,N1),A2,Hyps) :- number(N1), N1>0, % A/N1 <= A if N1>0 & A>=0
2027 check_equal(A1,A2,Hyps,Hyps1),!,
2028 check_leq(0,A1,Hyps1).
2029 check_leq(modulo(A1,A2),B,Hyps) :-
2030 \+ z_or_tla_minor_mode, % args to mod must be non-negative, modulo is between 0..A2-1
2031 ((number(A2),A21 is A2-1 -> check_leq(A21,B,Hyps)
2032 ; B=minus(B1,1) -> check_leq(A2,B1,Hyps)
2033 ; check_leq(A2,B,Hyps)
2034 ) -> true
2035 ; check_leq(A1,B,Hyps)).
2036 % TO DO: modulo as RHS
2037 check_leq(unary_minus(A),unary_minus(B),Hyps) :- !, % -A <= -B ---> A >= B
2038 check_leq(B,A,Hyps).
2039 check_leq(X,Nr,Hyps) :- \+ number(X),
2040 ? try_get_set_of_possible_values(X,Hyps,SetX,Hyps2),
2041 ? check_all_values_leq_val(SetX,Nr,Hyps2),!. % cut here; get set of possible values can give multiple solutions
2042 check_leq(Minus,N2,Hyps) :- minus_with_number(Minus,N1,Nr),
2043 Nr >= 0,!, % N1-Nr <= N2 if N1 <= N2
2044 % Both N1 and N2 are usually not numbers here
2045 check_leq(N1,N2,Hyps).
2046 check_leq(N1,Add,Hyps) :-
2047 add_with_number(Add,N2,Nr),Nr >= 0,!, % N1 <= N2+Nr if N1 <= N2
2048 % Both N1 and N2 are usually not numbers here
2049 check_leq(N1,N2,Hyps).
2050 check_leq(add(A,B),E,Hyps) :-
2051 ? decompose_floor(E,Hyps,X,Y), % e.g. divide a number E by 2
2052 check_leq(A,X,Hyps), % TO DO: other combinations like A <= 0, B <= Nr; or we could try_get_set_of_possible_values
2053 check_leq(B,Y,Hyps).
2054 check_leq('$'(X),N2,Hyps) :-
2055 ? avl_fetch_binop_from_hyps('$'(X),less_equal,Hyps,Y,Hyps2),
2056 (number(N2),avl_fetch_not_equal('$'(X),Y,Hyps) % as we know X and Y we can use regular avl_fetch
2057 -> N21 is N2+1 % we have X<Y in the Hypotheses, we just require that Y <= N2+1
2058 ; N21=N2),
2059 check_leq(Y,N21,Hyps2).
2060 check_leq(Nr,'$'(X),Hyps) :-
2061 ? ( avl_fetch_equal_from_hyps('$'(X),Hyps,Y,Hyps2),
2062 rewrite_local_loop_check(X,check_leq,Y,Hyps2,Hyps3),
2063 check_leq(Nr,Y,Hyps3) -> true
2064 % ; avl_fetch_binop_from_hyps('$'(X),greater,Hyps,Y,Hyps2), N1 is Nr-1, check_leq(N1,Y,Hyps2) -> true
2065 ? ; avl_fetch_binop_from_hyps('$'(X),greater_equal,Hyps,Y,Hyps2),
2066 % note: Nr is not a number, hence probably not useful to check not_equal in Hyps, as we cannot compute Nr-1
2067 check_leq(Nr,Y,Hyps2)
2068 -> true
2069 ),
2070 !.
2071 %check_leq(A,B,_H) :- print(check_leq_failed(A,B)),nl, portray_hyps(_H),nl,fail.
2072
2073 % decompose an expression E into A and B so that A+B <= E
2074 ?decompose_floor(X,Hyps,A,B) :- get_number(X,Hyps,Nr),!,
2075 A is Nr div 2, B=A. % -11 div 2 -> -6, -1 div 2 = -1, 11 div 2 = 5
2076 decompose_floor(add(A,B),_Hyps,A,B). % TO DO: we could try other order
2077 decompose_floor(Mul,Hyps,A,A) :-
2078 mul_with_number(Mul,Hyps,A,Nr),
2079 Nr>=2, % we could divide Nr by 2
2080 (Nr=2 -> true % we have exactly A+A = Mul
2081 ; check_leq(0,A,Hyps)). % Note: -10/10 + -10/10 is not <= -10
2082
2083 % ceiling division utility
2084 cdiv(N1,N2,Res) :-
2085 (N1 mod N2 =:= 0 -> Res is N1//N2
2086 ; Res is (N1 div N2)+1).
2087
2088 % Number <= Expression
2089 check_leq_nr(N1,Add,Hyps) :- % N1 <= A+N2 <=> N1-N2 <= A
2090 add_with_number(Add,A,N2), !,
2091 N12 is N1-N2,
2092 check_leq(N12,A,Hyps).
2093 check_leq_nr(Nr,add(N1,N2),Hyps) :- !, % 0 <= A+B if 0 <= A & 0 <= B
2094 % Both N1 and N2 are usually not numbers here
2095 cdiv(Nr,2,Nr2), % Note: cdiv(-3,2) = 1, cdiv(3,2)=2
2096 check_leq(Nr2,N1,Hyps),
2097 check_leq(Nr2,N2,Hyps).
2098 check_leq_nr(N1,minus(N2,B),Hyps) :- % N1 <= N2-B <=> B <= N2-N1
2099 number(N2), !,
2100 N21 is N2-N1,
2101 ? check_leq(B,N21,Hyps).
2102 check_leq_nr(N1,Mul,Hyps) :- % N1 <= A*N2 if N1/N2 <= A and N2>0
2103 mul_with_number(Mul,Hyps,A,N2),
2104 !,
2105 ( N2=0 -> check_leq(N1,0,Hyps)
2106 ; N2>0 -> cdiv(N1,N2,N12), % cdiv
2107 % if 1.5 <= A --> 2 <= A ; if -1.5 <= A --> -1 <= A
2108 check_leq(N12,A,Hyps)
2109 ; N12 is N1 div N2,
2110 % if A <= 1.5 --> A <= 1 ; if -1.5 <= A --> -1 <= A
2111 % A <= -1.5 means we have to have A <= -2 -3 div 2 =:= -2
2112 check_leq(A,N12,Hyps)
2113 ).
2114 check_leq_nr(0,multiplication(A,B),Hyps) :- !, % 0 <= A*B if A and B have same parity
2115 (check_leq(0,A,Hyps) -> check_leq(0,B,Hyps)
2116 ; check_leq(A,0,Hyps) -> check_leq(B,0,Hyps)).
2117 check_leq_nr(N1,div(A,N2),Hyps) :- % N1 <= A/N2 <=> N1*N2 <= A
2118 number(N2), N2>0, % TODO: case if N2<0
2119 !,
2120 (N1 > 0 -> N12 is N1*N2 % 10 <= A/4 <=> 40 <= A
2121 ; N1 = 0 -> N12 is 1-N2 % 0 <= A/4 <=> -3 <= A
2122 ; N12 is (N1 - 1)*(N2)+1 % -10 <= A/4 <=> -49 <= A
2123 ),
2124 check_leq(N12,A,Hyps).
2125 check_leq_nr(0,div(A,B),Hyps) :- !, % 0 <= A/B guaranteed if A and B have same parity
2126 (check_leq(0,A,Hyps) -> check_leq(0,B,Hyps) % B \= 0 checked by other WD condition
2127 ; check_leq(A,0,Hyps) -> check_leq(B,0,Hyps)). % ditto
2128 % TODO: other solutions possible, e.g., -1/100 = 1/-100 = 0
2129 check_leq_nr(Nr,'$'(X),Hyps) :-
2130 ? ( avl_fetch_equal_from_hyps('$'(X),Hyps,Y,Hyps2),
2131 rewrite_local_loop_check(X,check_leq,Y,Hyps2,Hyps3),
2132 check_leq(Nr,Y,Hyps3) -> true
2133 % ; avl_fetch_binop_from_hyps('$'(X),greater,Hyps,Y,Hyps2), N1 is Nr-1, check_leq(N1,Y,Hyps2) -> true
2134 ? ; avl_fetch_binop_from_hyps('$'(X),greater_equal,Hyps,Y,Hyps2),
2135 (avl_fetch_not_equal('$'(X),Y,Hyps2) % we have X < Y => sufficient to prove N-1 <= Y
2136 -> N1 is Nr-1, check_leq(N1,Y,Hyps2)
2137 ; check_leq(Nr,Y,Hyps2)
2138 )
2139 ),
2140 !.
2141 check_leq_nr(Nr,modulo(A,B),Hyps) :- \+ z_or_tla_minor_mode, % A and B must be non-negative, modulo is between 0..B-1
2142 (Nr =< 0 -> true % modulo always positive or 0
2143 ; % Nr <= A mod B if Nr <= A and A < B
2144 check_leq_nr(Nr,A,Hyps), % Nr <= A
2145 check_less(A,B,Hyps)). % and A < B so that modulo does not take effect
2146 check_leq_nr(Nr,size(Seq),Hyps) :- check_leq_nr_size(Nr,Seq,Hyps).
2147 check_leq_nr(1,power_of(A,_),Hyps) :- check_leq(1,A,Hyps). % Nr <= 1 <= x**y if x >= 1
2148 check_leq_nr(Nr,power_of(A,_),Hyps) :- number(Nr), Nr =< 0,
2149 check_leq(0,A,Hyps). % 0 <= x**y if x >= 0
2150 %check_leq_nr(A,B,_H) :- print(check_leq_nr_failed(A,B)),nl,fail.
2151
2152 check_less(A,B,Hyps) :-
2153 check_leq(A,B,Hyps),!,
2154 check_not_equal(A,B,Hyps).
2155
2156 :- use_module(probsrc(specfile),[z_or_tla_minor_mode/0]).
2157
2158
2159 check_leq_nr_size(Nr,restrict_front(_,RestrN),Hyps) :- !, % X <= size( Seq /|\ N) if X <= N as WD condition implies N : 0..size(Seq)
2160 check_leq_nr(Nr,RestrN,Hyps).
2161 check_leq_nr_size(1,Seq,Hyps) :- check_is_non_empty_sequence(Seq,Hyps).
2162
2163 add_with_number(add(A,B),X,Nr) :- (number(A) -> Nr=A, X=B ; number(B) -> Nr=B, X=A).
2164 add_with_number(minus(A,B),A,Nr) :- number(B), Nr is -B.
2165 mul_with_number(multiplication(A,B),Hyps,X,Nr) :-
2166 (get_number(A,Hyps,Nr) -> X=B ; get_number(B,Hyps,Nr) -> X=A).
2167 mul_with_number(unary_minus(A),_Hyps,A,Nr) :- Nr is -1.
2168 minus_with_number(add(A,B),A,Nr) :- number(B), Nr is -B.
2169 minus_with_number(minus(A,Nr),A,Nr) :- number(Nr).
2170
2171
2172 %get_possible_values('$'(X),Hyps,SetX,Hyps2) :-
2173 % avl_fetch_binop_from_hyps('$'(X),member,Hyps,SetX,Hyps2).
2174
2175 % a few rewrite rules for integer expressions
2176 % addition/multiplication is dealt with in other places (and is usually done symbolically)
2177 rewrite_integer(size(Seq),Hyps,Size,Hyps2) :- % can happen for sequence POs, like restrict_front,tail
2178 ? compute_card_of_set(Seq,Hyps,Size,Hyps2),!.
2179 rewrite_integer(card(Seq),Hyps,Size,Hyps2) :- !, rewrite_card_of_set(Seq,Hyps,Size,Hyps2).
2180 rewrite_integer(assertion_expression(_,_,Expr),Hyps,Expr,Hyps). % TO DO: add Predicate to Hyps?
2181 % the following may be done by ast_cleanup, but e.g., when applying functions no cleanup is run in l_rename_and_prove_goals
2182 rewrite_integer(add(A,B),Hyps,Res,Hyps2) :- compute_integer(A,Hyps,A1,Hyps1), number(A1),
2183 (compute_integer(B,Hyps1,B1,Hyps2), number(B1)
2184 -> Res is A1+B1
2185 ; A1=0 -> Res = B, Hyps2=Hyps1).
2186 rewrite_integer(multiplication(A,B),Hyps,Res,Hyps2) :- compute_integer(A,Hyps,A1,Hyps1), number(A1),!,
2187 (A1=0 -> Res=0, Hyps2=Hyps1
2188 ; compute_integer(B,Hyps1,B1,Hyps2), number(B1)
2189 -> Res is A1*B1
2190 ; A1=1 -> Res=B, Hyps2=Hyps1).
2191 rewrite_integer(multiplication(A,B),Hyps,Res,Hyps2) :-
2192 compute_integer(B,Hyps,B1,Hyps2), number(B1),
2193 (B1=0 -> Res=0
2194 ; B1=1 -> Res = A).
2195 rewrite_integer(unary_minus(A),Hyps,Res,Hyps2) :- compute_integer(A,Hyps,A1,Hyps2), number(A1),
2196 Res is -A1.
2197 rewrite_integer(minus(A,B),Hyps,Res,Hyps2) :- compute_integer(B,Hyps,B1,Hyps1), number(B1),
2198 (compute_integer(A,Hyps1,A1,Hyps2), number(A1)
2199 -> Res is A1-B1
2200 ; B1=0 -> Res = A, Hyps2=Hyps1).
2201 rewrite_integer(power_of(A,B),Hyps,Res,Hyps2) :- compute_integer(A,Hyps,A1,Hyps1), number(A1),
2202 compute_integer(B,Hyps1,B1,Hyps2), number(B1), B1 >=0,
2203 % check if not too large:
2204 (abs(A1) < 2 -> true
2205 ; A1=2 -> B1 =< 64
2206 ; A1 < 4294967296 -> B1 =< 2
2207 ; B1 =< 0
2208 ),
2209 Res is A1 ^ B1.
2210 rewrite_integer(modulo(A,B),Hyps,Res,Hyps2) :- compute_integer(A,Hyps,A1,Hyps1),number(A1),
2211 A1 >= 0,
2212 compute_integer(B,Hyps1,B1,Hyps2), number(B1), B1 >0,
2213 Res is A1 mod B1.
2214 rewrite_integer(div(A,B),Hyps,Res,Hyps2) :-
2215 compute_integer(B,Hyps,B1,Hyps1), number(B1), B1 \= 0,
2216 (compute_integer(A,Hyps1,A1,Hyps2), number(A1)
2217 -> Res is A1 // B1 % Prolog division corresponds to B division
2218 ; B1=1 -> Res=A, Hyps2=Hyps1).
2219 rewrite_integer(integer(X),Hyps,X,Hyps) :- integer(X), write(wd_unnormalised_integer(X)),nl. % should not happen
2220 rewrite_integer(real(X),Hyps,Res,Hyps) :- atom(X), construct_real(X,term(floating(Res))).
2221 rewrite_integer(convert_int_floor(RX),Hyps,X,Hyps1) :-
2222 compute_integer(RX,Hyps,RX1,Hyps1), number(RX1), X is floor(RX1). %, print(rewr_floor(RX,X)),nl.
2223 rewrite_integer(convert_int_ceiling(RX),Hyps,X,Hyps1) :-
2224 compute_integer(RX,Hyps,RX1,Hyps1), number(RX1), X is ceiling(RX1).
2225 rewrite_integer(convert_real(A),Hyps,RX,Hyps1) :-
2226 compute_integer(A,Hyps,A1,Hyps1), integer(A1), RX is float(A1).
2227
2228 rewrite_card_of_set(Set,Hyps,Size,Hyps2) :-
2229 ? compute_card_of_set(Set,Hyps,Size,Hyps2),!.
2230 rewrite_card_of_set(interval(1,Up),Hyps,Size,Hyps) :- !, % useful if Up is a symbolic expression
2231 Size=Up.
2232 rewrite_card_of_set(Set,Hyps,Size,Hyps2) :- rewrite_set_expression_exact(Set,Hyps,S2,Hyps1),
2233 rewrite_card_of_set(S2,Hyps1,Size,Hyps2).
2234
2235 ?compute_integer(A,Hyps,Res,Hyps) :- get_number(A,Hyps,Nr),!,Res=Nr.
2236 compute_integer(A,H,Res,H2) :- rewrite_integer(A,H,Res,H2).
2237
2238 get_number(A,_Hyps,Nr) :- number(A),!,Nr=A.
2239 get_number('$'(ID),Hyps,Nr) :- Hyps \= nohyps,
2240 ? avl_fetch_equal_from_hyps('$'(ID),Hyps,Nr,_Hyps1), number(Nr).
2241
2242
2243 :- use_module(probsrc(b_global_sets), [enumerated_set/1, b_global_set_cardinality/2]).
2244 compute_card_of_set(empty_set,Hyps,0,Hyps).
2245 compute_card_of_set(empty_sequence,Hyps,0,Hyps).
2246 compute_card_of_set(bool_set,Hyps,2,Hyps).
2247 compute_card_of_set(interval(L,U),Hyps,Size,Hyps) :- number(L), number(U), Size is U+1-L.
2248 compute_card_of_set(value(Val),Hyps,Size,Hyps) :- get_set_val_size(Val,Size).
2249 compute_card_of_set(sequence_extension(List),Hyps,Size,Hyps) :- length(List,Size).
2250 compute_card_of_set(set_extension([_]),Hyps,Size,Hyps) :- Size=1. % to do check if all elements definitely different
2251 compute_card_of_set(sorted_set_extension([_]),Hyps,Size,Hyps) :- Size=1. % ditto
2252 compute_card_of_set(rev(A),Hyps,Size,Hyps2) :- !, compute_card_of_set(A,Hyps,Size,Hyps2).
2253 compute_card_of_set(front(A),Hyps,Size,Hyps2) :- !, compute_card_of_set(tail(A),Hyps,Size,Hyps2).
2254 compute_card_of_set(tail(A),Hyps,Size,Hyps2) :- !,
2255 compute_card_of_set(A,Hyps,Size1,Hyps2), number(Size1), Size1>0,
2256 Size is Size1-1.
2257 compute_card_of_set(concat(A,B),Hyps,Size,Hyps2) :-
2258 compute_card_of_set(A,Hyps,SA,Hyps1),!,
2259 compute_card_of_set(B,Hyps1,SB,Hyps2),
2260 Size is SA+SB.
2261 compute_card_of_set('$'(ID),Hyps,Size,Hyps) :- is_enumerated_set(ID,Hyps),
2262 !,
2263 b_global_set_cardinality(ID,Size).
2264 compute_card_of_set('$'(ID),Hyps,Size,Hyps2) :-
2265 ? avl_fetch_equal_from_hyps('$'(ID),Hyps,X2,Hyps1),
2266 compute_card_of_set(X2,Hyps1,Size,Hyps2),!.
2267 compute_card_of_set('$'(ID),Hyps,Size,Hyps4) :- % e.g., f:1..10 --> BOOL --> card(f) = 10
2268 ? avl_fetch_binop_from_hyps('$'(ID),member,Hyps,FunctionType,Hyps1),
2269 is_partial_function_type(FunctionType,Hyps1,Hyps2),
2270 get_exact_domain_of_func_or_rel_type(FunctionType,Hyps2,Dom,Hyps3),
2271 compute_card_of_set(Dom,Hyps3,Size,Hyps4).
2272 %compute_card_of_set(S,_,_,_) :- print(card_fail(S)),nl,fail.
2273
2274 get_set_val_size([],0).
2275 get_set_val_size(avl_set(AVL),Size) :- avl_size(AVL,Size).
2276
2277
2278 check_all_values_geq_val(intersection(A,B),Nr,Hyps) :-
2279 (check_all_values_geq_val(A,Nr,Hyps) -> true ; check_all_values_geq_val(B,Nr,Hyps)).
2280 check_all_values_geq_val(union(A,B),Nr,Hyps) :-
2281 (check_all_values_geq_val(A,Nr,Hyps) -> check_all_values_geq_val(B,Nr,Hyps)).
2282 check_all_values_geq_val(set_subtraction(A,_),Nr,Hyps) :-
2283 check_all_values_geq_val(A,Nr,Hyps).
2284 check_all_values_geq_val(interval(From,_),Nr,Hyps) :- check_leq(Nr,From,Hyps).
2285 check_all_values_geq_val(value(avl_set(AVL)),Nr,Hyps) :- avl_min(AVL,int(Min)), check_leq(Nr,Min,Hyps).
2286 check_all_values_geq_val('NATURAL',Nr,Hyps) :- check_leq(Nr,0,Hyps).
2287 check_all_values_geq_val('NATURAL1',Nr,Hyps) :- check_leq(Nr,1,Hyps).
2288 check_all_values_geq_val(domain(Func),Nr,Hyps) :-
2289 ? get_domain_or_superset(Func,Hyps,DomFunc,Hyps2),
2290 ? check_all_values_geq_val(DomFunc,Nr,Hyps2).
2291 check_all_values_geq_val(range(Func),Nr,Hyps) :-
2292 ? get_range_or_superset(Func,Hyps,RanFunc,Hyps2),
2293 check_all_values_geq_val(RanFunc,Nr,Hyps2).
2294 check_all_values_geq_val(sorted_set_extension(L),Nr,Hyps) :- !, check_all_values_geq_val(set_extension(L),Nr,Hyps).
2295 check_all_values_geq_val(set_extension(L),Nr,Hyps) :-
2296 ? (member(Val,L), \+ check_leq(Nr,Val,Hyps) -> fail ; true).
2297 check_all_values_geq_val('$'(X),Nr,Hyps) :-
2298 ? avl_fetch_equal_from_hyps('$'(X),Hyps,Y,Hyps2),
2299 rewrite_local_loop_check(X,check_all_values_geq_val,Y,Hyps2,Hyps3),
2300 check_all_values_geq_val(Y,Nr,Hyps3).
2301 %check_all_values_geq_val(A,B,_) :- print(check_all_values_geq_val_failed(A,B)),nl,fail.
2302
2303 check_all_values_neq_nr(intersection(A,B),Nr,Hyps) :-
2304 (check_all_values_neq_nr(A,Nr,Hyps) -> true ; check_all_values_neq_nr(B,Nr,Hyps)).
2305 check_all_values_neq_nr(union(A,B),Nr,Hyps) :-
2306 (check_all_values_neq_nr(A,Nr,Hyps) -> check_all_values_neq_nr(B,Nr,Hyps)).
2307 check_all_values_neq_nr(set_subtraction(A,_),Nr,Hyps) :-
2308 check_all_values_neq_nr(A,Nr,Hyps).
2309 check_all_values_neq_nr(interval(From,_),Nr,Hyps) :- number(From),F1 is From-1, check_leq(Nr,F1,Hyps).
2310 check_all_values_neq_nr(interval(_,To),Nr,Hyps) :- number(To),T1 is To+1, check_leq(T1,Nr,Hyps).
2311 check_all_values_neq_nr('NATURAL',Nr,Hyps) :- check_leq(Nr,-1,Hyps).
2312 check_all_values_neq_nr('NATURAL1',Nr,Hyps) :- check_leq(Nr,0,Hyps).
2313 check_all_values_neq_nr(sorted_set_extension(L),Nr,Hyps) :- !, check_all_values_neq_nr(set_extension(L),Nr,Hyps).
2314 check_all_values_neq_nr(set_extension(L),Nr,Hyps) :-
2315 (member(Val,L), \+ check_not_equal(Val,Nr,Hyps) -> fail ; true).
2316 check_all_values_neq_nr('$'(X),Nr,Hyps) :-
2317 avl_fetch_equal_from_hyps('$'(X),Hyps,Y,Hyps2),
2318 rewrite_local_loop_check(X,check_all_values_neq_nr,Y,Hyps2,Hyps3),
2319 check_all_values_neq_nr(Y,Nr,Hyps3).
2320 %check_all_values_neq_nr(A,B,_) :- print(check_all_values_neq_nr_failed(A,B)),nl,fail.
2321
2322
2323 check_all_values_leq_val(intersection(A,B),Nr,Hyps) :-
2324 (check_all_values_leq_val(A,Nr,Hyps) -> true ; check_all_values_leq_val(B,Nr,Hyps)).
2325 check_all_values_leq_val(union(A,B),Nr,Hyps) :-
2326 (check_all_values_leq_val(A,Nr,Hyps) -> check_all_values_leq_val(B,Nr,Hyps)).
2327 check_all_values_leq_val(set_subtraction(A,_),Nr,Hyps) :-
2328 check_all_values_leq_val(A,Nr,Hyps).
2329 check_all_values_leq_val(interval(_,To),Nr,Hyps) :- check_leq(To,Nr,Hyps).
2330 check_all_values_leq_val(value(avl_set(AVL)),Nr,Hyps) :- avl_max(AVL,int(Max)), check_leq(Max,Nr,Hyps).
2331 check_all_values_leq_val(domain(Func),Nr,Hyps) :-
2332 get_domain_or_superset(Func,Hyps,DomFunc,Hyps2),
2333 check_all_values_leq_val(DomFunc,Nr,Hyps2).
2334 check_all_values_leq_val(range(Func),Nr,Hyps) :-
2335 ? get_range_or_superset(Func,Hyps,RanFunc,Hyps2),
2336 check_all_values_leq_val(RanFunc,Nr,Hyps2).
2337 check_all_values_leq_val(sorted_set_extension(L),Nr,Hyps) :- !, check_all_values_leq_val(set_extension(L),Nr,Hyps).
2338 check_all_values_leq_val(set_extension(L),Nr,Hyps) :-
2339 ? (member(Val,L), \+ check_leq(Val,Nr,Hyps) -> fail ; true).
2340 check_all_values_leq_val('$'(X),Nr,Hyps) :-
2341 ? avl_fetch_equal_from_hyps('$'(X),Hyps,Y,Hyps2),
2342 rewrite_local_loop_check(X,check_all_values_leq_val,Y,Hyps2,Hyps3),
2343 check_all_values_leq_val(Y,Nr,Hyps3).
2344 %check_all_values_leq_val(A,B,_) :- print(check_all_values_leq_val(A,B)),nl,fail.
2345
2346 % check if two expressions are definitely different
2347 % usually called for check_not_equal 0 or empty_set
2348 check_not_equal(A,B,Hyp) :-
2349 ? is_explicit_value(A,AV,Hyp), is_explicit_value(B,BV,Hyp), !, AV \= BV.
2350 ?check_not_equal(X,Y,Hyp) :- sym_unify(X,Y,if_then_else(Pred,A1,A2),B),!,
2351 push_and_rename_normalized_hyp(Pred,Hyp,Hyp1),
2352 ? (hyps_inconsistent(Hyp1) -> true ; check_not_equal(A1,B,Hyp1) -> true),
2353 push_and_rename_normalized_hyp(negation(Pred),Hyp,Hyp2),
2354 (hyps_inconsistent(Hyp2) -> true ; check_not_equal(A2,B,Hyp2) -> true).
2355 check_not_equal(N1,N2,Hyps) :-
2356 avl_fetch_not_equal(N1,N2,Hyps),!.
2357 check_not_equal(couple(A1,A2),couple(B1,B2),Hyps) :- !,
2358 (check_not_equal(A1,B1,Hyps) -> true ; check_not_equal(A2,B2,Hyps)).
2359 check_not_equal(X,B,Hyps) :- number(B),
2360 ? try_get_set_of_possible_values(X,Hyps,SetX,Hyps2),
2361 ? check_all_values_neq_nr(SetX,B,Hyps2),!.
2362 % TO DO: compute also things like domain(...) for :wd s:perm(1..10) & x:dom(s) & res = 10/x
2363 ?check_not_equal(X,Y,Hyps) :- sym_unify(X,Y,unary_minus(A),B),number(B),!, BM is -B,
2364 check_not_equal(A,BM,Hyps).
2365 ?check_not_equal(X,Y,Hyps) :- sym_unify(X,Y,multiplication(A,B),0),!, % A*B /= 0 if A/=0 & B/=0
2366 check_not_equal(A,0,Hyps),check_not_equal(B,0,Hyps).
2367 ?check_not_equal(X,Y,Hyps) :- sym_unify(X,Y,power_of(A,_),0),!, % A**B /= 0 if A/=0
2368 check_not_equal(A,0,Hyps).
2369 ?check_not_equal(X,Y,Hyps) :- sym_unify(X,Y,Add,B),
2370 add_with_number(Add,A,Nr),!,
2371 (Nr>0 -> check_leq(B,A,Hyps) % A >= B => A+Nr > B => A+Nr /= B
2372 ; Nr=0 -> check_not_equal(A,B,Hyps)
2373 ; check_leq(A,B,Hyps)
2374 ).
2375 ?check_not_equal(X,Y,Hyps) :- sym_unify(X,Y,A,B),number(B),!,
2376 B1 is B+1,
2377 ? (check_leq(B1,A,Hyps) -> true % B < A
2378 ; B2 is B-1,
2379 ? check_leq(A,B2,Hyps)). % A < B
2380 ?check_not_equal(XX,YY,Hyps) :- sym_unify(XX,YY,'$'(A),B),
2381 ? avl_fetch_binop_from_hyps('$'(A),less_equal,Hyps,Y,Hyps2),
2382 (number(B) -> (B1 is B-1, check_leq(Y,B1,Hyps2) -> true)
2383 ; avl_fetch_not_equal('$'(A),Y,Hyps) % we have $(A) < Y => prove Y <= B
2384 -> check_leq(Y,B,Hyps2) % we can prove x<y & y<=z => x<z but we cannot yet prove x<=y & y<z => x<z
2385 ).
2386 ?check_not_equal(XX,YY,Hyps) :- sym_unify(XX,YY,'$'(A),B),
2387 ? avl_fetch_binop_from_hyps('$'(A),greater_equal,Hyps,Y,Hyps2),
2388 (number(B) -> (B1 is B+1, check_leq(B1,Y,Hyps2) -> true)
2389 ; avl_fetch_not_equal('$'(A),Y,Hyps) % we have $(A) < Y => prove Y <= B
2390 -> check_leq(B,Y,Hyps2) % see comments above
2391 ).
2392 ?check_not_equal(A,Empty,Hyp) :- is_empty_set_direct(Empty), !, check_not_empty_set(A,Hyp).
2393 check_not_equal(Empty,A,Hyp) :- is_empty_set_direct(Empty), !, check_not_empty_set(A,Hyp).
2394 check_not_equal(value(avl_set(A)),value(avl_set(B)),_) :- nonvar(A), nonvar(B),!, % nonvar should always be true
2395 \+ equal_avl_tree(A,B).
2396 check_not_equal(A,B,Hyps) :-
2397 (A=set_extension(LA) -> check_not_equal_set_extension(B,LA,Hyps)
2398 ; B=set_extension(LB) -> check_not_equal_set_extension(A,LB,Hyps)),!.
2399 check_not_equal(A,B,Hyps) :-
2400 (is_interval(A,Hyps,Low,Up) -> check_not_equal_interval(B,lhs,Low,Up,Hyps)
2401 ? ; is_interval(B,Hyps,Low,Up) -> check_not_equal_interval(A,rhs,Low,Up,Hyps)),!.
2402 check_not_equal(A,B,Hyps) :-
2403 ? avl_fetch_worthwhile_equal_from_hyps(A,Hyps,Value,Hyps2),!,
2404 check_not_equal(Value,B,Hyps2).
2405 check_not_equal(A,B,Hyps) :-
2406 ? avl_fetch_worthwhile_equal_from_hyps(B,Hyps,Value,Hyps2),!,
2407 check_not_equal(A,Value,Hyps2).
2408 %check_not_equal(A,B,Hyps) :- print(check_not_equal_failed(A,B)),nl,portray_hyps(Hyps),nl,fail.
2409
2410 check_not_equal_interval(MaxSet,_,_,_,Hyps) :- infinite_integer_set(MaxSet,Hyps).
2411 check_not_equal_interval(A,lhs,Low,Up,Hyps) :- is_interval(A,Hyps,LowA,UpA),
2412 (check_not_empty_interval(Low,Up,Hyps) -> true ; check_not_empty_interval(LowA,UpA,Hyps)),
2413 % if one of the intervals is non-empty then it is sufficient for one bound to be different
2414 (check_not_equal(LowA,Low,Hyps) -> true
2415 ; check_not_equal(UpA,Up,Hyps) -> true).
2416 % TODO: other intervals
2417
2418 infinite_integer_set('INTEGER',_).
2419 infinite_integer_set('NATURAL',_).
2420 infinite_integer_set('NATURAL1',_).
2421
2422 check_not_equal_set_extension(set_extension([B|TB]),[A|TA],Hyps) :- (TA=[];TB=[]),!,
2423 check_not_equal(A,B,Hyps). % TO DO: we can generalize this treatment to find one element in one set not in the other
2424 check_not_equal_set_extension(value(avl_set(AVL)),LA,Hyps) :- length(LA,MaxSizeA),
2425 (avl_size(AVL,Sze),Sze>MaxSizeA -> true % AVL has at least one element more
2426 ; is_one_element_avl(AVL,B), LA=[A|_], check_not_equal(A,B,Hyps)).
2427
2428 avl_fetch_not_equal(N1,N2,hyp_rec(AVL,_)) :-
2429 (avl_fetch(not_equal(N1,N2),AVL) -> true
2430 ; avl_fetch(not_equal(N2,N1),AVL)). % we do not store both directions for not_equal
2431
2432 % unify two variables with other two variables; useful for symmetric rules
2433 sym_unify(A,B,A,B).
2434 sym_unify(A,B,B,A).
2435
2436 % TO DO: get equalities; maybe we should harmonise this for all rules
2437 % we could add rules about min_int, max_int
2438
2439
2440 % we should call this to check if something is the empty set:
2441 % it does equality rewrites, but also calls check_empty_set/3 indirectly
2442 check_equal_empty_set(Set,Hyps,PT) :-
2443 ? check_equal(Set,empty_set,Hyps,PT). % will also call this below:
2444
2445 is_empty_set_direct(empty_set).
2446 is_empty_set_direct(empty_sequence).
2447 is_empty_set_direct(value(X)) :- X==[].
2448
2449 check_empty_set(Set,_,empty_set) :- is_empty_set_direct(Set),!.
2450 check_empty_set(A,Hyps,hyp) :- avl_fetch_from_hyps(equal(A,empty_set),Hyps),!.
2451 check_empty_set(set_subtraction(A,B),Hyp,subset(PT)) :- !, % see SIMP_SETMINUS_EQUAL_EMPTY Rodin proof rule
2452 check_is_subset(A,B,Hyp,PT).
2453 check_empty_set(intersection(A,B),Hyps,inter_disjoint) :- !,
2454 ? check_disjoint(A,B,Hyps).
2455 check_empty_set(union(A,B),Hyps,union_empty(P1,P2)) :- !, % SIMP_BUNION_EQUAL_EMPTY
2456 check_equal_empty_set(A,Hyps,P1),!,
2457 check_equal_empty_set(B,Hyps,P2).
2458 check_empty_set(general_union(A),Hyp,general_union(PT)) :- !, % SIMP_KUNION_EQUAL_EMPTY
2459 check_is_subset(A,set_extension([empty_set]),Hyp,PT).
2460 check_empty_set(cartesian_product(A,B),Hyps,cart_empty(PT)) :- !, % SIMP_CPROD_EQUAL_EMPTY
2461 (check_equal_empty_set(A,Hyps,PT) -> true ; check_equal_empty_set(B,Hyps,PT)).
2462 check_empty_set(pow1_subset(A),Hyps,pow1_empty(PT)) :- !, % SIMP_POW1_EQUAL_EMPTY
2463 check_equal_empty_set(A,Hyps,PT).
2464 check_empty_set(interval(From,To),Hyps,interval_empty) :- !, % SIMP_UPTO_EQUAL_EMPTY
2465 check_less(To,From,Hyps).
2466 check_empty_set(domain(A),Hyps,domain_empty(PT)) :- !, % SIMP_DOM_EQUAL_EMPTY
2467 check_equal_empty_set(A,Hyps,PT).
2468 check_empty_set(range(A),Hyps,range_empty(PT)) :- !, % SIMP_RAN_EQUAL_EMPTY
2469 check_equal_empty_set(A,Hyps,PT).
2470 check_empty_set(reverse(A),Hyps,reverse_empty(PT)) :- !, % SIMP_CONVERSE_EQUAL_EMPTY (relational inverse)
2471 check_equal_empty_set(A,Hyps,PT).
2472 check_empty_set(total_relation(A,B),Hyp,trel_empty(PTA,PTB)) :- !, % SIMP_SPECIAL_EQUAL_RELDOM
2473 ? check_not_equal_empty_set(A,Hyp,PTA), check_equal_empty_set(B,Hyp,PTB).
2474 check_empty_set(total_function(A,B),Hyp,tfun_empty(PTA,PTB)) :- !, % SIMP_SPECIAL_EQUAL_RELDOM
2475 ? check_not_equal_empty_set(A,Hyp,PTA), check_equal_empty_set(B,Hyp,PTB).
2476 check_empty_set(composition(F,G),Hyp,fcomp_empty) :- !, % SIMP_FCOMP_EQUAL_EMPTY
2477 check_disjoint(range(F),domain(G),Hyp).
2478 check_empty_set(A,Hyps,subset_strict_singleton) :-
2479 ? avl_fetch_binop_from_hyps(A,subset_strict,Hyps,B,_), % A <<: {Single} => A={}
2480 singleton_set(B,_).
2481 % TODO: add more rules inter(A,Singleton) SIMP_BINTER_SING_EQUAL_EMPTY
2482
2483 % we should call this to check if something is not the empty set:
2484 % it does equality rewrites, but also calls check_not_empty_set/2 indirectly
2485 check_not_equal_empty_set(Set,Hyps,not_equal_empty_set) :-
2486 ? check_not_equal(Set,empty_set,Hyps).
2487
2488 check_not_empty_set(A,Hyps) :- avl_fetch_from_hyps(not_equal(A,empty_set),Hyps),!.
2489 check_not_empty_set(A,Hyps) :- %Note: size(A) should be changed to card(A) in normalization
2490 (CardA = card(A) ; CardA = size(A)),
2491 (Op = equal ; Op = greater_equal),
2492 ? avl_fetch_binop_from_hyps(CardA,Op,Hyps,Nr,Hyps2), %Nr \= 0,
2493 check_leq(1,Nr,Hyps2),!. % cut here, relevant for test 2043
2494 check_not_empty_set(set_extension([_|_]),_Hyps).
2495 check_not_empty_set(sorted_set_extension([_|_]),_Hyps).
2496 check_not_empty_set(sequence_extension([_|_]),_Hyps).
2497 check_not_empty_set(cartesian_product(A,B),Hyps) :- % SIMP_CPROD_EQUAL_EMPTY
2498 (check_not_empty_set(A,Hyps) -> check_not_empty_set(B,Hyps)).
2499 check_not_empty_set(interval(A,B),Hyps) :- check_leq(A,B,Hyps).
2500 check_not_empty_set(value(avl_set(AVL)),_) :- AVL \= empty.
2501 ?check_not_empty_set(union(A,B),Hyp) :- !, (check_not_empty_set(A,Hyp) -> true ; check_not_empty_set(B,Hyp)).
2502 check_not_empty_set(general_union(A),Hyp) :- !, % SIMP_KUNION_EQUAL_EMPTY
2503 check_not_subset(A,set_extension([empty_set]),Hyp,_PT).
2504 check_not_empty_set(set_subtraction(A,B),Hyp) :- !, % see SIMP_SETMINUS_EQUAL_EMPTY Rodin proof rule
2505 check_not_subset(A,B,Hyp,_PT).
2506 ?check_not_empty_set(overwrite(A,B),Hyp) :- !, (check_not_empty_set(A,Hyp) -> true ; check_not_empty_set(B,Hyp)).
2507 check_not_empty_set(domain(A),Hyp) :- !, % SIMP_DOM_EQUAL_EMPTY
2508 check_not_empty_set(A,Hyp).
2509 check_not_empty_set(range(A),Hyp) :- !, % SIMP_RAN_EQUAL_EMPTY
2510 check_not_empty_set(A,Hyp).
2511 check_not_empty_set(identity(A),Hyp) :- !, check_not_empty_set(A,Hyp).
2512 check_not_empty_set(image(R,interval(L,U)),Hyp) :- !,
2513 ? check_not_empty_set(interval(L,U),Hyp),
2514 (check_member_of_set(domain(R),L,Hyp,_) -> true
2515 ; check_member_of_set(domain(R),U,Hyp,_)
2516 ).
2517 check_not_empty_set(image(Func,set_extension([S1|_])),Hyp) :- !,
2518 check_member_of_set(domain(Func),S1,Hyp,_).
2519 check_not_empty_set(reverse(A),Hyp) :- !, % SIMP_CONVERSE_EQUAL_EMPTY (relational inverse)
2520 check_not_empty_set(A,Hyp).
2521 check_not_empty_set(rev(A),Hyp) :- !, check_not_empty_set(A,Hyp).
2522 check_not_empty_set(concat(A,B),Hyp) :- !, (check_not_empty_set(A,Hyp) -> true ; check_not_empty_set(B,Hyp)).
2523 check_not_empty_set(bool_set,_Hyp) :- !.
2524 check_not_empty_set(float_set,_Hyp) :- !.
2525 check_not_empty_set(real_set,_Hyp) :- !.
2526 check_not_empty_set(string_set,_Hyp) :- !.
2527 check_not_empty_set('NATURAL1',_Hyp) :- !. % SIMP_NATURAL1_EQUAL_EMPTY
2528 check_not_empty_set('NATURAL',_Hyp) :- !. % SIMP_NATURAL_EQUAL_EMPTY
2529 check_not_empty_set(typeset,_Hyp) :- !. % SIMP_TYPE_EQUAL_EMPTY, all basic sets are non empty in B and Event-B
2530 check_not_empty_set(relations(_,_),_Hyp) :- !. % SIMP_SPECIAL_EQUAL_REL
2531 check_not_empty_set(total_function(A,B),Hyp) :- !, % SIMP_SPECIAL_EQUAL_RELDOM
2532 ( check_equal_empty_set(A,Hyp,_) -> true
2533 ? ; check_not_equal_empty_set(B,Hyp,_) -> true
2534 ; check_equal(A,B,Hyp,_)). % implicit proof by case distinction
2535 check_not_empty_set(total_relation(A,B),Hyp) :- !, % SIMP_SPECIAL_EQUAL_RELDOM
2536 check_not_empty_set(total_function(A,B),Hyp).
2537 check_not_empty_set(if_then_else(Pred,A,B),Hyp) :- !,
2538 push_and_rename_normalized_hyp(Pred,Hyp,Hyp1),
2539 (hyps_inconsistent(Hyp1) -> true ; check_not_empty_set(A,Hyp1) -> true),
2540 push_and_rename_normalized_hyp(negation(Pred),Hyp,Hyp2),
2541 (hyps_inconsistent(Hyp2) -> true ; check_not_empty_set(B,Hyp2) -> true).
2542 check_not_empty_set(Expr,Hyps) :-
2543 ? is_lambda_function_with_domain(Expr,Domain),!,
2544 check_not_empty_set(Domain,Hyps).
2545 check_not_empty_set('$'(ID),Hyps) :-
2546 enumerated_set(ID),
2547 \+ is_hyp_var(ID,Hyps),!. % global enumerated set visible
2548 check_not_empty_set(Eq,Hyps) :-
2549 (Eq='$'(_) ; Eq=interval(_,_)),
2550 ? avl_fetch_equal_from_hyps(Eq,Hyps,Value,Hyps2),
2551 rewrite_local_loop_check(Eq,check_not_empty_set,Value,Hyps2,Hyps3),
2552 ? check_not_empty_set(Value,Hyps3),!.
2553 ?check_not_empty_set(Seq,Hyp) :- infer_sequence_type_of_expr(Seq,Hyp,seq1),!.
2554 check_not_empty_set(Func,Hyps) :- Func = '$'(_),
2555 ? avl_fetch_binop_from_hyps(Func,member,Hyps,FunctionType,Hyps2), % Func : . --> .
2556 ? check_not_empty_elements(FunctionType,Hyps2),!.
2557 check_not_empty_set(function(Func,Args),Hyps) :-
2558 ? (get_range_or_superset(Func,Hyps,Range,Hyps2),
2559 check_not_empty_elements(Range,Hyps2) -> !,true
2560 ? ; rewrite_function_application(Func,Args,Hyps,Result,Hyps2),
2561 check_not_empty_set(Result,Hyps2)).
2562 check_not_empty_set(tail(A),Hyps) :- rewrite_card_of_set(A,Hyps,CardA,Hyps1),!,
2563 check_leq(2,CardA,Hyps1).
2564 check_not_empty_set(front(A),Hyps) :- rewrite_card_of_set(A,Hyps,CardA,Hyps1),!,
2565 check_leq(2,CardA,Hyps1).
2566 check_not_empty_set(A,Hyps) :-
2567 ? avl_fetch_binop_from_hyps(A,not_subset_strict,Hyps,B,_), % A <<: {Single} <=> A={}
2568 singleton_set(B,_),!.
2569 check_not_empty_set(A,Hyps) :-
2570 ( Lookup = A, Operator = superset
2571 ;
2572 (Lookup=domain(A) ; Lookup=range(A)),
2573 (Operator = superset ; Operator = equal)
2574 ),
2575 ? avl_fetch_binop_from_hyps(Lookup,Operator,Hyps,B,Hyps2), % B /= {} & B <: A => A /= {}
2576 rewrite_local_loop_check(A,check_not_empty_set,B,Hyps2,Hyps3),
2577 ? check_not_empty_set(B,Hyps3),!.
2578 % TO DO: rule for dom(r)<:A and r not empty implies A not empty; problem: we need lookup for A=dom(r), or dom(r)<:A, could be of form: r:A+->B
2579 %check_not_empty_set(A,H) :- print(check_not_empty_set_failed(A)),nl,portray_hyps(H),nl,fail.
2580 % TO DO: more rules for sequence operators; infer_sequence_type_of_expr does not look at values of ids
2581
2582
2583 % check if elements of a function type or set are guaranteed to be not empty
2584
2585 check_not_empty_elements(fin1_subset(_),_).
2586 check_not_empty_elements(pow1_subset(_),_).
2587 check_not_empty_elements(seq1(_),_).
2588 check_not_empty_elements(iseq1(_),_).
2589 check_not_empty_elements(perm(A),Hyps) :- check_not_empty_set(A,Hyps).
2590 ?check_not_empty_elements(total_function(A,_),Hyps) :- check_not_empty_set(A,Hyps).
2591 check_not_empty_elements(total_injection(A,_),Hyps) :- check_not_empty_set(A,Hyps).
2592 check_not_empty_elements(total_surjection(A,B),Hyps) :-
2593 (check_not_empty_set(A,Hyps) -> true ; check_not_empty_set(B,Hyps)).
2594 check_not_empty_elements(total_bijection(A,B),Hyps) :-
2595 (check_not_empty_set(A,Hyps) -> true ; check_not_empty_set(B,Hyps)).
2596 check_not_empty_elements(total_relation(A,_),Hyps) :- check_not_empty_set(A,Hyps).
2597 check_not_empty_elements(total_surjection_relation(A,_),Hyps) :- check_not_empty_set(A,Hyps).
2598 check_not_empty_elements(partial_surjection(_,B),Hyps) :- check_not_empty_set(B,Hyps).
2599 check_not_empty_elements(partial_bijection(_,B),Hyps) :- check_not_empty_set(B,Hyps).
2600 check_not_empty_elements(surjection_relation(_,B),Hyps) :- check_not_empty_set(B,Hyps).
2601 % more cases, set_extension,...
2602
2603 :- use_module(probsrc(b_global_sets),[enumerated_set/1]).
2604 % check if an expression is definitely finite
2605 check_finite(bool_set,_,bool_set) :- !.
2606 check_finite(empty_set,_,empty_set) :- !.
2607 check_finite(empty_sequence,_,empty_sequence) :- !.
2608 check_finite(float_set,_,float_set) :- !.
2609 % check_finite(integer_set(X),_,bool_set) :- !. INT, NAT, NAT1 are translated to intervals
2610 check_finite(set_extension(_),_,set_extension) :- !.
2611 check_finite(sorted_set_extension(_),_,set_extension) :- !.
2612 check_finite(sequence_extension(_),_,seq_extension) :- !.
2613 check_finite(fin_subset(X),Hyps,fin(PT)) :- !, check_finite(X,Hyps,PT).
2614 check_finite(fin1_subset(X),Hyps,fin1(PT)) :- !, check_finite(X,Hyps,PT).
2615 check_finite(pow_subset(X),Hyps,pow(PT)) :- !, check_finite(X,Hyps,PT).
2616 check_finite(pow1_subset(X),Hyps,pow1(PT)) :- !, check_finite(X,Hyps,PT).
2617 check_finite(iseq(X),Hyps,iseq(PT)) :- !, check_finite(X,Hyps,PT).
2618 check_finite(iseq1(X),Hyps,iseq1(PT)) :- !, check_finite(X,Hyps,PT).
2619 check_finite(mu(Set),Hyps,mu) :- !, has_finite_elements(Set,Hyps).
2620 check_finite(perm(X),Hyps,perm(PT)) :- !, check_finite(X,Hyps,PT).
2621 check_finite(Set,Hyps,hyp) :-
2622 avl_fetch_from_hyps(finite(Set),Hyps),!.
2623 check_finite(domain(A),Hyp,dom(PT)) :- !,
2624 ? (check_finite(A,Hyp,PT) -> true ; finite_domain(A,Hyp,PT)).
2625 check_finite(range(A),Hyp,ran(PT)) :- !,
2626 ? (check_finite(A,Hyp,PT) -> true ; finite_range(A,Hyp,PT)).
2627 ?check_finite(reverse(A),Hyp,rev(PT)) :- !, check_finite(A,Hyp,PT).
2628 check_finite(identity(A),Hyp,id(PT)) :- !,check_finite(A,Hyp,PT). % finite(id(A)) if finite(A)
2629 check_finite(function(Func,Args),Hyps,function(PT)) :- !,
2630 ? (get_range_or_superset(Func,Hyps,RanFunc,Hyps2),
2631 has_finite_elements(RanFunc,Hyps2) -> PT = finite_elements
2632 ; rewrite_function_application(Func,Args,Hyps,Result,Hyps2),
2633 check_finite(Result,Hyps2,PT)).
2634 check_finite(image(Func,B),Hyp,image(PT)) :- !,
2635 ? (check_finite(Func,Hyp,PT) -> true % finite(Func[.]) <= finite(Func)
2636 ; check_finite(B,Hyp,PTB)
2637 ? -> PT = pfun(PTB), check_is_partial_function(Func,Hyp) % finite(Func[B]) <= finite(B) & Func : TD +-> TR
2638 ).
2639 ?check_finite(union(A,B),Hyp,union(PTA,PTB)) :- !, (check_finite(A,Hyp,PTA) -> check_finite(B,Hyp,PTB)).
2640 check_finite(if_then_else(Pred,A,B),Hyps,if(PTA,PTB)) :- !,
2641 push_and_rename_normalized_hyp(Pred,Hyps,Hyps1),
2642 (hyps_inconsistent(Hyps1) -> true ; check_finite(A,Hyps1,PTA) -> true),
2643 push_and_rename_normalized_hyp(negation(Pred),Hyps,Hyps2),
2644 (hyps_inconsistent(Hyps2) -> true ; check_finite(B,Hyps2,PTB) -> true).
2645 check_finite(intersection(A,B),Hyps,intersection(D,PT)) :- !,
2646 ? (D=left,check_finite(A,Hyps,PT) -> true ; D=right,check_finite(B,Hyps,PT)).
2647 check_finite(cartesian_product(A,B),Hyp,cart(PT)) :-
2648 (check_finite(A,Hyp,PT) -> (check_equal_empty_set(A,Hyp,_PT2) -> true ; check_finite(B,Hyp,_PT2))
2649 ; check_equal_empty_set(B,Hyp,PT)).
2650 check_finite(Rel,Hyp,rel(PTA,PTB)) :- is_relations_type(Rel,A,B),!,
2651 (check_finite(A,Hyp,PTA) -> check_finite(B,Hyp,PTB)). % add other relations
2652 check_finite(direct_product(A,B),Hyp,direct_product(PTA,PTB)) :- !,
2653 (check_finite(A,Hyp,PTA) -> check_finite(B,Hyp,PTB)).
2654 check_finite(parallel_product(A,B),Hyp,parallel_product(PTA,PTB)) :- !,
2655 (check_finite(A,Hyp,PTA) -> check_finite(B,Hyp,PTB)).
2656 ?check_finite(overwrite(A,B),Hyp,overwrite(PTA,PTB)) :- !, (check_finite(A,Hyp,PTA) -> check_finite(B,Hyp,PTB)).
2657 check_finite(set_subtraction(A,_),Hyps,set_subtraction(PT)) :- !, check_finite(A,Hyps,PT).
2658 check_finite(domain_restriction(A,BRel),Hyp,domain_restriction(PT)) :- !,
2659 ? (check_finite(BRel,Hyp,PT) -> true
2660 ; check_is_partial_function(BRel,Hyp), check_finite(A,Hyp,PT)
2661 ; finite_range(BRel,Hyp,_) -> check_finite(A,Hyp,PT) % finite(a <| brel) if finite(a) & finite(ran(brel))
2662 ).
2663 ?check_finite(domain_subtraction(_,B),Hyp,domain_subtraction(PT)) :- !, check_finite(B,Hyp,PT).
2664 check_finite(range_restriction(ARel,B),Hyp,range_restriction(PT)) :- !,
2665 ? (check_finite(ARel,Hyp,PT) -> true
2666 ; check_is_injective(ARel,Hyp) -> check_finite(B,Hyp,PT)
2667 ; finite_domain(ARel,Hyp,_) -> check_finite(B,Hyp,PT) % finite(arel |> b) if finite(b) & finite(dom(arel))
2668 ).
2669 check_finite(image(A,B),Hyp,image(PT)) :- % A[B] is finite if A is finite or if B is finite and A a function
2670 (check_finite(A,Hyp,PT) -> true ; check_is_partial_function(A,Hyp), check_finite(B,Hyp,PT)).
2671 check_finite(range_subtraction(A,_),Hyp,range_subtraction(PT)) :- check_finite(A,Hyp,PT).
2672 check_finite(interval(_,_),_,interval) :- !.
2673 check_finite(value(V),_,empty_set_value) :- V==[], !.
2674 check_finite(value(X),_,avl_set) :- nonvar(X),X=avl_set(_),!.
2675 check_finite('$'(ID),Hyps,finite_type) :-
2676 get_hyp_var_type(ID,Hyps,Type), %print(chk_fin(ID,Type)),nl,
2677 (is_finite_type_for_wd(Type,Hyps) -> true
2678 ; Type = set(couple(DomType,_)), % in principle an infinite relation type
2679 is_finite_type_for_wd(DomType,Hyps), % we have something like set(couple(boolean,integer))
2680 % note: we treat this here in addition to the case is_partial_function below, as
2681 % sometimes we loose the typing information in the term, e.g., in comprehension_set
2682 ? avl_fetch_equal_from_hyps('$'(ID),Hyps,Func,_),
2683 ? is_lambda_function(Func) % we have a function, it is finite if the domain is finite
2684 ),!.
2685 check_finite('$'(ID),Hyps,enumerated_set) :-
2686 enumerated_set(ID),
2687 \+ is_hyp_var(ID,Hyps),!. % global enumerated set visible
2688 %check_finite('$'(ID),Hyp,partition) :-
2689 % avl_fetch_binop_from_hyps('$'(ID),partition,Hyp,Values,Hyp2), % is now normalized
2690 % not_occurs(Values,ID),
2691 % l_check_finite(Values,Hyp2),!.
2692 check_finite('$'(ID),Hyps,rewrite(Operator,PT)) :-
2693 (Operator = equal ; Operator = subset), % for subset_strict we also have subset in Hyp
2694 ? avl_fetch_binop_from_hyps('$'(ID),Operator,Hyps,Set2,Hyps2),
2695 not_occurs(Set2,ID), % avoid silly, cyclic rewrites $x -> reverse(reverse($x)) (FunLawsStrings.mch)
2696 % however, in SetLawsNatural this prevents proving 2 POs due to SS <: min(SS)..max(SS)
2697 rewrite_local_loop_check(ID,check_finite,Set2,Hyps2,Hyps3),
2698 check_finite(Set2,Hyps3,PT),!.
2699 check_finite(Set,Hyp,finite_elements) :- id_or_record_field(Set),
2700 ? avl_fetch_mem_or_struct(Set,Hyp,Set2,Hyp2),
2701 Set2 \= Set,
2702 ? has_finite_elements(Set2,Hyp2).
2703 check_finite(Func,Hyp,pfun(PTA,PTB)) :- is_partial_function(Func,A,B),!,
2704 % a set of partial functions from A to B is finite if both A and B are finite
2705 (check_finite(A,Hyp,PTA) -> check_finite(B,Hyp,PTB)),!.
2706 ?check_finite(Seq,Hyp,seq_type) :- infer_sequence_type_of_expr(Seq,Hyp,_),!. % a sequence is always finite
2707 check_finite(comprehension_set(Paras,Body),Hyp,comprehension_set) :-
2708 finite_comprehension_set(Paras,Body,Hyp),!.
2709 check_finite(struct(rec(Fields)),Hyp,struct) :- maplist(check_finite_field(Hyp),Fields).
2710 check_finite(general_union(SetOfSets),Hyp,general_union) :-
2711 ? check_all_finite(SetOfSets,Hyp).
2712 check_finite(general_intersection(SetOfSets),Hyp,general_intersection(PT)) :-
2713 check_some_finite(SetOfSets,Hyp,PT).
2714 % TODO: is_lambda_function_with_domain; improve some proof trees above in style of intersection
2715 %check_finite(F,Hyps,_) :- print(check_finite_failed(F)),nl,portray_hyps(Hyps),nl,fail.
2716
2717 check_finite_field(Hyp,field(_,Set)) :- check_finite(Set,Hyp,_PT).
2718
2719 % we could write a check_all meta_predicate
2720 % check if we have a finite set of finite sets; used to determine if union(Sets) is finite
2721 check_all_finite(empty_set,_).
2722 check_all_finite(empty_sequence,_).
2723 check_all_finite(value(avl_set(_AVL)),_Hyp) :- % currently avl_set can only contain finite values for normalisation
2724 true.
2725 check_all_finite(intersection(A,B),Hyps) :-
2726 (check_all_finite(A,Hyps) -> true ; check_all_finite(B,Hyps)).
2727 check_all_finite(union(A,B),Hyps) :-
2728 ? (check_all_finite(A,Hyps) -> check_all_finite(B,Hyps)).
2729 check_all_finite(sorted_set_extension(L),Hyps) :- !, check_all_finite(set_extension(L),Hyps).
2730 check_all_finite(set_extension(L),Hyps) :-
2731 (member(Val,L), \+ check_finite(Val,Hyps,_) -> fail % CHECK
2732 ; true).
2733 check_all_finite('$'(ID),Hyps) :-
2734 (Operator = equal ; Operator = subset), % for subset_strict we also have subset in Hyp
2735 ? avl_fetch_binop_from_hyps('$'(ID),Operator,Hyps,Set2,Hyps2),
2736 not_occurs(Set2,ID), % avoid silly, cyclic rewrites
2737 rewrite_local_loop_check(ID,check_finite,Set2,Hyps2,Hyps3),
2738 check_all_finite(Set2,Hyps3),!.
2739 check_all_finite(Op,Hyps) :- pow_subset_operator(Op,Set),!,
2740 % if Set is finite then all subsets of it are finite and there are only finitely many
2741 check_finite(Set,Hyps,_PT).
2742 check_all_finite(Op,Hyps) :- iseq_operator(Op,Set),!,
2743 % if Set is finite then all injective sequences of it are finite and there are only finitely many
2744 check_finite(Set,Hyps,_PT).
2745
2746 % check if some set of a set of sets is finite:
2747 check_some_finite(sorted_set_extension(L),Hyps,PT) :- !, check_some_finite(set_extension(L),Hyps,PT).
2748 check_some_finite(set_extension(L),Hyps,set_extension(PT)) :-
2749 (member(Val,L), check_finite(Val,Hyps,PT) -> true).
2750 check_some_finite('$'(ID),Hyps,rewrite_id(ID,PT)) :-
2751 (Operator = equal ; Operator = superset), % Note: superset not subset as for check_all_finite
2752 avl_fetch_binop_from_hyps('$'(ID),Operator,Hyps,Set2,Hyps2),
2753 not_occurs(Set2,ID), % avoid silly, cyclic rewrites
2754 rewrite_local_loop_check(ID,check_finite,Set2,Hyps2,Hyps3),
2755 check_some_finite(Set2,Hyps3,PT),!.
2756 %check_some_finite(intersection(A,B),Hyps) :- fail. % Note: the intersection could be empty!
2757 check_some_finite(union(A,B),Hyps,union(PT)) :-
2758 (check_some_finite(A,Hyps,PT) -> true ; check_some_finite(B,Hyps,PT)).
2759 % for pow_subset_operator iseq_operator we would still need to check that the sets are not empty
2760 % we cannot currently :prove x<:POW1(INT) & inter({NATURAL}\/x) : FIN(inter({NATURAL}\/x))
2761
2762
2763 pow_subset_operator(fin_subset(X),X).
2764 pow_subset_operator(fin1_subset(X),X).
2765 pow_subset_operator(pow_subset(X),X).
2766 pow_subset_operator(pow1_subset(X),X).
2767 iseq_operator(perm(Set),Set).
2768 iseq_operator(iseq(Set),Set).
2769 iseq_operator(iseq1(Set),Set).
2770
2771 % Note: lambdas already treated in is_partial_function check above
2772 finite_comprehension_set(Paras,Body,Hyp) :-
2773 % first exclude the parameters which can be proven finite on their own
2774 % now deal with the rest; we do not pass AllParas as second arg; as all references to excluded IDs is ok (only finitely many values possible)
2775 finite_comprehension_set_rest(Paras,Body,Hyp,[],Rest),
2776 Rest \= Paras,
2777 finite_comprehension_set_rest(Rest,Body,Hyp,[],[]). % do a second pass, e.g., for {x,y|x:{y,y+1} & y:1..2 & x:INTEGER}
2778
2779 finite_comprehension_set_rest([],_,_,_,[]).
2780 % finite_comprehension_set(['$'(ID)|TID],Body,Hyp) :- finite_type !
2781 finite_comprehension_set_rest([ParaID1|TID],Body,Hyp,UnProven,Rest) :-
2782 ? get_parameter_superset_in_body(ParaExpr,[ParaID1|TID],Body,Values),
2783 l_not_occurs(Values,UnProven), % do not rely on not yet finitely proven paras; e.g. for {x,y|x:INTEGER & y=x}
2784 ? match_parameter(ParaExpr,ParaID1),
2785 check_finite(Values,Hyp,_PT),!,
2786 finite_comprehension_set_rest(TID,Body,Hyp,UnProven,Rest).
2787 finite_comprehension_set_rest([ParaID1|TID],Body,Hyp,UnProven,[ParaID1|Rest]) :-
2788 finite_comprehension_set_rest(TID,Body,Hyp,[ParaID1|UnProven],Rest).
2789
2790 % match_parameter(Expr,ID) -> ID occurs in Expr and finite number of values for Expr implies finite values for ID
2791 match_parameter(ParaID,ParaID).
2792 match_parameter(couple(ParaID,_),ParaID). % x|->y : Values finite implies finitely many values for x
2793 match_parameter(couple(_,ParaID),ParaID).
2794 match_parameter(set_extension(Ext),ParaID) :-
2795 ? member(El,Ext), match_parameter(El,ParaID). % {x,..} : Values finite implies finitely many values for x
2796 match_parameter(sorted_set_extension(Ext),ParaID) :- match_parameter(set_extension(Ext),ParaID).
2797 ?match_parameter(sequence_extension(Ext),ParaID) :- member(ParaID,Ext).
2798 ?match_parameter(rev(RF),ParaID) :- match_parameter(RF,ParaID).
2799 match_parameter(reverse(RF),ParaID) :- match_parameter(RF,ParaID).
2800 match_parameter(unary_minus(RF),ParaID) :- match_parameter(RF,ParaID).
2801 ?match_parameter(concat(RF1,RF2),ParaID) :- (match_parameter(RF1,ParaID) -> true ; match_parameter(RF2,ParaID)).
2802 match_parameter(union(RF1,RF2),ParaID) :- (match_parameter(RF1,ParaID) -> true ; match_parameter(RF2,ParaID)).
2803 ?match_parameter(overwrite(_,RF),ParaID) :- match_parameter(RF,ParaID). % f <+ RF = (... <<| f ) \/ RF
2804 ?match_parameter(Add,ParaID) :- add_with_number(Add,A,_Number), match_parameter(A,ParaID).
2805 ?match_parameter(Mul,ParaID) :- mul_with_number(Mul,nohyps,A,Number), Number \= 0, match_parameter(A,ParaID).
2806 % TO DO: more injective functions where a solution determines the ParaID, identity? direct_product, ...
2807 % cartesian_product : only if other set not empty
2808
2809 get_parameter_superset_in_body(ParaID,AllParas,Body,Values) :-
2810 ? ( member_in_norm_conjunction(Body,member(ParaID,Values))
2811 ? ; member_in_norm_conjunction(Body,subset(ParaID,Values)) % there are only finitely many subsets of a finite set
2812 ; member_in_norm_conjunction(Body,subset_strict(ParaID,Values))
2813 ? ; member_in_norm_conjunction(Body,equal(X,Y)),
2814 ? sym_unify(X,Y,ParaID,Value), Values=set_extension([Value]) ),
2815 l_not_occurs(Values,AllParas). % as an alternative: check for finite_type of set elements; e.g., detect ID=bool(...)
2816
2817
2818 :- use_module(probsrc(bsyntaxtree),[is_set_type/2]).
2819 %we suppose this has already failed: finite_domain(A,Hyp) :- check_finite(A,Hyp,PT).
2820 finite_domain('$'(ID),Hyps,finite_type) :-
2821 get_hyp_var_type(ID,Hyps,Type),
2822 is_set_type(Type,couple(DomType,_)),
2823 is_finite_type_for_wd(DomType,Hyps),!.
2824 finite_domain(domain_restriction(A,Rel),Hyps,domain_restriction(PT)) :- !,
2825 (check_finite(A,Hyps,PT) -> true ; finite_domain(Rel,Hyps,PT)).
2826 ?finite_domain(A,Hyp,PT) :- get_domain_or_superset(A,Hyp,DA,Hyp2), check_finite(DA,Hyp2,PT).
2827
2828 finite_range('$'(ID),Hyps,finite_type) :-
2829 get_hyp_var_type(ID,Hyps,Type),
2830 is_set_type(Type,couple(_,RanType)),
2831 is_finite_type_for_wd(RanType,Hyps),!.
2832 ?finite_range(A,Hyp,PT) :- get_range_or_superset(A,Hyp,RA,Hyp2),!, check_finite(RA,Hyp2,PT).
2833
2834 l_check_finite([],_).
2835 l_check_finite([H|T],Hyp) :- (check_finite(H,Hyp,_) -> l_check_finite(T,Hyp)).
2836
2837 % is a set containing only finite sets
2838 has_finite_elements(fin_subset(_),_) :- !.
2839 has_finite_elements(fin1_subset(_),_) :- !.
2840 has_finite_elements(pow_subset(X),Hyps) :- !, check_finite(X,Hyps,_).
2841 has_finite_elements(pow1_subset(X),Hyps) :- !, check_finite(X,Hyps,_).
2842 has_finite_elements(seq(_),_) :- !. % every sequence is always finite (of finite length)
2843 has_finite_elements(seq1(_),_) :- !.
2844 has_finite_elements(iseq(_),_) :- !.
2845 has_finite_elements(iseq1(_),_) :- !.
2846 has_finite_elements(perm(_),_) :- !.
2847 has_finite_elements(union(A,B),Hyps) :- !, has_finite_elements(A,Hyps), has_finite_elements(B,Hyps).
2848 has_finite_elements(intersection(A,B),Hyps) :- !, (has_finite_elements(A,Hyps) -> true ; has_finite_elements(B,Hyps)).
2849 has_finite_elements(set_subtraction(A,_),Hyps) :- !, has_finite_elements(A,Hyps).
2850 has_finite_elements(sorted_set_extension(L),Hyps) :- !, l_check_finite(L,Hyps).
2851 has_finite_elements(set_extension(L),Hyps) :- !, l_check_finite(L,Hyps).
2852 has_finite_elements(S,_) :- is_empty_set_direct(S),!. % has no elements
2853 has_finite_elements(Func,Hyps) :- is_partial_function(Func,A,B),!,
2854 ? (check_finite(A,Hyps,_) -> true ; is_injective(Func), check_finite(B,Hyps,_)).
2855 ?has_finite_elements(Rel,Hyps) :- is_relations_type(Rel,A,B),!,check_finite(A,Hyps,_),check_finite(B,Hyps,_).
2856 %has_finite_elements(F,Hs) :- print(has_finite_elements_failed(F)),nl, portray_hyps(Hs),fail.
2857
2858
2859 is_relations_type(relations(A,B),A,B).
2860 is_relations_type(surjection_relation(A,B),A,B).
2861 is_relations_type(total_relation(A,B),A,B).
2862 is_relations_type(total_surjection_relation(A,B),A,B).
2863
2864 % TO DO: more rules for functions
2865 % ------------------------------
2866
2867 :- use_module(probsrc(avl_tools),[avl_fetch_bin/4]).
2868
2869 % fetch member(Ground,Free) construct
2870 %avl_fetch_mem(Key, AVL ,Res) :- avl_fetch_bin(Key, member, AVL ,Res).
2871 %avl_fetch_equal(Key, AVL ,Res) :- avl_fetch_bin(Key, equal, AVL ,Res).
2872
2873
2874 avl_fetch_mem_from_hyps(ID,Hyps,Value,Hyps2) :-
2875 ? avl_fetch_binop_from_hyps(ID,member,Hyps,Value,Hyps2).
2876
2877 avl_fetch_worthwhile_mem_from_hyps(ID,Hyps,Value,Hyps2) :-
2878 ? avl_fetch_binop_from_hyps(ID,member,Hyps,Value,Hyps2),
2879 \+ maximal_set(Value,Hyps2).
2880
2881 avl_fetch_equal_from_hyps(ID,Hyps,Value,Hyps2) :-
2882 ? avl_fetch_binop_from_hyps(ID,equal,Hyps,Value,Hyps2).
2883
2884 avl_fetch_worthwhile_equal_from_hyps(ID,Hyps,Value,Hyps2) :-
2885 worth_rewriting_with_equal(ID),
2886 ? avl_fetch_binop_from_hyps(ID,equal,Hyps,Value,Hyps2),
2887 quick_not_occurs_check(ID,Value).
2888
2889 avl_fetch_worthwhile_member_from_hyps(ID,Hyps,Value,Hyps2) :-
2890 worth_rewriting_with_equal(ID),
2891 ? avl_fetch_binop_from_hyps(ID,member,Hyps,Value,Hyps2).
2892
2893 % fetch member predicate or indirect member via record fields
2894 avl_fetch_mem_or_struct(Func,Hyps,Function,Hyps1) :-
2895 ? get_type_from_hyps(Func,Hyps,Function,Hyps1).
2896 avl_fetch_mem_or_struct(record_field(Rec,Field),Hyps,FieldType,Hyps2) :-
2897 ? get_record_type_fields(Rec,Fields,Hyps,Hyps2),
2898 ? (member(field(Field,FieldType),Fields) -> true).
2899
2900 % find record type and extract fields for a given expression
2901 get_record_type_fields(function(Func,_),Fields,Hyps,Hyps2) :-
2902 ? get_range_or_superset(Func,Hyps,Range,Hyps1),
2903 ? check_equal_pattern(Range,struct(rec(Fields)),Hyps1,Hyps2).
2904 get_record_type_fields(Rec,Fields,Hyps,Hyps2) :-
2905 ? get_type_from_hyps(Rec,Hyps,RecType,Hyps1),
2906 ? check_equal_pattern(RecType,struct(rec(Fields)),Hyps1,Hyps2).
2907
2908 % get type from hyps x:XType or x:ran(F) with F : A->B
2909 get_type_from_hyps(X,Hyps,XType,Hyps2) :-
2910 ? avl_fetch_mem_from_hyps(X,Hyps,XSet,Hyps1),
2911 ? get_type2(XSet,Hyps1,XType,Hyps2).
2912 get_type_from_hyps(function(Func2,_),Hyps,Range,Hyps2) :-
2913 % f : _ +-> ( _ >-> _ ) => f(_) : _ >-> _
2914 ? get_range_or_superset(Func2,Hyps,Range,Hyps2).
2915 get_type_from_hyps(second_of_pair(X),Hyps,Type,Hyps2) :- %prj2
2916 ? get_type_from_hyps(X,Hyps,XType,Hyps1),
2917 check_equal_pattern(XType,cartesian_product(_,Type),Hyps1,Hyps2).
2918 get_type_from_hyps(first_of_pair(X),Hyps,Type,Hyps2) :- %prj1
2919 ? get_type_from_hyps(X,Hyps,XType,Hyps1),
2920 check_equal_pattern(XType,cartesian_product(Type,_),Hyps1,Hyps2).
2921 get_type_from_hyps(assertion_expression(_,_,X),Hyps,XType,Hyps1) :-
2922 ? get_type_from_hyps(X,Hyps,XType,Hyps1).
2923
2924 get_type2(domain(Func),Hyps,XType,Hyps2) :- !,
2925 ? get_domain_or_superset(Func,Hyps,XType,Hyps2).
2926 get_type2(range(Func),Hyps,XType,Hyps2) :- !,
2927 ? get_range_or_superset(Func,Hyps,XType,Hyps2).
2928 get_type2(Type,Hyps,Type,Hyps).
2929
2930 id_or_record_field('$'(_)).
2931 id_or_record_field(record_field(_,_)).
2932
2933 % perform occurs check if first arg is an identifier:
2934 quick_not_occurs_check('$'(ID),Value) :- !, not_occurs(Value,ID).
2935 quick_not_occurs_check(_,_).
2936
2937 % worth rewriting with equality hyps
2938 worth_rewriting_with_equal('$'(_)).
2939 worth_rewriting_with_equal(record_field('$'(_),_)).
2940 worth_rewriting_with_equal(couple(_,_)).
2941 worth_rewriting_with_equal(size(_)).
2942 worth_rewriting_with_equal(card(_)).
2943 worth_rewriting_with_equal(function(_,_)).
2944
2945 % utility to fetch fully ground term from hyp avl
2946 avl_fetch_from_hyps(Term,hyp_rec(AVL,_)) :- avl_fetch(Term,AVL).
2947
2948 % a version without loop check; can be used if processing is finished afterwards
2949 avl_fetch_binop_from_hyps_no_loop_check(ID,BinOp,hyp_rec(AVL,_),Value) :-
2950 ? avl_fetch_bin(ID,BinOp,AVL,Value).
2951
2952 % lookup a hypothesis ID BinOp Value in logarithmic time; ID and BinOp must be known
2953 avl_fetch_binop_from_hyps(ID,BinOp,hyp_rec(AVL,HInfos),Value,hyp_rec(AVL,HInfos2)) :-
2954 ? avl_fetch_bin(ID,BinOp,AVL,Value),
2955 (avl_fetch(prevent_cycle_count,HInfos,CycleCount) % avoid cycles x=y, y=x
2956 -> (CycleCount < 5 -> true ; % print(prevented_cycle(ID,CycleCount)),nl,
2957 % in test 2018: :wd target = [2,1,1,2,1] & n=size(target) & i:1..n & target(i)=res requires cycle count < 5
2958 !, fail),
2959 C1 is CycleCount+1
2960 ; C1 is 1
2961 ),
2962 avl_store(prevent_cycle_count,HInfos,C1,HInfos2).
2963 % detect local loops; should not be used where Hyps are passed to unrelated goals or one has to reset_local_loop_check
2964 rewrite_local_loop_check(_,_,Value,HI,HI1) :- useful_value(Value),!,HI1=HI.
2965 rewrite_local_loop_check(Term,ProverPredicate,_,Hyps,_) :- var(Hyps),!,
2966 add_internal_error('Var hyps: ',rewrite_local_loop_check(Term,ProverPredicate,_,Hyps,_)),fail.
2967 rewrite_local_loop_check(Term,ProverPredicate,_,hyp_rec(AVL,HInfos),hyp_rec(AVL,HInfos1)) :- !,
2968 (Term='$'(ID) -> true ; ID=Term),
2969 %(avl_fetch(rewritten(Term,ProverPredicate),HInfos) -> print(loop(Term,ProverPredicate)),nl,fail ; true),
2970 \+ avl_fetch(rewritten(ID,ProverPredicate),HInfos),
2971 avl_store(rewritten(ID,ProverPredicate),HInfos,true,HInfos1).
2972 % :wd a : 1 .. sz --> INTEGER & sz=5 & p : perm(dom(a)) & i : 1 .. sz - 1 & res= p(i) % sz rewritten multiple times
2973 % :wd f: BOOL --> 1..10 & g : 0..20 --> BOOL & bb:BOOL & (f;g)(bb)=res
2974
2975 %reset_local_loop_check()
2976
2977 % values where there is no risk of looping when rewriting to:
2978 useful_value(Value) :- number(Value).
2979 useful_value(interval(A,B)) :- number(A), number(B).
2980 useful_value(value(_)).
2981
2982
2983 % rename and prove a list of goals
2984 l_rename_and_prove_goals([],_,_,[]).
2985 l_rename_and_prove_goals([H|T],Subst,Hyps,[PTH|PTT]) :-
2986 rename_norm_term(H,Subst,RH),!,
2987 ? prove_po(RH,Hyps,PTH),!, % TO DO: use version of prove_po that does not print info
2988 l_rename_and_prove_goals(T,Subst,Hyps,PTT).
2989
2990
2991 % small utility for sanity checking
2992 check_integer(A,PP) :- not_integer(A),!, add_error(PP,'Not an integer: ',A),fail.
2993 check_integer(_,_).
2994 not_integer(empty_set).
2995 not_integer(empty_sequence).
2996 not_integer(interval(_,_)).
2997 not_integer(couple(_,_)).
2998 not_integer(union(_,_)).
2999 not_integer(intersection(_,_)).
3000 not_integer(domain(_)).
3001 not_integer(range(_)).
3002 % TO DO: extend
3003
3004
3005 % ----------------
3006
3007 % small REPL to inspect hyps
3008 :- public hyp_repl/1.
3009 hyp_repl(Hyps) :- hyp_repl_prompt(Hyps),read(Term), !, hyp_repl(Term,Hyps).
3010 hyp_repl(_).
3011
3012 hyp_repl(end_of_file,_).
3013 hyp_repl(quit,_).
3014 hyp_repl(exit,_).
3015 hyp_repl(help,Hyps) :- write('Use quit to exit, print to portray_hyps, or type an identifier to lookup in hyps'),nl,
3016 hyp_repl(Hyps).
3017 hyp_repl(print,Hyps) :- portray_hyps(Hyps), hyp_repl(Hyps).
3018 hyp_repl(ID,Hyps) :- avl_fetch_equal_from_hyps($(ID),Hyps,Value,_),
3019 format('Value for ~w:~n ~w~n',[ID,Value]),
3020 hyp_repl(Hyps).
3021
3022 hyp_repl_prompt(hyp_rec(AVL,HInfos)) :-
3023 avl_size(AVL,Size),
3024 avl_size(HInfos,ISize),!,
3025 format('hyp_rec(#~w,#~w) >>>',[Size,ISize]).
3026 hyp_repl_prompt(_) :- write('ILLEGAL HYP_REC >>>').