1		% (c) 2004-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(bsets_clp,
6		[empty_sequence/1,
7		is_sequence/2, is_sequence_wf/3, not_is_sequence/2, not_is_sequence_wf/3,
8		not_is_non_empty_sequence_wf/3,
9		injective_sequence_wf/3,
10		not_injective_sequence/3,
11		not_non_empty_injective_sequence/3,
12		injective_non_empty_sequence/3,
13		finite_non_empty_sequence/3,
14		test_finite_non_empty_sequence/4,
15		permutation_sequence_wf/3,
16		not_permutation_sequence/3,
17		size_of_sequence/3,
18		prepend_sequence/4, append_sequence/4, prefix_sequence_wf/4,
19		suffix_sequence/4, concat_sequence/4,
20		disjoint_union_wf/4,
21		concatentation_of_sequences/3,
22		tail_sequence/4, first_sequence/4, front_sequence/4, last_sequence/4,
23		rev_sequence/3,
24
25
26		% maplet/3,
27		% relation/1,
28		relation_over/3, relation_over_wf/4,
29		not_relation_over/4,
30		domain_wf/3,
31
32		range_wf/3,
33		identity_relation_over_wf/3, in_identity/3, not_in_identity/3,
34		invert_relation_wf/3,
35		tuple_of/3,
36		in_composition_wf/4, not_in_composition_wf/4, rel_composition_wf/5,
37		direct_product_wf/4,
38		parallel_product_wf/4, in_parallel_product_wf/4, not_in_parallel_product_wf/4,
39		rel_iterate_wf/5,
40		event_b_identity_for_type/3,
41
42		not_partial_function/4,
43		partial_function/3, partial_function_wf/4, partial_function_test_wf/5,
44
45		total_function/3, total_function_wf/4, total_function_test_wf/5,
46
47		% enumerate_total_bijection/3,
48		total_bijection/3, total_bijection_wf/4,
49
50		not_total_function/4,
51		not_total_bijection/4,
52
53
54		range_restriction_wf/4, range_subtraction_wf/4,
55		in_range_restriction_wf/4, not_in_range_restriction_wf/4,
56		in_range_subtraction_wf/4, not_in_range_subtraction_wf/4,
57		domain_restriction_wf/4, domain_subtraction_wf/4,
58		in_domain_restriction_wf/4, not_in_domain_restriction_wf/4,
59		in_domain_subtraction_wf/4, not_in_domain_subtraction_wf/4,
60		override_relation/4,
61		in_override_relation_wf/4, not_in_override_relation_wf/4,
62		image_wf/4, image_for_closure1_wf/4,
63		special_operator_for_image/3, image_for_special_operator/5, apply_fun_for_special_operator/6,
64
65		in_domain_wf/3, not_in_domain_wf/3,
66		apply_to/4, apply_to/5, apply_to/6,
67		override/5,
68
69		%sum_over_range/2, mul_over_range/2,
70
71		disjoint_union_generalized_wf/3,
72
73		partial_surjection/3, not_partial_surjection_wf/4,
74		partial_surjection_test_wf/5,
75
76		total_relation_wf/4,
77		not_total_relation_wf/4,
78
79		surjection_relation_wf/4, total_surjection_relation_wf/4,
80		not_surjection_relation_wf/4, not_total_surjection_relation_wf/4,
81
82		total_surjection/3, total_surjection_wf/4,
83		not_total_surjection_wf/4,
84
85		partial_injection/3, partial_injection_wf/4,
86		not_partial_injection/4,
87
88		total_injection/3, total_injection_wf/4,
89		not_total_injection/4,
90
91		partial_bijection/3, partial_bijection_wf/4,
92		not_partial_bijection/4,
93
94		relational_trans_closure_wf/3, %relational_reflexive_closure/2,
95		in_closure1_wf/3, not_in_closure1_wf/3
96		]).
97
98
99		:- use_module(library(terms)).
100		:- use_module(self_check).
101
102		:- use_module(debug).
103		:- use_module(tools).
104
105		:- use_module(module_information,[module_info/2]).
106		:- module_info(group,kernel).
107		:- module_info(description,'This module provides more advanced operations for the basic datatypes of ProB (mainly for relations, functions, sequences).').
108
109		:- use_module(tools_printing).
110
111		:- use_module(delay).
112
113		:- use_module(typechecker).
114		:- use_module(error_manager).
115
116		:- use_module(kernel_objects).
117		:- use_module(kernel_records).
118		:- use_module(kernel_tools).
119
120		:- use_module(kernel_waitflags).
121		:- use_module(kernel_equality,[equality_objects_wf/4]).
122
123		:- use_module(custom_explicit_sets).
124		:- use_module(avl_tools,[avl_fetch_pair/3]).
125		:- use_module(bool_pred,[negate/2]).
126		:- use_module(closures,[is_symbolic_closure/1]).
127		:- use_module(bsyntaxtree, [conjunct_predicates/2,
128		mark_bexpr_as_symbolic/2,
129		create_texpr/4,
130		safe_create_texpr/3,
131		get_texpr_type/2
132		]).
133
134		/* --------- */
135		/* SEQUENCES */
136		/* ------- - */
137
138		:- assert_must_succeed((bsets_clp:empty_sequence([]))).
139		:- assert_must_fail((bsets_clp:empty_sequence([int(1)]))).
140		empty_sequence(X) :- empty_set(X). % TO DO: add WF
141
142		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_empty_sequence([(int(2),int(33)),(int(1),int(22))]))).
143		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_empty_sequence([(int(1),int(33))]))).
144		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:not_empty_sequence([]))).
145
146		not_empty_sequence(X) :- var(X),!,
147		X = [(int(1),_)|_].
148		not_empty_sequence(X) :- is_custom_explicit_set_nonvar(X),!,
149		is_non_empty_explicit_set(X).
150		not_empty_sequence([(int(_),_)|_]). % clousure, avl_set dealt with clause above
151
152		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_empty_sequence_wf([(int(1),int(33))],WF),WF)).
153		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_empty_sequence_wf([(int(1),pred_true),(int(2),pred_false)],WF),WF)).
154		not_empty_sequence_wf(X,_WF) :- nonvar(X),!, not_empty_sequence(X).
155		not_empty_sequence_wf(X,WF) :-
156		(preferences:preference(use_smt_mode,true) -> not_empty_sequence(X)
157		; get_enumeration_starting_wait_flag(not_empty_sequence_wf,WF,LWF),
158		not_empty_sequence_lwf(X,LWF)).
159
160		:- block not_empty_sequence_lwf(-,-).
161		not_empty_sequence_lwf(S,_) :- nonvar(S),!,not_empty_sequence(S).
162		not_empty_sequence_lwf([(int(1),_)|_],_).
163
164		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:is_sequence([(int(1),int(22))],[int(22)]))).
165		:- assert_must_succeed(bsets_clp:is_sequence(closure(['_zzzz_unit_tests'],[couple(integer,integer)],b(member(b(identifier('_zzzz_unit_tests'),couple(integer,integer),[generated]),b(value([(int(1),int(22))]),set(couple(integer,integer)),[])),pred,[])),[int(22)])).
166
167		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:is_sequence([(int(2),int(33)),(int(1),int(22))],[int(22),int(33),int(44)]))).
168		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:is_sequence([(int(2),int(33)),(int(1),int(23))],[int(22),int(33),int(44)]))).
169		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:is_sequence([(int(1),int(33)),(int(0),int(22))],[int(22),int(33),int(44)]))).
170		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:is_sequence([(int(3),int(33)),(int(1),int(22))],[int(22),int(33),int(44)]))).
171		:- assert_must_succeed((is_sequence(R,global_set('Name')),R = [])).
172		:- assert_must_succeed((is_sequence(R,global_set('Name')),
173		R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
174		:- assert_must_succeed((is_sequence(R,global_set('Name')),
175		R = [(int(1),fd(2,'Name'))] )).
176		:- assert_must_succeed((is_sequence(R,global_set('Name')),
177		R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
178		:- assert_must_succeed((is_sequence(R,global_set('Name')),
179		R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
180		:- assert_must_succeed((is_sequence([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))],
181		global_set('Name')) )).
182		:- assert_must_succeed((is_sequence(R,[int(1),int(2)]),
183		R = [(int(2),int(2)),(int(1),int(1))] )).
184		:- assert_must_fail((is_sequence(R,[int(1),int(2)]),
185		R = [(int(2),int(2)),(int(3),int(1))] )).
186		:- assert_must_fail((is_sequence(R,[int(1),int(2)]),
187		R = [(int(2),int(2)),(int(1),int(3))] )).
188		:- assert_must_fail((is_sequence(R,global_set('Name')),
189		R = [(int(0),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
190		:- assert_must_succeed((is_sequence(X,global_set('Name')),
191		(preferences:get_preference(randomise_enumeration_order,true) -> true
192		; kernel_objects:enumerate_basic_type(X,seq(global('Name')))),
193		X = [(int(1),fd(1,'Name'))])). % can take a long time with RANDOMISE_ENUMERATION_ORDER
194
195		is_sequence(X,Type) :- init_wait_flags(WF,[is_sequence]),
196		is_sequence_wf(X,Type,WF),
197		ground_wait_flags(WF).
198
199		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_domain([int(1),int(2),int(3)],WF),WF)).
200		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_domain([int(1)],WF),WF)).
201		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_domain([],WF),WF)).
202		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:is_sequence_domain([int(0)],WF),WF)).
203		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:is_sequence_domain([int(2),int(3)],WF),WF)).
204		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_is_sequence_domain([int(2),int(3)],WF),WF)).
205		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_is_sequence_domain([int(0)],WF),WF)).
206		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_is_sequence_domain([int(1)],WF),WF)).
207		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_is_sequence_domain([],WF),WF)).
208
209		% check if a set is the domain of a sequence, i.e., an interval 1..n with n>=0
210		:- use_module(custom_explicit_sets,[construct_interval_closure/3]).
211		:- use_module(kernel_cardinality_attr,[finite_cardinality_as_int_wf/3]).
212		:- block is_sequence_domain(-,?).
213		is_sequence_domain(Domain,WF) :-
214		finite_cardinality_as_int_wf(Domain,int(Max),WF),
215		construct_interval_closure(1,Max,Interval), equal_object_wf(Domain,Interval,is_sequence_domain,WF).
216		:- block not_is_sequence_domain(-,?).
217		not_is_sequence_domain(Domain,WF) :-
218		finite_cardinality_as_int_wf(Domain,int(Max),WF),
219		construct_interval_closure(1,Max,Interval), not_equal_object_wf(Domain,Interval,WF).
220
221		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_wf([(int(1),pred_true)],
222		[pred_true,pred_false],WF),WF)).
223		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_wf([(int(1),pred_true),(int(2),pred_false),(int(3),pred_true)],
224		[pred_true,pred_false],WF),WF)).
225		:- assert_must_succeed((bsets_clp:is_sequence_wf([(int(X),R)],[pred_true],_WF),X==1, R==pred_true)).
226		:- assert_must_succeed((bsets_clp:is_sequence_wf([(int(X),R),(int(Y),R)],[pred_true],_WF),X=2,
227		(preferences:preference(use_clpfd_solver,true) -> Y==1 ; Y=1), R==pred_true)).
228
229		is_sequence_wf(Seq,Range,WF) :- is_sequence_wf_ex(Seq,Range,WF,_).
230		% is_sequence_wf_ex also returns expansion; if it was done
231		:- block is_sequence_wf_ex(-,?,?,?).
232		is_sequence_wf_ex(FF,Range,WF,FF) :-
233		nonvar(FF), FF = closure(_,_,_),
234		custom_explicit_sets:is_definitely_maximal_set(Range),
235		% we do not need the Range; this means we can match more closures (e.g., lambda)
236		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
237		is_sequence_domain(FFDomain,WF).
238		is_sequence_wf_ex(Seq,Range,WF,Res) :-
239		expand_and_convert_to_avl_set_warn(Seq,AER,is_sequence_wf_ex,'ARG : seq(?)',WF),!,
240		is_avl_sequence(AER),
241	?	is_avl_relation_over_range(AER,Range,WF),
242		custom_explicit_sets:construct_avl_set(AER,Res).
243		is_sequence_wf_ex(X,Type,WF,EX) :-
244		% try_ensure_seq_numbering(X,1),
245		expand_custom_set_to_list_wf(X,EX,_,is_sequence_wf_ex,WF),
246		is_sequence2(EX,[],Type,0,_MinSize,WF).
247
248		% will make this much faster x:seq(STRING) & card(x)=400 & 401:dom(x) (40 ms rather than > 2 secs)
249		% but this does not work -eval_file /Users/leuschel/git_root/prob_examples/examples/Setlog/prob-ttf/plavis-TransData_SP_21_simplified.prob
250		%:- block try_ensure_seq_numbering(-,?).
251		%try_ensure_seq_numbering([H|T],NextNr) :- var(H),!, print(nr(NextNr)),nl,
252		% H = (int(NextNr),_), N1 is NextNr+1,
253		% try_ensure_seq_numbering(T,N1).
254		%try_ensure_seq_numbering(_,_).
255
256		:- block is_sequence2(-,?,?,?,?,?).
257		is_sequence2([],IndexesSoFar,_Type,Size,MinSize,_WF) :- MinSize = Size,
258		contiguous_set_of_indexes(IndexesSoFar,Size).
259		/* not very good to do the checking at the end; can we move part of the checking earlier ? */
260		is_sequence2([(int(Idx),X)|Tail],IndexesSoFar,Type,Size,MinSize,WF) :-
261		less_than_direct(0,Idx), %is_index_greater_zero(Idx),
262		not_element_of_wf(int(Idx),IndexesSoFar,WF),
263		check_element_of_wf(X,Type,WF), S1 is Size+1,
264		clpfd_interface:clpfd_leq(Idx,MinSize,_Posted),
265		(var(Tail)
266		-> clpfd_interface:clpfd_domain(MinSize,Low,_Up), % TO DO: ensure that final size at least Low
267		(number(Low),Low>S1 -> Tail = [_|_] % TO DO: proper reification; what if MinSize gets constrained later
268		; expand_seq_if_necessary(Idx,S1,Tail)) % the sequence must be longer; force it
269		; true
270		),
271		is_sequence2(Tail,[int(Idx)|IndexesSoFar],Type,S1,MinSize,WF).
272
273		:- block expand_seq_if_necessary(-,?,-).
274		expand_seq_if_necessary(MinSize,S1,Tail) :- % TO DO: proper reification on MinSize above
275		number(MinSize), MinSize>S1, (var(Tail) ; Tail==[]),
276		!,
277		Tail = [_|_].
278		expand_seq_if_necessary(_,_,_).
279
280		:- block contiguous_set_of_indexes(-,?).
281		contiguous_set_of_indexes([],_).
282		contiguous_set_of_indexes([H|T],Size) :- contiguous_set_of_indexes1(T,H,Size).
283
284		:- block contiguous_set_of_indexes1(-,?,?).
285		contiguous_set_of_indexes1([],int(1),_).
286		contiguous_set_of_indexes1([int(H2)|T],int(H1),Size) :- less_than_equal_direct(H1,Size),
287		less_than_equal_direct(H2,Size), less_than_equal_indexes(T,[H1,H2],Size).
288
289
290		less_than_equal_indexes([],All,_) :- clpfd_interface:clpfd_alldifferent(All).
291		less_than_equal_indexes([int(H)|T],All,Size) :- less_than_equal_direct(H,Size),less_than_equal_indexes(T,[H|All],Size).
292
293		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_is_sequence_wf([(int(1),int(6)),(int(2),int(7)),(int(4),int(7))],[int(7),int(6)],WF),WF)).
294		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_is_sequence_wf([(int(1),int(6)),(int(2),int(7)),(int(3),int(8))],[int(7),int(6)],WF),WF)).
295		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_is_sequence_wf([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(7),int(6)],WF),WF)).
296		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_is_sequence_wf([(int(2),int(6)),(int(3),int(7)),(int(4),int(7))],[int(7),int(6)],WF),WF)).
297		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_is_sequence_wf([(int(1),int(6)),(int(0),int(7)),(int(2),int(7))],[int(7),int(6)],WF),WF)).
298		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:not_is_sequence([(int(1),int(22))],[int(22)]))).
299		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:not_is_sequence([(int(2),int(33)),(int(1),int(22))],[int(22),int(33),int(44)]))).
300		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_is_sequence([(int(2),int(33)),(int(1),int(23))],[int(22),int(33),int(44)]))).
301		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_is_sequence([(int(3),int(33)),(int(1),int(22))],[int(22),int(33),int(44)]))).
302		:- assert_must_fail((not_is_sequence(R,global_set('Name')),R = [])).
303		:- assert_must_fail((not_is_sequence(R,global_set('Name')),
304		R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
305		:- assert_must_fail((not_is_sequence(R,global_set('Name')),
306		R = [(int(1),fd(2,'Name'))] )).
307		:- assert_must_fail((not_is_sequence(R,global_set('Name')),
308		R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
309		:- assert_must_fail((not_is_sequence(R,global_set('Name')),
310		R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
311		:- assert_must_fail((not_is_sequence([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))],
312		global_set('Name')) )).
313		:- assert_must_fail((not_is_sequence(R,[int(1),int(2)]),
314		R = [(int(2),int(2)),(int(1),int(1))] )).
315		:- assert_must_succeed((not_is_sequence(R,[int(1),int(2)]),
316		R = [(int(2),int(2)),(int(3),int(1))] )).
317		:- assert_must_succeed((not_is_sequence(R,[int(1),int(2)]),
318		R = [(int(2),int(2)),(int(1),int(3))] )).
319
320
321		not_is_sequence(X,Type) :- init_wait_flags(WF,[not_is_sequence]),
322		not_is_sequence_wf(X,Type,WF),
323		ground_wait_flags(WF).
324
325		:- block not_is_sequence_wf(-,?,?).
326		not_is_sequence_wf(FF,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
327		% we do not need the Range; this means we can match more closures (e.g., lambda)
328		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
329		not_is_sequence_domain(FFDomain,WF).
330		not_is_sequence_wf(Seq,Range,WF) :-
331		expand_and_convert_to_avl_set_warn(Seq,AER,not_is_sequence_wf,'ARG /: seq(?)',WF),
332		!,
333		(is_avl_sequence(AER) -> is_not_avl_relation_over_range(AER,Range,WF)
334		; true).
335		not_is_sequence_wf(X,Type,WF) :- expand_custom_set_to_list_wf(X,EX,_Done,not_is_sequence_wf,WF),
336		not_is_sequence2(EX,[],Type,WF).
337
338		:- block not_is_sequence2(-,?,?,?).
339		not_is_sequence2([],IndexesSoFar,_,_WF) :- not_contiguous_set_of_indexes(IndexesSoFar).
340		not_is_sequence2([(int(Idx),X)|Tail],IndexesSoFar,Type,WF) :-
341		membership_test_wf(IndexesSoFar,int(Idx),MemRes,WF),
342		not_is_sequence3(MemRes,Idx,X,Tail,IndexesSoFar,Type,WF).
343
344		:- block not_is_sequence3(-,?,?,?,?,?,?).
345		not_is_sequence3(pred_true,_Idx,_X,_Tail,_IndexesSoFar,_Type,_WF).
346		not_is_sequence3(pred_false,Idx,_X,_Tail,_IndexesSoFar,_Type,_WF) :- nonvar(Idx),Idx<1,!.
347		not_is_sequence3(pred_false,Idx,X,Tail,IndexesSoFar,Type,WF) :-
348		membership_test_wf(Type,X,MemRes,WF),
349		not_is_sequence4(MemRes,Idx,Tail,IndexesSoFar,Type,WF).
350
351		:- block not_is_sequence4(-,?,?,?,?,?).
352		not_is_sequence4(pred_false,_Idx,_Tail,_IndexesSoFar,_Type,_WF).
353		not_is_sequence4(pred_true,Idx,Tail,IndexesSoFar,Type,WF) :-
354		not_is_sequence2(Tail,[int(Idx)|IndexesSoFar],Type,WF).
355
356		not_contiguous_set_of_indexes(Indexes) :-
357		when(ground(Indexes),(sort(Indexes,Sorted),not_contiguous_set_of_indexes2(Sorted,1))).
358		not_contiguous_set_of_indexes2([int(N)|T],N1) :-
359		when(?=(N,N1),
360		((N \= N1) ; (N=N1, N2 is N1+1, not_contiguous_set_of_indexes2(T,N2)))).
361
362
363
364
365
366		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:not_is_non_empty_sequence([(int(1),int(22))],[int(22)]))).
367		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_is_non_empty_sequence([(int(1),int(2))],[int(22)]))).
368		:- assert_must_succeed((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),R = [])).
369		:- assert_must_fail((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),
370		R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
371		:- assert_must_succeed((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),
372		R = [(int(2),fd(1,'Name')),(int(4),fd(2,'Name'))] )).
373		:- assert_must_fail((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),
374		R = [(int(1),fd(1,'Name')),(int(2),fd(1,'Name'))] )).
375		:- assert_must_succeed((bsets_clp:not_is_non_empty_sequence(R,[int(1),int(2)]),
376		R = [(int(1),int(2)),(int(2),int(3))] )).
377
378		% S /: seq1(T)
379		not_is_non_empty_sequence_wf(S,T,_) :- not_is_non_empty_sequence(S,T).
380		:- block not_is_non_empty_sequence(-,?).
381		not_is_non_empty_sequence([],_) :- !.
382		not_is_non_empty_sequence(X,Type) :-
383		empty_sequence(X) ; not_is_sequence(X,Type).
384
385
386
387		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_sequence_wf([(int(1),int(22))],[int(22)],WF),WF)).
388		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_sequence_wf([(int(2),int(33)),(int(1),int(22))],[int(22),int(33),int(44)],WF),WF)).
389		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:injective_sequence_wf([(int(2),int(33)),(int(1),int(23))],[int(22),int(33),int(44)],WF),WF)).
390		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:injective_sequence_wf([(int(2),int(22)),(int(1),int(22))],[int(22),int(33),int(44)],WF),WF)).
391		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_sequence_wf([],global_set('Name'),WF),WF)).
392		:- assert_must_succeed((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF),
393		kernel_waitflags:ground_det_wait_flag(WF), R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
394		:- assert_must_succeed((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF),
395		ground_det_wait_flag(WF), R = [(int(1),fd(2,'Name'))] )).
396		:- assert_must_succeed((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF),
397		ground_det_wait_flag(WF), R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
398		:- assert_must_fail((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF),
399		ground_det_wait_flag(WF), R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
400		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:injective_sequence_wf([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))],
401		global_set('Name'),WF),WF) ).
402		:- assert_must_succeed((bsets_clp:injective_sequence_wf(R,[int(1),int(2)],WF),
403		ground_det_wait_flag(WF),R = [(int(2),int(2)),(int(1),int(1))] )).
404		:- assert_must_fail((bsets_clp:injective_sequence_wf(R,[int(1),int(2)],WF),
405		ground_det_wait_flag(WF),R = [(int(2),int(2)),(int(3),int(1))] )).
406		:- assert_must_fail((bsets_clp:injective_sequence_wf(R,[int(1),int(2)],WF),
407		ground_det_wait_flag(WF), R = [(int(2),int(2)),(int(1),int(3))] )).
408
409
410
411		:- block injective_sequence_wf(-,-,?).
412		injective_sequence_wf(Seq,Type,WF) :- /* corresponds to iseq */
413		nonvar(Seq),
414		%expand_and_convert_to_avl_set_warn(Seq,AER,injective_sequence_wf_aux,'ARG : iseq(?)',WF),
415		Seq=avl_set(AER),
416		!,
417		is_avl_sequence(AER),
418		is_injective_avl_relation(AER,_ExactRange), % Should we check _ExactRange <: Type ??
419		is_avl_relation_over_range(AER,Type,WF).
420		injective_sequence_wf(Seq,Type,WF) :-
421		cardinality_as_int_for_wf(Type,MaxCard),
422		custom_explicit_sets:blocking_nr_iseq(MaxCard,ISeqSize),
423		block_get_wait_flag(ISeqSize,injective_sequence_wf,WF,LWF),
424		injective_sequence_wf_aux(Seq,Type,MaxCard,WF,LWF).
425
426		:- block injective_sequence_wf_aux(-,?,?,?,-).
427		injective_sequence_wf_aux(Seq,Type,_,WF,_) :- /* corresponds to iseq */
428		nonvar(Seq),
429		expand_and_convert_to_avl_set_warn(Seq,AER,injective_sequence_wf_aux,'ARG : iseq(?)',WF),!,
430		%Seq=avl_set(AER),
431		!,
432		is_avl_sequence(AER),
433		is_injective_avl_relation(AER,_ExactRange), % Should we check _ExactRange <: Type ??
434		is_avl_relation_over_range(AER,Type,WF).
435		injective_sequence_wf_aux(Seq,Type,MaxCard,WF,LWF) :-
436		expand_custom_set_to_list_wf(Seq,ESeq,_,injective_sequence_wf,WF),
437		is_sequence_wf(ESeq,Type,WF),
438	?	injective_sequence2(ESeq,0,[],Type,WF,MaxCard,LWF).
439
440		:- block injective_sequence2(-,?,?,?,?,?,-),injective_sequence2(-,?,?,?,?,-,?).
441		injective_sequence2([],_,_,_Type,_WF,_MaxCard,_LWF).
442		injective_sequence2([(int(Index),X)|Tail],CardSoFar,SoFar,Type,WF,MaxCard,LWF) :-
443		(number(MaxCard) -> CardSoFar< MaxCard, %less_than_equal_direct(Index,MaxCard) % does not enumerate index
444		in_nat_range_wf(int(Index),int(0),int(MaxCard),WF) % ensures the index gets enumerated, see test 1914, x:iseq(50001..50002) & y:1..100005 & SIGMA(yy).(yy:dom(x)|x(yy)) = y & y>50002
445		; true),
446		check_element_of_wf(X,Type,WF),
447		not_element_of_wf(X,SoFar,WF),
448		add_new_element_wf(X,SoFar,SoFar2,WF),
449		C1 is CardSoFar+1,
450		(C1 == MaxCard -> Tail=[] ; true),
451	?	injective_sequence2(Tail,C1,SoFar2,Type,WF,MaxCard,LWF).
452
453
454		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_injective_sequence([(int(1),int(22))],[int(22)],WF),WF)).
455		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_injective_sequence([(int(2),int(33)),(int(1),int(22))],[int(22),int(33),int(44)],WF),WF)).
456		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_injective_sequence([(int(2),int(33)),(int(1),int(23))],[int(22),int(33),int(44)],WF),WF)).
457		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_injective_sequence([(int(2),int(22)),(int(1),int(22))],[int(22),int(33),int(44)],WF),WF)).
458		:- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),_WF),R = [])).
459		:- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),WF),
460		ground_det_wait_flag(WF),
461		R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
462		:- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),WF),
463		ground_det_wait_flag(WF),
464		R = [(int(1),fd(2,'Name'))] )).
465		:- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),WF),
466		ground_det_wait_flag(WF),
467		R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
468		:- assert_must_fail((bsets_clp:not_injective_sequence(R,[int(1),int(2)],WF),
469		ground_det_wait_flag(WF),
470		R = [(int(2),int(2)),(int(1),int(1))] )).
471		:- assert_must_succeed((bsets_clp:not_injective_sequence(R,global_set('Name'),WF),
472		ground_det_wait_flag(WF),
473		R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
474		:- assert_must_succeed((bsets_clp:not_injective_sequence([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))],
475		global_set('Name'),WF),
476		ground_det_wait_flag(WF) )).
477		:- assert_must_succeed((bsets_clp:not_injective_sequence(R,[int(1),int(2)],WF),
478		ground_det_wait_flag(WF),
479		R = [(int(2),int(2)),(int(3),int(1))] )).
480		:- assert_must_succeed((bsets_clp:not_injective_sequence(R,[int(1),int(2)],WF),
481		ground_det_wait_flag(WF),
482		R = [(int(2),int(2)),(int(1),int(3))] )).
483		:- block not_injective_sequence(-,?,?), not_injective_sequence(?,-,?).
484		not_injective_sequence(Seq,_,_) :- Seq==[],!,fail.
485		not_injective_sequence(Seq,Type,WF) :- nonvar(Seq),
486		expand_and_convert_to_avl_set_warn(Seq,AER,not_injective_sequence,'ARG /: iseq(?)',WF),!,
487		(\+ is_avl_sequence(AER) -> true
488		; is_injective_avl_relation(AER,ExactRange) -> not_subset_of_wf(ExactRange,Type,WF)
489		; true).
490		not_injective_sequence(Seq,Type,WF) :- /* corresponds to Iseq */
491		%get_middle_wait_flag(not_injective_sequence,WF,LWF),
492		ground_value_check(Seq,SV),
493		not_injective_sequence1(Seq,Type,WF,SV).
494		:- block not_injective_sequence1(?,?,?,-).
495		not_injective_sequence1(Seq,Type,WF,_) :-
496		expand_custom_set_to_list_wf(Seq,ESeq,_,not_injective_sequence1,WF),
497		(not_is_sequence_wf(ESeq,Type,WF)
498		; /* CHOICE POINT !! */
499		(is_sequence_wf(ESeq,Type,WF),not_injective_sequence2(ESeq,[],Type,WF))).
500		:- block not_injective_sequence2(-,?,?,?).
501		not_injective_sequence2([(int(_),X)|Tail],SoFar,Type,WF) :-
502		membership_test_wf(SoFar,X,MemRes,WF),
503		not_injective_sequence3(MemRes,X,Tail,SoFar,Type,WF).
504
505		:- block not_injective_sequence3(-,?,?,?,?,?).
506		not_injective_sequence3(pred_true,_X,_Tail,_SoFar,_Type,_WF).
507		not_injective_sequence3(pred_false,X,Tail,SoFar,Type,WF) :-
508		add_new_element_wf(X,SoFar,SoFar2,WF),
509		not_injective_sequence2(Tail,SoFar2,Type,WF).
510
511		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_non_empty_injective_sequence([(int(1),int(22))],[int(22)],WF),WF)).
512		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_non_empty_injective_sequence([(int(2),int(33)),(int(1),int(22))],[int(22),int(33),int(44)],WF),WF)).
513		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_non_empty_injective_sequence([(int(2),int(33)),(int(1),int(23))],[int(22),int(33),int(44)],WF),WF)).
514		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_non_empty_injective_sequence([(int(2),int(33)),(int(1),int(33))],[int(44),int(33),int(22)],WF),WF)).
515		:- assert_must_succeed((bsets_clp:not_non_empty_injective_sequence(R,global_set('Name'),WF),
516		ground_det_wait_flag(WF), R = [])).
517		:- assert_must_fail((bsets_clp:not_non_empty_injective_sequence(R,global_set('Name'),WF),
518		ground_det_wait_flag(WF), R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
519		:- assert_must_succeed((bsets_clp:not_non_empty_injective_sequence(R,[int(1),int(2)],WF),
520		ground_det_wait_flag(WF), R = [(int(2),int(2)),(int(1),int(3))] )).
521
522		:- block not_non_empty_injective_sequence(-,?,?).
523		not_non_empty_injective_sequence([],_Type,_WF) :- !.
524		not_non_empty_injective_sequence(X,Type,WF) :-
525		empty_sequence(X) ; not_injective_sequence(X,Type,WF).
526
527
528		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_non_empty_sequence([(int(1),int(22))],[int(22)],WF),WF)).
529		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_non_empty_sequence([(int(2),int(33)),(int(1),int(22))],[int(22),int(33),int(44)],WF),WF)).
530		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:injective_non_empty_sequence([(int(2),int(33)),(int(1),int(23))],[int(22),int(33),int(44)],WF),WF)).
531		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:injective_non_empty_sequence([(int(2),int(44)),(int(1),int(44))],[int(22),int(33),int(44)],WF),WF)).
532		:- assert_must_fail((bsets_clp:injective_non_empty_sequence(R,global_set('Name'),WF),
533		ground_det_wait_flag(WF),R = [])).
534		:- assert_must_succeed((bsets_clp:injective_non_empty_sequence(R,global_set('Name'),WF),
535		ground_det_wait_flag(WF),R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
536		:- block injective_non_empty_sequence(-,-,?). /* corresponds to iseq1 */
537		injective_non_empty_sequence(A,Type,WF) :- nonvar(A),A=avl_set(AS), !,
538		injective_sequence_wf(avl_set(AS),Type,WF),is_non_empty_explicit_set_wf(avl_set(AS),WF).
539		injective_non_empty_sequence(Seq,Type,WF) :-
540		((nonvar(Seq),Seq=closure(_,_,_)) -> try_expand_custom_set_wf(Seq,ESeq,injective_non_empty_sequence,WF) ; ESeq=Seq),
541		injective_sequence_wf(ESeq,Type,WF),not_empty_sequence_wf(ESeq,WF).
542
543		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:finite_non_empty_sequence([(int(1),int(22))],[int(22)],WF),WF)).
544		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:finite_non_empty_sequence([(int(1),int(33)),(int(2),int(33))],[int(22),int(33)],WF),WF)).
545		:- assert_must_fail((bsets_clp:finite_non_empty_sequence(R,global_set('Name'),WF),ground_det_wait_flag(WF),ground_det_wait_flag(WF),R = [])).
546		:- assert_must_succeed((bsets_clp:finite_non_empty_sequence(R,global_set('Name'),WF),
547		ground_det_wait_flag(WF),R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
548		:- block finite_non_empty_sequence(-,?,?).
549		finite_non_empty_sequence(Seq,Type,WF) :- /* corresponds to Seq1 */
550	?	is_sequence_wf_ex(Seq,Type,WF,ESeq),
551		(var(ESeq) -> not_empty_sequence_wf(Seq,WF) ; not_empty_sequence_wf(ESeq,WF)).
552
553		% reification of seq1(.)
554		:- block test_finite_non_empty_sequence(-,?,-,?).
555		test_finite_non_empty_sequence(Seq,_Type,Res,_WF) :-
556		Seq == [],!, Res=pred_false.
557		test_finite_non_empty_sequence(Seq,Type,Res,WF) :- var(Res),!,
558		ground_value_check(Seq,GrSeq),get_wait_flag1(WF,WF1),
559		test_finite_non_empty_sequence2(Res,Seq,Type,GrSeq,WF1,WF). % will trigger and enumerate Res below
560		% Note: we cannot rely on Res being enumerated; e.g., in case a WD error occurs
561		test_finite_non_empty_sequence(Seq,Type,Res,WF) :- get_wait_flag1(WF,WF1),
562		test_finite_non_empty_sequence2(Res,Seq,Type,_,WF1, WF).
563
564		% TODO: improve to incrementally check if something is a sequence
565		:- block test_finite_non_empty_sequence2(-,?,?,-,?,?),
566		test_finite_non_empty_sequence2(-,?,?,?,-,?).
567		test_finite_non_empty_sequence2(pred_true,Seq,Type,_,_,WF) :-
568	?	finite_non_empty_sequence(Seq,Type,WF).
569		test_finite_non_empty_sequence2(pred_false,Seq,Type,_,_,WF) :-
570		not_is_non_empty_sequence_wf(Seq,Type,WF).
571
572
573
574		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:permutation_sequence_wf([(int(1),int(22))],[int(22)],WF),WF)).
575		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:permutation_sequence_wf([(int(2),int(33)),(int(1),int(22))],[int(22),int(33)],WF),WF)).
576		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:permutation_sequence_wf([(int(2),int(33)),(int(1),int(23))],[int(23),int(33),int(44)],WF),WF)).
577		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:permutation_sequence_wf([(int(2),int(44)),(int(1),int(44))],[int(44)],WF),WF)).
578		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1)],WF),
579		ground_det_wait_flag(WF),R = [(int(1),int(1))] )).
580		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1),int(2)],WF),
581		ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(2))] )).
582		:- assert_must_succeed((bsets_clp:permutation_sequence_wf(R,[int(1),int(2)],WF),
583		ground_det_wait_flag(WF),R = [(int(1),int(2)),(int(2),int(1))] )).
584		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[pred_true /* bool_true */,pred_false /* bool_false */],WF), kernel_waitflags:ground_wait_flags(WF), nonvar(R),
585		R = [(int(1),pred_false /* bool_false */),(int(2),pred_true /* bool_true */)] )).
586		:- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1)],WF),
587		ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(1))] )).
588		:- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF),ground_det_wait_flag(WF),R = [])).
589		:- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF),
590		ground_det_wait_flag(WF),R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
591		:- assert_must_succeed((bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF),
592		ground_det_wait_flag(WF),
593		kernel_objects:equal_object(R,[(int(1),fd(1,'Name')),(int(3),fd(2,'Name')),(int(2),fd(3,'Name'))]) )).
594		:- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1),int(2)],WF),
595		ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(3))] )).
596		:- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF),
597		ground_det_wait_flag(WF),R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
598		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(4),int(3),int(2),int(1)],WF),
599		ground_det_wait_flag(WF), R=[(int(1),int(1)),(int(2),int(2)),(int(3),int(3)),(int(4),int(4))])).
600
601		:- block permutation_sequence_wf(-,-,?).
602		permutation_sequence_wf(SeqFF,Type,WF) :- nonvar(SeqFF),
603		custom_explicit_sets:dom_range_for_specific_closure(SeqFF,FFDomain,FFRange,function(bijection),WF),!,
604		equal_object_wf(FFRange,Type,permutation_sequence_wf_1,WF),
605		is_sequence_domain(FFDomain,WF).
606		permutation_sequence_wf(Seq,Type,WF) :-
607		expand_and_convert_to_avl_set_warn(Seq,AER,permutation_sequence_wf,'ARG : perm(?)',WF),!,
608		is_avl_sequence(AER),
609		is_injective_avl_relation(AER,Range),
610		kernel_objects:equal_object_wf(Range,Type,permutation_sequence_wf_2,WF).
611		permutation_sequence_wf(Seq,Type,WF) :-
612		try_expand_custom_set_wf(Seq,ESeq,permutation_sequence_wf,WF),
613		cardinality_as_int_wf(Type,int(Card),WF),
614		when(nonvar(Card), (setup_sequence_wf(Card,SkelSeq,perm,WF),
615		CardGround=true,
616		kernel_objects:equal_object_wf(SkelSeq,ESeq,permutation_sequence_wf_3,WF))),
617		%injective_sequence_wf(ESeq,Type,WF,LWF),
618		surjective_iseq_0(SkelSeq,ESeq,Type,WF,Card,CardGround).
619		% quick_all_different_range(ESeq,[],Type,WF). % see all_different_wf
620
621		:- block surjective_iseq_0(-,-,?,?,?,-).
622		surjective_iseq_0(SkelSeq,_ESeq,Type,WF,_Card,Ground) :-
623		nonvar(Ground),
624		nonvar(SkelSeq),
625		preference(use_clpfd_solver,true), % try and use an optimized version calling global_cardinality in CLPFD module
626		get_global_cardinality_list(Type,YType,GCL,_,WF),
627		% this dramatically reduces runtime for NQueens40_perm; maybe we should do this only when necessary, i.e., when surjective_iseq blocks on PreviousRemoveDone
628		% check why it slows down SortByPermutation_v2
629		!,
630		global_cardinality_range(SkelSeq,[],YType,GCL,WF).
631		surjective_iseq_0(_,ESeq,Type,WF,Card,_) :-
632		%quick_propagate_range(ESeq,Type,WF), % ensure that we propagate type information to all elements; p:perm(5..20) & p(10)=21 will fail straightaway (surjective_iseq will block);
633		% but this slows down EulerWay.mch ; maybe because it sets up enumerators ? TO DO: investigate
634		surjective_iseq(ESeq,Type,WF,Card).
635
636		%:- use_module(clpfd_interface,[clpfd_alldifferent/1]).
637		% collect range and then call CLPFD global_cardinality using GCL (Global Cardinality List Ki-Vi)
638		:- use_module(library(clpfd), [global_cardinality/3]).
639		:- block global_cardinality_range(-,?,?,?,?).
640		global_cardinality_range([],Acc,_Type,GCL,WF) :-
641		global_cardinality(Acc,GCL,[consistency(value)]),
642		add_fd_variables_for_labeling(Acc,WF). % this is needed for efficiency for NQueens40_perm !!
643		global_cardinality_range([(_,Y)|T],Acc,Type,GCL,WF) :-
644		get_simple_fd_value(Type,Y,FDYVAL),
645		global_cardinality_range(T,[FDYVAL|Acc],Type,GCL,WF).
646
647
648		:- use_module(library(avl), [avl_domain/2]).
649		:- use_module(b_global_sets,[all_elements_of_type_wf/3,b_integer_set/1]).
650		% try and convert a B set into a list suitable for calling clpfd:global_cardinality
651		% get_global_cardinality_list(avl_set(A) % TO DO: extend to integer_lists
652		get_global_cardinality_list(global_set(G),Type,GCL,list,WF) :- !,
653		all_elements_of_type_wf(G,Values,WF), % can only work for finite sets, not for STRING, NATURAL, REAL, ...
654		(b_integer_set(G) -> Type=integer ; Type=global(G)),
655		findall(X-1,(get_simple_fd_value(Type,VV,X),member(VV,Values)),GCL).
656		get_global_cardinality_list(avl_set(A),Type,GCL,list,_WF) :- !,
657		A = node(TopValue,_True,_,_,_),
658		get_simple_fd_value(Type,TopValue,_), % we have CLPFD values
659		avl_domain(A,Values),
660		findall(X-1,(get_simple_fd_value(Type,VV,X),member(VV,Values)),GCL).
661		get_global_cardinality_list(Set,integer,GCL,interval(L1,U1),_WF) :- nonvar(Set),
662		is_interval_closure_or_integerset(Set,L1,U1), number(L1),number(U1),
663		global_cardinality_list_interval(L1,U1,GCL).
664
665		global_cardinality_list_interval(From,To,[]) :- From>To, !.
666		global_cardinality_list_interval(From,To,[From-1|T]) :-
667		F1 is From+1, global_cardinality_list_interval(F1,To,T).
668
669		%try_get_simple_fd_value(Type,V,Val) :- nonvar(V),get_simple_fd_value(Type,V,Val).
670		get_simple_fd_value(integer,int(X),X).
671		get_simple_fd_value(global(T),fd(X,T),X).
672		% try_get_simple_fd_value(pred_false,0). try_get_simple_fd_value(pred_true,1). ??
673		% TO DO: maybe also treat pairs ? but we need complete values; see module clpfd_lists !
674
675		setup_sequence_wf(0,R,_,_) :- !, R=[].
676		setup_sequence_wf(Card,_,PP,WF) :- \+ number(Card), !,
677		add_error_wf(infinite_sequence,'Cannot generate infinite sequence for', PP,unknown,WF). % triggered in test 1979
678		setup_sequence_wf(Card,[(int(1),_)|T] ,_PP,_WF) :- Card>0, C1 is Card-1,
679		setup_sequence(C1,T,2).
680		setup_sequence(0,R,_) :- !, R=[].
681		setup_sequence(Card,[(int(Nr),_)|T], Nr ) :- Card>0, C1 is Card-1,
682		N1 is Nr+1,
683		setup_sequence(C1,T,N1).
684
685		:- block surjective_iseq(?,?,?,-),surjective_iseq(?,-,?,?), surjective_iseq(-,?,?,?).
686		surjective_iseq(avl_set(S),Type,WF,Done) :-
687		expand_custom_set_wf(avl_set(S),ES,surjective_iseq,WF),
688		surjective_iseq(ES,Type,WF,Done).
689		surjective_iseq(closure(P,T,B),Type,WF,Done) :-
690		expand_custom_set_wf(closure(P,T,B),ES,surjective_iseq,WF),
691		surjective_iseq(ES,Type,WF,Done).
692		% no case for global_set: cannot be a relation
693		surjective_iseq([],T,WF,_) :- empty_set_wf(T,WF).
694		surjective_iseq([(int(_Nr),El)|Tail],Type,WF,_PreviousRemoveDone) :-
695	?	remove_element_wf(El,Type,NType,WF,Done),
696		surjective_iseq(Tail,NType,WF,Done).
697		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_permutation_sequence([(int(1),int(22))],[int(22)],WF),WF)).
698		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_permutation_sequence([(int(2),int(33)),(int(1),int(22))],[int(22),int(33)],WF),WF)).
699		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_permutation_sequence([(int(2),int(33)),(int(1),int(23))],[int(23),int(33),int(44)],WF),WF)).
700		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_permutation_sequence([(int(2),int(44)),(int(1),int(44))],[int(44)],WF),WF)).
701		:- assert_must_fail((bsets_clp:not_permutation_sequence(R,[int(1)],WF),
702		ground_det_wait_flag(WF),R = [(int(1),int(1))] )).
703		:- assert_must_fail((bsets_clp:not_permutation_sequence(R,[int(1),int(2)],WF),
704		ground_det_wait_flag(WF),R = [(int(2),int(2)),(int(1),int(1))] )).
705		:- assert_must_fail((bsets_clp:not_permutation_sequence(R,[int(1),int(2)],WF),
706		ground_det_wait_flag(WF),R = [(int(1),int(2)),(int(2),int(1))] )).
707		:- assert_must_fail((bsets_clp:not_permutation_sequence(R,global_set('Name'),WF),
708		ground_det_wait_flag(WF), R = [(int(1),fd(1,'Name')),(int(3),fd(2,'Name')),(int(2),fd(3,'Name'))] )).
709		:- assert_must_succeed((bsets_clp:not_permutation_sequence(R,[int(1)],WF),
710		ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(1))] )).
711		:- assert_must_succeed((bsets_clp:not_permutation_sequence(R,global_set('Name'),_WF),R = [])).
712		:- assert_must_succeed((bsets_clp:not_permutation_sequence(R,global_set('Name'),WF),
713		ground_det_wait_flag(WF),R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
714		:- assert_must_succeed((bsets_clp:not_permutation_sequence(R,[int(1),int(2)],WF),
715		ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(3))] )).
716		:- assert_must_succeed((bsets_clp:not_permutation_sequence(R,global_set('Name'),WF),
717		ground_det_wait_flag(WF),R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
718		:- block not_permutation_sequence(-,?,?).
719		not_permutation_sequence(SeqFF,Type,WF) :- nonvar(SeqFF),
720		custom_explicit_sets:dom_range_for_specific_closure(SeqFF,FFDomain,FFRange,function(bijection),WF),!,
721		equality_objects_wf(FFRange,Type,Result,WF),
722		when(nonvar(Result),(Result=pred_false -> true ; not_is_sequence_domain(FFDomain,WF))).
723		not_permutation_sequence(Seq,Type,WF) :-
724		ground_value_check(Seq,SV),
725		not_permutation_sequence1(Seq,Type,SV,WF).
726		:- block not_permutation_sequence1(?,-,?,?), not_permutation_sequence1(?,?,-,?).
727		not_permutation_sequence1(avl_set(A),Type,_,WF) :- is_ground_set(Type), !, Seq=avl_set(A),
728		if(not_injective_sequence(Seq,Type,WF),
729		true, % no backtracking required; we could even use regular if with ->
730		not_surj_avl(Seq,Type,WF)
731		).
732		not_permutation_sequence1(avl_set(A),Type,_,WF) :- !, Seq=avl_set(A),
733		(not_injective_sequence(Seq,Type,WF)
734		; injective_sequence_wf(Seq,Type,WF),
735		not_surj_avl(Seq,Type,WF)).
736		not_permutation_sequence1(Seq,Type,_,WF) :-
737		expand_custom_set_to_list_wf(Seq,ESeq,Done,not_permutation_sequence1,WF),
738		not_permutation_sequence2(ESeq,Type,WF,Done).
739
740		not_surj_avl(Seq,Type,WF) :- range_wf(Seq,Range,WF),
741		not_equal_object_wf(Range,Type,WF). % TO DO: one could even just check cardinality as Seq is inj
742		%expand_custom_set_to_list_wf(Seq,ESeq,_,not_permutation_sequence1,WF),
743		% not_surjective_seq(ESeq,Type,WF).
744		% check if it is a ground set that cannot be instantiated
745		is_ground_set(V) :- var(V),!,fail.
746		is_ground_set(avl_set(_)).
747		is_ground_set(global_set(_)).
748		is_ground_set([]).
749
750		% here we could have a choice point in WF0
751		:- block not_permutation_sequence2(?,?,?,-).
752		not_permutation_sequence2(Seq,Type,WF,_) :- not_injective_sequence(Seq,Type,WF).
753		not_permutation_sequence2(Seq,Type,WF,_) :-
754		injective_sequence_wf(Seq,Type,WF), not_surjective_seq(Seq,Type,WF).
755
756		:- block not_surjective_seq(-,?,?).
757		not_surjective_seq([],T,WF) :- not_empty_set_wf(T,WF).
758		not_surjective_seq([(int(_),El)|Tail],Type,WF) :-
759		delete_element_wf(El,Type,NType,WF),
760		not_surjective_seq(Tail,NType,WF).
761
762		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:size_of_sequence([(int(1),int(22))],int(1),_WF))).
763		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:size_of_sequence([(int(2),int(22)),(int(1),int(22))],int(2),_WF))).
764		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:size_of_sequence([(int(2),int(22)),(int(1),int(22))],int(3),_WF))).
765		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:size_of_sequence([(int(2),int(22)),(int(1),int(22)),(int(3),int(33))],int(3),_WF))).
766		:- assert_must_succeed((bsets_clp:size_of_sequence(X,R,_WF),
767		X = [(int(1),int(2)),(int(2),int(1))],
768		R = int(2))).
769		:- assert_must_succeed((preferences:preference(use_clpfd_solver,false) -> true
770		; preferences:preference(use_smt_mode,false) -> true
771		; bsets_clp:size_of_sequence(X,R,_WF), R=int(RI),
772		clpfd_interface:clpfd_geq2(RI,2,_), nonvar(X), X = [(I1,_),(I2,_)|T],
773		I1==int(1), I2==int(2), T=[], RI==2 )).
774		:- assert_must_succeed((bsets_clp:size_of_sequence(X,R,_WF),X = [(int(1),_),(int(2),_)],R = int(2))).
775		:- assert_must_succeed((bsets_clp:size_of_sequence(X,_R,_WF),X =[(int(1),_),(int(2),_)] )).
776		:- assert_must_succeed_any((bsets_clp:size_of_sequence(X,int(2),_WF),nonvar(X),X=[_|Y],nonvar(Y),Y=[_|Z],Z==[])).
777		:- assert_must_succeed((bsets_clp:size_of_sequence([],int(0),_WF))).
778		:- assert_must_succeed((bsets_clp:size_of_sequence([],int(0),_WF))).
779		:- assert_must_succeed((bsets_clp:size_of_sequence([(int(1),int(4))],int(1),_WF))).
780		:- assert_must_succeed((bsets_clp:size_of_sequence([],_,_WF))).
781		:- assert_must_fail((bsets_clp:size_of_sequence(X,int(1),_WF),
782		X = [(int(1),_),(int(2),_)|_])).
783		:- block size_of_sequence(-,-,?).
784		size_of_sequence(Seq,int(Res),WF) :- size_of_sequence1(Seq,Res,WF),
785		set_up_sequence_skel(Seq,Res,WF).
786
787		% setup sequence skeleton if we have some CLPFD bounds information about the size
788		% currently still quite limited: only sets up if sequence is a variable; + does the setup only once
789		:- use_module(library(clpfd), [(#<=>)/2]).
790		:- use_module(clpfd_interface,[clpfd_domain/3]).
791		set_up_sequence_skel(Seq,Res,WF) :-
792		var(Seq), % to do: also deal with cases when Seq partially instantiated
793		var(Res),
794		preferences:preference(use_clpfd_solver,true),
795		!,
796		clpfd_interface:clpfd_geq2(Res,0,_), % assert that size must not be negative
797		clpfd_interface:try_post_constraint((Res#>0) #<=> Trigger), % generate reified trigger for when we can instantiate Seq
798		set_up_sequence_skel_aux(Seq,Res,Trigger,WF).
799		set_up_sequence_skel(_,_,_). % TO DO: check if Size interval shrinks
800		:- block set_up_sequence_skel_aux(-,?,-,?).
801		set_up_sequence_skel_aux(Seq,_Res,_Trigger,_WF) :-
802		nonvar(Seq),
803		!. % to do: also deal with cases when Seq partially instantiated
804		set_up_sequence_skel_aux(Seq,Res,_Trigger,_WF) :-
805		(number(Res) ; preferences:preference(use_smt_mode,true)),
806		!,
807		gen_seq_for_res(Res,Seq).
808		set_up_sequence_skel_aux(Seq,Res,_Trigger,WF) :-
809		get_large_finite_wait_flag(set_up_sequence_skel,WF,LWF),
810		% delay, avoid costly unification with partially instantiated list skeleton;
811		% TO DO: in future we may use the kernel_cardinality attribute instead
812		when((nonvar(LWF) ; nonvar(Seq) ; nonvar(Res)),
813		(nonvar(Seq) -> true ; gen_seq_for_res(Res,Seq))).
814
815		gen_seq_for_res(Res,Seq) :-
816		clpfd_domain(Res,FDLow,FDUp), % FDLow could also be 0
817		(number(FDLow) % it is ok if FDUp is sup, see test 1109
818		-> gen_sequence_skeleton(1,FDLow,FDUp,S),
819		Seq=S
820		; true).
821		gen_sequence_skeleton(N,M,FDUp,S) :- N>M,!,(FDUp==M -> S=[] ; true).
822		gen_sequence_skeleton(N,Max,FDUp,[(int(N),_)|T]) :-
823		N1 is N+1,
824		gen_sequence_skeleton(N1,Max,FDUp,T).
825
826		:- block size_of_sequence1(-,-,?).
827		size_of_sequence1(Seq,ResInt,WF) :-
828		nonvar(Seq),is_custom_explicit_set_nonvar(Seq),
829		size_of_custom_explicit_set(Seq,Size,WF),!,
830		equal_object_wf(Size,int(ResInt),size_of_sequence1,WF).
831		/* TO DO: CHECK BELOW: would it not be better to use cardinality ?? */
832		/*
833		size_of_sequence1(Seq,Size,WF) :- !,kernel_cardinality_attr:finite_cardinality_as_int_wf(Seq,int(Size),WF), check_indexes(Seq,Size).
834
835		construct_interval_closure(1,Size,Domain),
836		total_function_wf(FF,Domain,Range,_WF)
837		% we could also call total_function 1..Size --> _RangeType; would setup domain ?
838		:- block check_indexes(-,?).
839		check_indexes([],_) :- !.
840		check_indexes([(int(X),_)|T],Size) :- !,
841		less_than_equal_direct(X,Size), check_indexes(T,Size).
842		check_indexes(_,_).
843		*/
844		size_of_sequence1(Seq,Size,_WF) :- Size==0,!, empty_sequence(Seq).
845		size_of_sequence1(Seq,Size,WF) :-
846		expand_custom_set_to_list_wf(Seq,ESeq,_,size_of_sequence1,WF),
847		(var(ESeq),nonvar(Size) -> size_of_var_seq(ESeqR,0,Size),
848		ESeqR=ESeq % unify after to do propagation in one go, without triggering coroutines inbetween
849		; size_of_seq2(ESeq,0,Size),
850		(var(Size),var(ESeq) -> less_than_equal_direct(0,Size) % propagate that Size is positive
851		; true)
852		).
853		/* small danger of expanding closure while still var !*/
854		:- block size_of_seq2(-,?,-).
855		size_of_seq2([],Size,Size).
856		size_of_seq2([I|Tail],SizeSoFar,Res) :-
857		S2 is SizeSoFar + 1,
858		check_index(I,Res), % don't instantiate I yet; allow other kernel_predicates to freely instantiate it
859		less_than_equal_direct(S2,Res),
860		%(ground(Res) -> safe_less_than_equal(size_of_seq2,S2,Res) ; true),
861		size_of_seq2(Tail,S2,Res).
862		size_of_var_seq([],Size,Size).
863		size_of_var_seq([(int(S2),_)|Tail],SizeSoFar,Res) :-
864		S2 is SizeSoFar + 1,safe_less_than_equal(size_of_var_seq,S2,Res),
865		(var(Tail) -> size_of_var_seq(Tail,S2,Res) ; size_of_seq2(Tail,S2,Res)).
866
867
868		:- block check_index(-,?).
869		check_index((I,_),Res) :- check_index1(I,Res).
870		:- block check_index1(-,?).
871		check_index1(int(Idx),Res) :- less_than_equal_direct(Idx,Res).
872
873		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:prepend_sequence(int(33),[(int(1),int(22))],[(int(2),int(22)),(int(1),int(33))],WF),WF)).
874		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:prepend_sequence(int(33),[],[(int(1),int(33))],WF),WF)).
875		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:prepend_sequence(int(33),[(int(2),int(44)),(int(1),int(22))],[(int(1),int(33)),(int(3),int(44)),(int(2),int(22))],WF),WF)).
876		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:prepend_sequence(int(33),[(int(1),int(22))],[(int(1),int(22)),(int(2),int(33))],WF),WF)).
877		:- assert_must_succeed((bsets_clp:prepend_sequence(int(7),[],[(int(1),int(7))],_WF))).
878		:- assert_must_succeed((bsets_clp:prepend_sequence(int(7),X,R,_WF),
879		X = [(int(2),int(4)),(int(1),int(3))],
880		kernel_objects:equal_object(R,[(int(1),int(7)),(int(2),int(3)),(int(3),int(4))]))).
881		% code for insert_front operator: El -> Seq
882		:- block prepend_sequence(?,-,-,?).
883		prepend_sequence(El,Seq,Res,_WF) :- Seq==[],!,
884		equal_object_optimized([(int(1),El)],Res,prepend_sequence).
885		prepend_sequence(El,Seq,Res,WF) :- nonvar(Seq),is_custom_explicit_set(Seq,prepend_sequence),
886		prepend_custom_explicit_set(Seq,El,ERes),!,
887		equal_sequence(Res,ERes,WF).
888		prepend_sequence(El,Seq,Res,WF) :- nonvar(Res),is_custom_explicit_set(Res,prepend_sequence),
889		tail_sequence_custom_explicit_set(Res,First,Tail,unknown,WF),!,
890		equal_object_wf(El,First,prepend_sequence,WF),
891		equal_sequence(Seq,Tail,WF).
892		prepend_sequence(El,Seq,Res,WF) :-
893		equal_cons_wf(Res,(int(1),El),ShiftSeq,WF),
894		shift_seq_indexes(Seq,1,ShiftSeq,WF).
895
896		:- block shift_seq_indexes(-,-,?,?),shift_seq_indexes(-,?,-,?).
897		shift_seq_indexes(Seq,Offset,ShiftedSeq,WF) :-
898		Offset == 0,!, equal_sequence(Seq,ShiftedSeq,WF).
899		shift_seq_indexes(Seq,Offset,ShiftedSeq,WF) :- nonvar(Seq),!,
900		expand_custom_set_to_list_wf(Seq,ESeq,_,shift_seq_indexes,WF),
901		shift_seq_indexes2(ESeq,Offset,ShiftedSeq,WF,Done),
902		(Done == done
903		-> true
904		; % also propagate in the other way: TO DO: make a more efficient fine-grained two-ways propagation; maybe using CHR
905		NegOffset is -Offset,
906		expand_custom_set_to_list_wf(ShiftedSeq,ESeq1,_,shift_seq_indexes,WF),
907		shift_seq_indexes2(ESeq1,NegOffset,ESeq,WF,_)).
908		shift_seq_indexes(Seq,Offset,ShiftedSeq,WF) :- NegOffset is -Offset,
909		% compute in the other direction; TO DO: make a more efficient fine-grained two-ways propagation; maybe using CHR
910		expand_custom_set_to_list_wf(ShiftedSeq,ESeq,_,shift_seq_indexes,WF),
911		shift_seq_indexes2(ESeq,NegOffset,Seq,WF,Done),
912		(Done == done
913		-> true
914		; % also propagate in the original way:
915		expand_custom_set_to_list_wf(Seq,ESeq1,_,shift_seq_indexes,WF),
916		shift_seq_indexes2(ESeq1,Offset,ESeq,WF,_)).
917
918		:- block shift_seq_indexes2(-,?,?,?,?).
919		shift_seq_indexes2([],_,R,WF,Done) :- !, Done = done, empty_set_wf(R,WF).
920		shift_seq_indexes2([Pair|Tail],Offset,Res,WF,Done) :- !,
921		Pair = (int(N),El),
922		equal_cons_wf(Res,(int(NewN),El),ShiftTail,WF),
923		int_plus(int(N),int(Offset),int(NewN)),
924		shift_seq_indexes2(Tail,Offset,ShiftTail,WF,Done).
925		shift_seq_indexes2(Seq,Offset,Res,WF,Done) :-
926		add_internal_error('Unexpected set argument: ',shift_seq_indexes2(Seq,Offset,Res,WF,Done)), fail.
927
928		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:append_sequence([(int(1),int(22))],int(33),[(int(2),int(33)),(int(1),int(22))],WF),WF)).
929		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:append_sequence([],int(33),[(int(1),int(33))],WF),WF)).
930		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:append_sequence([(int(2),int(44)),(int(1),int(22))],int(33),[(int(1),int(22)),(int(3),int(33)),(int(2),int(44))],WF),WF)).
931		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:append_sequence([(int(1),int(22))],int(33),[(int(1),int(33)),(int(2),int(22))],WF),WF)).
932		:- assert_must_succeed((bsets_clp:append_sequence([],int(7),[(int(1),int(7))],_WF))).
933		:- assert_must_succeed((bsets_clp:append_sequence(X,int(7),R,_WF),
934		X = [(int(2),int(4)),(int(1),int(3))],
935		kernel_objects:equal_object(R,[(int(1),int(3)),(int(2),int(4)),(int(3),int(7))]))).
936
937		% code for the insert_tail operator Seq<-El
938		:- block append_sequence(-,?,-,?).
939		append_sequence(Seq,El,Res,_WF) :- Seq==[],!,
940		equal_object_optimized([(int(1),El)],Res,append_sequence).
941		append_sequence(Seq,El,Res,WF) :-
942		nonvar(Seq),is_custom_explicit_set_nonvar(Seq),
943		append_custom_explicit_set(Seq,El,ERes,WF),!,
944		equal_sequence(Res,ERes,WF).
945		append_sequence(Seq,El,Res,WF) :-
946		nonvar(Res),is_custom_explicit_set_nonvar(Res),
947		% we know result: deconstruct into last El and front Seq
948		front_sequence_custom_explicit_set(Res,Last,Front), !,
949		equal_object_wf(El,Last,append_sequence,WF),
950		equal_sequence(Seq,Front,WF).
951		append_sequence(Seq,El,Res,WF) :-
952		(var(Seq) -> size_of_sequence(Res,INewSize,WF), INewSize=int(NewSize) ; true),
953		equal_cons_wf(Res,(int(NewSize),El),ResT,WF),
954		append_sequence2(Seq,ResT,NewSize,WF).
955
956		:- block append_sequence2(-,?,-,?).
957		append_sequence2(Seq,ResT,_NewSize,WF) :- var(Seq),!,
958		equal_sequence(Seq,ResT,WF).
959		append_sequence2(Seq,ResT,NewSize,WF) :-
960		try_expand_custom_set_wf(Seq,ESeq,append_sequence2,WF),
961		equal_sequence(ESeq,ResT,WF),
962		size_of_sequence(ESeq,Size,WF),
963		int_plus(Size,int(1),int(NewSize)).
964
965		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:prefix_sequence([(int(1),int(22))],int(1),[(int(1),int(22))]))).
966		:- assert_must_succeed(exhaustive_kernel_succeed_check(bsets_clp:prefix_sequence([(int(2),int(22)),(int(3),int(33)),(int(1),int(11))],int(2),[(int(1),int(11)),(int(2),int(22))]))).
967		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:prefix_sequence([(int(2),int(22)),(int(3),int(33)),(int(1),int(11))],int(3),[(int(1),int(11)),(int(2),int(22))]))).
968		:- assert_must_succeed((bsets_clp:prefix_sequence(X,int(1),X),X = [(int(1),int(1))])).
969		:- assert_must_succeed((bsets_clp:prefix_sequence(X,int(0),[]),X = [(int(1),int(1))])).
970		:- assert_must_abort_wf((bsets_clp:prefix_sequence_wf(X,int(-1),_R,WF),X = [(int(1),int(1))]),WF).
971		:- assert_must_succeed((bsets_clp:prefix_sequence(X,int(2),Y),
972		X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
973		kernel_objects:equal_object(Y,[(int(1),int(1)),(int(2),int(3))]) )).
974		:- assert_must_succeed((bsets_clp:prefix_sequence(X,int(1),Y),
975		X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
976		kernel_objects:equal_object(Y,[(int(1),int(1))]) )).
977		:- assert_must_succeed((bsets_clp:prefix_sequence(X,int(3),Y),
978		X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
979		kernel_objects:equal_object(Y,X) )).
980
981		prefix_sequence(Seq,N,R) :- init_wait_flags(WF,[prefix_sequence]),
982		prefix_sequence_wf(Seq,N,R,WF),
983		ground_wait_flags(WF).
984
985		% Prefix of a sequence (s /|\ n)
986		prefix_sequence_wf(Seq,int(Num),Res,WF) :-
987		prefix_sequence1(Seq,Num,Res,WF),
988		propagate_size(Res,Num,WF).
989
990		% the size of the result of (s /|\ n) is the number n
991		:- block propagate_size(-,-,?).
992		propagate_size(Res,Num,WF) :-
993		var(Res),!,
994		(Num<0 -> preferences:preference(disprover_mode,false) % don't do anything; we may want to generate WD error
995		; Num < 4 -> size_of_sequence(Res,int(Num),WF)
996		; Prio is 1+Num // 100,
997		get_wait_flag(Prio,propagate_size,WF,LWF), % avoid setting up very large skeletons too early
998		block_size_of_sequence(LWF,Res,int(Num),WF)
999		).
1000		propagate_size(_,Num,_) :- number(Num), !. % no need to propagate
1001		propagate_size(_,_Num,_) :- \+ preferences:preference(find_abort_values,false),
1002		!. % do not propagate as we could prevent detection of WD errors below
1003		propagate_size([],Num,_WF) :- !,
1004		Num=0. % Note: this could prevent a wd-error being detected
1005		propagate_size(avl_set(A),Num,WF) :- var(Num),
1006		% with partially instantated sets we get slowdowns (SimpleCSGGrammar2_SlowCLPFD)
1007		% TO DO: treat list skeletons
1008		!,
1009		size_of_sequence(avl_set(A),int(Num),WF). % Note: this could prevent a wd-error being detected
1010		propagate_size(_,_,_). % should we also propagate the other way around ?
1011
1012		:- block block_size_of_sequence(-,?,?,?).
1013		block_size_of_sequence(_,Seq,Size,WF) :- size_of_sequence(Seq,Size,WF).
1014
1015		:- block prefix_sequence1(-,?,?,?), prefix_sequence1(?,-,?,?).
1016		prefix_sequence1(_Seq,Num,Res,WF) :- Num==0,!, empty_set_wf(Res,WF).
1017		prefix_sequence1(_Seq,Num,_Res,WF) :- Num<0,!, % according to version 1.8.8 of Atelier-B manual Num must be in 0..size(_Seq)
1018		add_wd_error('negative index in prefix_sequence (/|\\)! ', Num,WF).
1019		prefix_sequence1(Seq,Num,Res,WF) :-
1020		is_custom_explicit_set(Seq,prefix),
1021		prefix_of_custom_explicit_set(Seq,Num,ERes,WF),!, % TO DO: check Num <= size(Seq)
1022		equal_object_wf(Res,ERes,prefix_sequence1,WF).
1023		prefix_sequence1(Seq,Num,Res,WF) :-
1024		expand_custom_set_to_list_wf(Seq,ESeq,_,prefix_sequence1,WF),
1025		unify_same_index_elements(Res,ESeq,WF),
1026		unify_same_index_elements(Seq,Res,WF),
1027		prefix_seq(ESeq,Num,0,Res,WF).
1028		:- block prefix_seq(-,?,?,?,?).
1029		prefix_seq([],Max,Sze,Res,WF) :-
1030		(less_than_direct(Sze,Max)
1031		-> add_wd_error('index larger than size of sequence in prefix_sequence (/|\\)! ', (Max,Sze),WF)
1032		; true),
1033		empty_set_wf(Res,WF).
1034		%(less_than(int(_Sze),int(_Max))
1035		% -> (print_message('Index bigger than sequence size in prefix_sequence (/|\\) !'),
1036		% print_message(Max))
1037		% /* in the AtelierB book this is allowed, in Wordsworth + AMN on web it is not ?? */
1038		% ; true).
1039		prefix_seq([(int(N),El)|Tail],Max,SizeSoFar,Res,WF) :-
1040		prefix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF).
1041		:- block prefix_seq2(-,?,?,?,?,?,?).
1042		prefix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF) :- % SizeSoFar is always ground
1043		(less_than_equal_direct(N,Max), equal_cons_wf(Res,(int(N),El),PTail,WF)
1044		;
1045		less_than_direct(Max,N), equal_object_wf(Res,PTail,prefix_seq2,WF)
1046		),
1047		( SizeSoFar<N -> NewSizeSoFar=N ; NewSizeSoFar = SizeSoFar ),
1048		prefix_seq(Tail,Max,NewSizeSoFar,PTail,WF).
1049
1050		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:suffix_sequence([(int(1),int(22))],int(0),[(int(1),int(22))],WF),ground_det_wait_flag(WF))).
1051		:- assert_must_succeed(exhaustive_kernel_succeed_check(bsets_clp:suffix_sequence([(int(2),int(22)),(int(3),int(33)),(int(1),int(11))],int(1),[(int(1),int(22)),(int(2),int(33))],_WF))).
1052		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:suffix_sequence([(int(2),int(22)),(int(3),int(33)),(int(1),int(11))],int(2),[(int(1),int(22)),(int(2),int(33))],_WF))).
1053		:- assert_must_succeed((bsets_clp:suffix_sequence(X,int(0),X,_WF),X = [(int(1),int(1))])).
1054		:- assert_must_succeed((bsets_clp:suffix_sequence(X,int(1),[],_WF),X = [(int(1),int(1))])).
1055		:- assert_must_succeed((bsets_clp:suffix_sequence(X,int(2),Y,_WF),
1056		X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
1057		kernel_objects:equal_object(Y,[(int(1),int(4))]) )).
1058		:- assert_must_succeed((bsets_clp:suffix_sequence(X,int(1),Y,_WF),
1059		X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
1060		kernel_objects:equal_object(Y,[(int(1),int(3)),(int(2),int(4))]) )).
1061		:- assert_must_succeed((bsets_clp:suffix_sequence(X,int(2),Y,_WF),
1062		X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
1063		kernel_objects:equal_object(Y,[(int(1),int(4))]) )).
1064		:- assert_must_abort_wf(bsets_clp:suffix_sequence([(int(1),int(11)),(int(2),int(22))],int(-1),_R,WF),WF).
1065		:- assert_must_abort_wf(bsets_clp:suffix_sequence([(int(1),int(11)),(int(2),int(22))],int(3),_R,WF),WF).
1066
1067		% kernel_waitflags:assert_must_abort2_wf(bsets_clp:suffix_sequence([int(11),int(22)],int(-1),_R,WF),WF)
1068
1069		% suffix of a sequence (s \|/ n); also called restrict at tail (Atelier B) or Drop
1070		:- block suffix_sequence(-,?,?,?).
1071		suffix_sequence(Seq,int(Num),Res,WF) :-
1072		suffix_sequence1(Seq,Num,Res,WF).
1073		:- block suffix_sequence1(?,-,?,?).
1074		suffix_sequence1(Seq,Num,Res,WF) :- Num==0, !, equal_object_wf(Res,Seq,suffix_sequence1_1,WF).
1075		suffix_sequence1(_Seq,Num,_Res,WF) :- Num<0, !, add_wd_error('negative index in suffix_sequence (\\|/)! ', Num,WF).
1076		suffix_sequence1(Seq,Num,Res,WF) :- is_custom_explicit_set(Seq,suffix),
1077		suffix_of_custom_explicit_set(Seq,Num,ERes,WF),!,
1078		equal_object_wf(Res,ERes,suffix_sequence1_2,WF).
1079		suffix_sequence1(Seq,Num,Res,WF) :-
1080		expand_custom_set_to_list_wf(Seq,ESeq,_,suffix_sequence,WF), suffix_seq(ESeq,Num,0,Res,WF).
1081		:- block suffix_seq(-,?,?,?,?).
1082		suffix_seq([],Max,Sze,Res,WF) :-
1083		(less_than_direct(Sze,Max)
1084		-> add_wd_error('index larger than size of sequence in suffix_sequence (\\|/)! ', '>'(Max,Sze),WF)
1085		; true), empty_set_wf(Res,WF).
1086		suffix_seq([(int(N),El)|Tail],Max,SizeSoFar,Res,WF) :-
1087		suffix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF).
1088		:- block suffix_seq2(-,?,?,?,?,?,?).
1089		suffix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF) :-
1090		(less_than_equal_direct(N,Max), equal_object_wf(Res,PTail,suffix_seq2,WF)
1091		;
1092		less_than_direct(Max,N),int_minus(int(N),int(Max),int(NN)),
1093		equal_cons_wf(Res,(int(NN),El),PTail,WF)
1094		),
1095		(N>SizeSoFar -> (NewSizeSoFar=N)
1096		; (NewSizeSoFar = SizeSoFar)),
1097		suffix_seq(Tail,Max,NewSizeSoFar,PTail,WF).
1098
1099
1100
1101		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:concat_sequence([],[(int(1),int(33))],[(int(1),int(33))],WF),WF)).
1102		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:concat_sequence([(int(1),int(22)),(int(2),int(33))],[(int(1),int(33)),(int(2),int(44))],[(int(2),int(33)),(int(3),int(33)),(int(1),int(22)),(int(4),int(44))],WF),WF)). % not wfdet because of pending label_el_nr from clpfd_lists
1103		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:concat_sequence([(int(1),int(22))],[(int(1),int(33))],[(int(2),int(33)),(int(1),int(22))],WF),WF)).
1104		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:concat_sequence([(int(1),int(22))],[(int(1),int(33))],[(int(2),int(22)),(int(1),int(33))],WF),WF)).
1105		:- assert_must_succeed((bsets_clp:concat_sequence([],X,Y,_WF),
1106		X = [(int(1),int(1))], Y==X)).
1107		:- assert_must_succeed((bsets_clp:concat_sequence(X,[],Y,_WF), X = [(int(1),int(1))], Y==X)).
1108		:- assert_must_succeed((bsets_clp:concat_sequence([(int(1),int(1))],[],Y,_WF), Y==[(int(1),int(1))])).
1109		:- assert_must_succeed((bsets_clp:concat_sequence(X,X,Y,_WF),
1110		X = [(int(1),int(1))], kernel_objects:equal_object(Y,[(int(1),int(1)),(int(2),int(1))]))).
1111		:- assert_must_succeed((bsets_clp:concat_sequence(X,X,Y,_WF),
1112		X = [(int(2),int(88)),(int(1),int(77))],
1113		kernel_objects:equal_object(Y,[(int(1),int(77)),(int(2),int(88)),(int(3),int(77)),(int(4),int(88))]))).
1114
1115		:- block /* concat_sequence(-,-,?,?), */
1116		concat_sequence(?,-,-,?), concat_sequence(-,?,-,?).
1117		concat_sequence(S1,S2,Res,WF) :- Res==[],!, empty_set_wf(S1,WF), empty_set_wf(S2,WF).
1118		concat_sequence(S1,S2,Res,WF) :-
1119		(var(S1),var(S2) -> get_wait_flag(2,concat,WF,LWF) % we have at least two solutions; TODO maybe use cardinality as wait_flag?
1120		; LWF=1),
1121		concat_sequence2(LWF,S1,S2,Res,WF).
1122
1123		:- block concat_sequence2(-,?,-,?,?), concat_sequence2(-,-,?,?,?).
1124		concat_sequence2(_,S1,S2,Res,WF) :- S1==[],!,equal_sequence(S2,Res,WF).
1125		concat_sequence2(_,S1,S2,Res,WF) :- S2==[],!,equal_sequence(S1,Res,WF).
1126		concat_sequence2(LWF,S1,S2,Res,WF) :-
1127		try_expand_and_convert_to_avl_with_check(S1,AS1,concat1),
1128		try_expand_and_convert_to_avl_with_check(S2,AS2,concat2),
1129		concat_sequence3(LWF,AS1,AS2,Res,WF).
1130
1131		concat_sequence3(_,S1,S2,Res,WF) :- nonvar(S1),is_custom_explicit_set(S1,concat_sequence),
1132		concat_custom_explicit_set(S1,S2,ERes,WF),!,
1133		equal_sequence(Res,ERes,WF).
1134		concat_sequence3(_LWF,S1,S2,Res,WF) :-
1135		%try_expand_custom_set_wf(S1,ES1,concat,WF),
1136		size_of_sequence(S1,int(Size1),WF),
1137		(number(Size1) -> true
1138		; size_of_sequence(S2,Size2,WF),
1139		size_of_sequence(Res,SizeRes,WF),
1140		int_minus(SizeRes,Size2,int(Size1)),
1141		in_nat_range_wf(int(Size1),int(0),SizeRes,WF)
1142		% is this required: ?? ,in_nat_range_wf(Size2,int(0),SizeRes,WF)
1143		),
1144		concat_sequence_aux(Size1,S1,S2,Res,WF).
1145
1146
1147		:- assert_must_succeed( (bsets_clp:equal_sequence([(int(1),A)|T1],[(int(1),int(22))|T2],_WF),
1148		A==int(22),T2=[],T1==[] )) .
1149		:- assert_must_succeed( (bsets_clp:equal_sequence([(int(1),A)|T],avl_set(node((int(2),string(a)),true,0,node((int(1),string(c)),true,0,empty,empty),node((int(3),string(b)),true,0,empty,empty))),_WF),
1150		check_eqeq(A,string(c)),
1151		kernel_objects:equal_object(T,[(int(2),B)|T2]), check_eqeq(B,string(a)),
1152		kernel_objects:equal_object(T2,[(int(3),C)]), check_eqeq(C,string(b))) ).
1153		% equal_object optimized for sequences; can infer that pairs with same index have same value
1154		% TO DO: complete and make more efficient
1155		%equal_sequence(X,Y,_WF) :- nonvar(X),nonvar(Y),
1156		% is_custom_explicit_set(X,eval_sequence), is_custom_explicit_set(Y,eval_sequence),!,
1157		% equal_explicit_sets(X,Y).
1158		equal_sequence(X,Y,WF) :- nonvar(X),nonvar(Y),
1159		get_seq_head(X,XI,XEl,XT), get_seq_head(Y,YI,YEl,YT), XI==YI,!,
1160		% THIS CURRENTLY ONLY CHECKS FRONTMOST indexes
1161		equal_object_wf(XEl,YEl,equal_sequence_1,WF),
1162		equal_sequence(XT,YT,WF).
1163		equal_sequence(X,Y,WF) :-
1164		/* (is_custom_explicit_set(Y) -> monitor_equal_sequence_againts_custom_set(X,Y,WF)
1165		; is_custom_explicit_set(X) -> monitor_equal_sequence_againts_custom_set(Y,X,WF)
1166		; true), does not seem to buy anything; equal_object already powerful enough */
1167		equal_object_wf(X,Y,equal_sequence_2,WF).
1168
1169		% enforces the constraint that there is only one possible elemenent per index:
1170		%:- block monitor_equal_sequence_againts_custom_set(-,?,?).
1171		%monitor_equal_sequence_againts_custom_set([],_,_) :- !.
1172		%monitor_equal_sequence_againts_custom_set([El|T],CS,WF) :- !,
1173		% element_of_custom_set_wf(El,CS,WF),
1174		% monitor_equal_sequence_againts_custom_set(T,CS,WF).
1175		%monitor_equal_sequence_againts_custom_set(_,_,_).
1176
1177		get_seq_head([(Idx,El)|Tail],Idx,El,Tail).
1178		%get_seq_head(avl_set(AVL),Idx,El,Tail) :- does not seem to buy anything; equal_object already powerful enough
1179		% custom_explicit_sets:avl_min_pair(AVL,Idx,El),
1180		% custom_explicit_sets:direct_remove_element_from_avl(AVL,(Idx,El),Tail). % TO DO: only compute if indexes ==
1181
1182
1183		:- block concat_sequence_aux(-,?,?,?,?).
1184		concat_sequence_aux(Size1,_S1,_S2,Res,WF) :- nonvar(Res),Res=avl_set(_),
1185		size_of_custom_explicit_set(Res,int(RSize),WF), number(RSize),
1186		Size1 > RSize,!, % S1 is longer than Res; no solution (prevent WD error below)
1187		fail.
1188		concat_sequence_aux(Size1,S1,S2,Res,WF) :- nonvar(Res),Res=avl_set(_),
1189		% split Result into prefix and suffix
1190		prefix_of_custom_explicit_set(Res,Size1,Prefix,WF), % we could call versions which do not check WD
1191		suffix_of_custom_explicit_set(Res,Size1,Postfix,WF),
1192		!,
1193		equal_sequence(S1,Prefix,WF), equal_sequence(S2,Postfix,WF).
1194		concat_sequence_aux(Size1,S1,S2,Res,WF) :-
1195		shift_seq_indexes(S2,Size1,NewS2,WF),
1196		% We can do something stronger than disjoint union: we know that the indexes are disjoint!
1197		% Hence: if (int(X),Y) : Res & (int(X),Z) : S1 => Y=Z
1198		% Hence: if (int(X),Y) : Res & (int(X),Z) : S2 => Y=Z
1199		unify_same_index_elements(S1,Res,WF),
1200		unify_same_index_elements(Res,S1,WF),
1201		unify_same_index_elements(NewS2,Res,WF),
1202		unify_same_index_elements(Res,NewS2,WF),
1203		disjoint_union_wf(S1,NewS2,Res,WF).
1204
1205		% Check if (int(X),Y) pairs in Seq2 have a matching (int(X),Z) in Seq1 and then unify(Y,Z)
1206		:- block unify_same_index_elements(-,?,?).
1207		unify_same_index_elements(avl_set(A),Seq,WF) :- !,
1208		unify_same_index_elements_aux(Seq,A,WF).
1209		unify_same_index_elements(_,_,_). % TO DO: maybe also support other partially instantiated lists
1210
1211		:- block unify_same_index_elements_aux(-,?,?).
1212		unify_same_index_elements_aux([],_,_) :- !.
1213		unify_same_index_elements_aux([(int(Idx),El)|T],A,WF) :- !,
1214		try_find_index_element(Idx,El,A,WF),
1215		unify_same_index_elements_aux(T,A,WF).
1216		unify_same_index_elements_aux(_,_,_).
1217
1218		:- block try_find_index_element(-,?,?,?).
1219		try_find_index_element(Idx,El,AVL,WF) :-
1220		avl_fetch_pair(int(Idx),AVL,AvlEl),
1221		!,
1222		% We have found an entry with the same index: El and AvlEl must be identical:
1223		equal_object_wf(El,AvlEl,try_find_index_element,WF).
1224		try_find_index_element(_Idx,_El,_AVL,_WF). % :- print(not_found(_Idx,_AVL)),nl.
1225
1226		% TO DO: add waitflags + use within partition_wf
1227		% computes union of two sets which are guaranteed to be disjoint: means that if two of three sets known the other one can be determined
1228
1229		:- assert_must_succeed(exhaustive_kernel_check_wf([commutative],bsets_clp:disjoint_union_wf([int(3)],[int(2),int(1)],[int(1),int(3),int(2)],WF),WF)).
1230		:- assert_must_succeed(exhaustive_kernel_check_wf([commutative],bsets_clp:disjoint_union_wf([],[int(2),int(1)],[int(1),int(2)],WF),WF)).
1231		:- assert_must_succeed(exhaustive_kernel_check_wf([commutative],bsets_clp:disjoint_union_wf([int(1),int(2)],[],[int(2),int(1)],WF),WF)).
1232		:- assert_must_succeed((bsets_clp:disjoint_union_wf([int(1)],[int(2)],Res,_WF),kernel_objects:equal_object(Res,[int(1),int(2)]))).
1233		:- assert_must_succeed((bsets_clp:disjoint_union_wf(A,B,[int(1)],_WF),B=[H],H==int(1),A==[])).
1234
1235		% a union where we know that Set1 and Set2 are disjoint
1236		% this means we can propagate elements of Set1/2 more easily to result
1237		disjoint_union_wf(Set1,Set2,Res,WF) :-
1238		(var(Res)
1239		-> disjoint_union_wf0(Set1,Set2,DRes,DRes,WF),
1240		equal_object_optimized(Res,DRes) % try and convert result to AVL
1241		; disjoint_union_wf0(Set1,Set2,Res,Res,WF)).
1242
1243		% disjoint_union_wf0(Set1,Set2,UnionOfSet1Set2, SuperSet, WF)
1244		:- block disjoint_union_wf0(-,-,-,?,?).
1245		disjoint_union_wf0(Set1,Set2,Res,_,WF) :- Set1==[],!,equal_object_wf(Set2,Res,disjoint_union_wf0_1,WF).
1246		disjoint_union_wf0(Set1,Set2,Res,_,WF) :- Set2==[],!,equal_object_wf(Set1,Res,disjoint_union_wf0_2,WF).
1247		disjoint_union_wf0(Set1,Set2,Res,_,WF) :- Res==[],!,empty_set_wf(Set1,WF), empty_set_wf(Set2,WF).
1248		disjoint_union_wf0(Set1,Set2,Res,FullRes,WF) :-
1249		((nonvar(Set1);nonvar(Set2)) -> true ; get_cardinality_powset_wait_flag(Res,disjoint_union_wf0,WF,_Card,CWF)),
1250		disjoint_union0(Set1,Set2,Res,FullRes,WF,CWF).
1251
1252		:- block disjoint_union0(-,-,?,?,?,-), disjoint_union0(-,?,-,-,?,?), disjoint_union0(?,-,-,-,?,?).
1253		disjoint_union0(Set1,Set2,Res,_,WF,_) :- Set1==[],!,equal_object_wf(Set2,Res,disjoint_union0_1,WF).
1254		disjoint_union0(Set1,Set2,Res,_,WF,_) :- Set2==[],!,equal_object_wf(Set1,Res,disjoint_union0_2,WF).
1255		disjoint_union0(S1,S2,Res,_F,WF,_CWF) :-
1256		ground_value(Res),
1257		( ground_value(S1) -> !,
1258		check_subset_of_wf(S1,Res,WF), % TO DO: check if we can merge the check_subset and difference set in one predicate
1259		difference_set_wf(Res,S1,S2,WF)
1260		; ground_value(S2) -> !,
1261		check_subset_of_wf(S2,Res,WF),
1262		difference_set_wf(Res,S2,S1,WF)
1263		; var(S1),var(S2) -> !, % CWF nonvar
1264		% see test 1408; allows to generate subsets of Res and avoid enumeration warnings
1265		check_subset_of_wf(S1,Res,WF),
1266		%check_subset_of(S1,Res), % without waitflag: will generate ground version
1267		difference_set_wf(Res,S1,S2,WF)
1268		).
1269		disjoint_union0(Set1,Set2,Res,_,WF,_) :- nonvar(Set1),
1270		is_custom_explicit_set_nonvar(Set1),
1271		union_of_explicit_set(Set1,Set2,Union), !, % TODO: if it fails: copy/propagate values to result?
1272		equal_object_wf(Union,Res,disjoint_union0_3,WF).
1273		disjoint_union0(Set1,Set2,Res,Full,WF,_) :-
1274		expand_custom_set_to_list_no_dups_wf(Set1,ESet1,_,disjoint_union0_1,WF),
1275		expand_custom_set_to_list_no_dups_wf(Set2,ESet2,_,disjoint_union0_2,WF),
1276		disj_union1(ESet1,ESet2,Res,Full,WF).
1277
1278		:- block disj_union1(-,-,?,?,?).
1279		disj_union1(X,Y,Res,FullRes,WF) :-
1280		var(X) -> disj_union2(Y,X,Res,FullRes,WF) ; disj_union2(X,Y,Res,FullRes,WF).
1281
1282		disj_union2([],Y,Res,_,_WF) :- equal_object_optimized(Y,Res,disj_union2).
1283		disj_union2([X|TX],Y,Res,FullRes,WF) :-
1284		remove_element_wf(X,Res,TR,WF), % was: equal_cons_wf(Res,X,TR,WF) but error was that it could force X to be a certain value
1285		ground_value_check(X,XV),
1286		(nonvar(XV) -> equal_cons_wf(Res,X,TR,WF)
1287		; check_element_of_wf(X,FullRes,WF), % ensure that we set up proper constraints for X; e.g., for x \/ y = 1..10 & x /\ y = {}
1288		when(nonvar(XV), equal_cons_wf(Res,X,TR,WF))
1289		), % ensure that we instantiate Res if TR known; otherwise we may get pending co-routines, e.g. test 506, SyracuseGrammar
1290		disj_union3(TX,Y,TR,FullRes,WF).
1291
1292		:- block disj_union3(-,-,-,?,?).
1293		disj_union3(X,Y,Res,_,WF) :- Res==[],!,empty_set_wf(X,WF),empty_set_wf(Y,WF).
1294		disj_union3(X,Y,Res,FullRes,WF) :- disj_union1(X,Y,Res,FullRes,WF).
1295
1296
1297		:- block disjoint_union_generalized_wf(-,?,?).
1298		%disjoint_union_generalized_wf([Set1|T],Res,_WF) :- T==[],!, % just one set; probably not covered at the moment (ast_cleanup simplifies partition with single set
1299		% equal_object(Set1,Res).
1300		disjoint_union_generalized_wf(ListOfSets,Res,WF) :-
1301		%expand_custom_set_to_list_wf(SetsOfSets,ESetsOfSets,_,disjoint_union_generalized_wf,WF), % this is a list of sets
1302		disjoint_union_generalized2(ListOfSets,[],Res,WF).
1303		:- block disjoint_union_generalized2(-,?,?,?).
1304		disjoint_union_generalized2([],S,Res,WF) :- !, equal_object_optimized_wf(S,Res,disjoint_union_generalized2,WF).
1305		disjoint_union_generalized2([H|T],UnionSoFar,Res,WF) :- !,
1306		disjoint_union_wf0(H,UnionSoFar,UnionSoFar2,Res,WF),
1307		%% print_message(called_disjoint_union(H,UnionSoFar,UnionSoFar2)), %%
1308		disjoint_union_generalized2(T,UnionSoFar2,Res,WF).
1309		disjoint_union_generalized2(L,S,Res,WF) :-
1310		add_internal_error('Not a list: ',disjoint_union_generalized2(L,S,Res,WF)),fail.
1311		% TO DO: if there are more than two sets: it may be interesting to set up constraint that
1312		% each set is a subset of the full set;
1313		% (would avoid enumeration warning in, e.g., x \/ y \/ z = 1..10 & x /\ y = {} & x /\ z = {} & y /\ z = {} & card(x)=card(y)+2 )
1314
1315		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:concatentation_of_sequences([(int(1),[]),(int(3),[(int(1),int(22)),(int(2),int(33))]),(int(2),[(int(1),int(11))])],
1316		[(int(1),int(11)),(int(2),int(22)),(int(3),int(33))],_WF))).
1317		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:concatentation_of_sequences([(int(1),[]),(int(2),[(int(1),int(33))])],[(int(1),int(33))],_WF))).
1318		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:concatentation_of_sequences([(int(1),[]),(int(2),[(int(1),int(55))])],Res,WF),
1319		kernel_waitflags:ground_wait_flags(WF),
1320		kernel_objects:equal_object(Res,[(int(1),int(55))]) )).
1321		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:concatentation_of_sequences([(int(1),[(int(1),int(22))]),(int(2),[(int(1),int(55))])],Res,WF),
1322		kernel_waitflags:ground_wait_flags(WF),
1323		kernel_objects:equal_object(Res,[(int(1),int(22)),(int(2),int(55))]) )).
1324		:- block concatentation_of_sequences(-,?,?).
1325		concatentation_of_sequences(SeqOfSeq,Res,WF) :-
1326		try_expand_and_convert_to_avl_with_check(SeqOfSeq,ES,conc),
1327	?	concs2(ES,Res,WF).
1328
1329		concs2(SeqOfSeq,Res,WF) :- is_custom_explicit_set(SeqOfSeq,conc),
1330		conc_custom_explicit_set(SeqOfSeq,CRes),!,
1331		equal_object_wf(CRes,Res,concs2,WF).
1332		concs2(SeqOfSeq,Res,WF) :- empty_set_wf(SeqOfSeq,WF),empty_set_wf(Res,WF).
1333		concs2(SeqOfSeq,Res,WF) :- not_empty_set_wf(SeqOfSeq,WF),
1334		front_sequence(SeqOfSeq,Front,WF),
1335		concatentation_of_sequences(Front,FrontRes,WF),
1336		last_sequence(SeqOfSeq,Last,WF),
1337		concat_sequence(FrontRes,Last,Res,WF).
1338
1339		:- assert_must_abort_wf(bsets_clp:tail_sequence([],_R,unknown,WF),WF).
1340		:- assert_must_abort_wf(bsets_clp:tail_sequence([],[],unknown,WF),WF).
1341		:- assert_must_succeed(exhaustive_kernel_succeed_check(
1342		bsets_clp:tail_sequence([(int(1),int(4)),(int(2),int(5))],[(int(1),int(5))],unknown,_WF)) ).
1343		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:tail_sequence([(int(1),int(4)),(int(3),int(6)),(int(2),int(5))],
1344		[(int(1),int(5)),(int(2),int(6))],unknown,_WF)) ).
1345		:- assert_must_succeed((bsets_clp:tail_sequence(X,R,unknown,_),
1346		X = [(int(1),int(6)),(int(2),int(5))],
1347		kernel_objects:equal_object(R,[(int(1),int(5))]) )).
1348		:- assert_must_succeed((bsets_clp:tail_sequence(X,[(int(1),int(5))],unknown,_),
1349		X = [(int(1),int(6)),(int(2),int(5))] )).
1350		:- assert_must_succeed((bsets_clp:tail_sequence(X,[(int(1),int(5)),(int(2),int(7))],unknown,_),
1351		X = [(int(1),int(6)),(int(2),int(5)),(int(3),int(7))] )).
1352		:- assert_must_succeed((bsets_clp:tail_sequence(X,[(int(2),int(7)),(int(1),int(5))],unknown,_),
1353		X = [(int(1),int(6)),(int(2),int(5)),(int(3),int(7))] )).
1354		:- block tail_sequence(-,?,?,?).
1355		tail_sequence(S1,Res,Span,WF) :- is_custom_explicit_set(S1,tail_sequence),
1356		tail_sequence_custom_explicit_set(S1,_,TRes,Span,WF),!,
1357		equal_object_wf(TRes,Res,tail_sequence,WF).
1358		tail_sequence(S1,Res,Span,WF) :- expand_custom_set_to_list_wf(S1,ES1,_,tail_sequence,WF),
1359		tail2(ES1,Res,Span,WF).
1360
1361		tail2([],_,Span,WF) :-
1362		add_wd_error_span('tail applied to empty sequence!',[],Span,WF).
1363		tail2([H|T],Res,_Span,WF) :- domain_subtraction_wf([int(1)],[H|T],IntRes,WF),
1364		shift_seq_indexes(IntRes,-1,Res,WF).
1365
1366
1367		:- assert_must_abort_wf(bsets_clp:first_sequence([],_R,unknown,WF),WF).
1368		:- assert_must_abort_wf(bsets_clp:first_sequence([],int(1),unknown,WF),WF).
1369		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:first_sequence([(int(1),int(4)),(int(2),int(5))],int(4),unknown,_WF)) ).
1370		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:first_sequence([(int(1),int(4)),(int(3),int(6)),(int(2),int(5))],int(4),unknown,_WF)) ).
1371		:- assert_must_succeed((bsets_clp:first_sequence(X,R,unknown,_WF),
1372		X = [(int(1),int(2)),(int(2),int(1))],
1373		R = int(2))).
1374
1375		:- block first_sequence(-,?,?,?).
1376		first_sequence([],_,Span,WF) :- !,add_wd_error_span('first applied to empty sequence!',[],Span,WF).
1377		first_sequence(Seq,Res,Span,WF) :- apply_to(Seq,int(1),Res,Span,WF).
1378
1379
1380
1381		:- assert_must_abort_wf(bsets_clp:front_sequence([],_R,WF),WF).
1382		:- assert_must_abort_wf(bsets_clp:front_sequence([],[],WF),WF).
1383		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:front_sequence([(int(1),int(4)),(int(2),int(5))],[(int(1),int(4))],_WF)) ).
1384		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:front_sequence([(int(1),int(4)),(int(3),int(6)),(int(2),int(5))],[(int(1),int(4)),(int(2),int(5))],_WF)) ).
1385		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:front_sequence(X,R,WF),
1386		X = [(int(1),int(2)),(int(2),int(55))],kernel_waitflags:ground_wait_flags(WF),
1387		kernel_objects:equal_object(R,[(int(1),int(2))]))).
1388		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:front_sequence(X,R,WF),
1389		X = [(int(3),int(33))|R], kernel_waitflags:ground_wait_flags(WF),
1390		kernel_objects:equal_object(R,[(int(1),int(2)),(int(2),int(55))]) )).
1391
1392		front_sequence(Seq,Res,WF) :- front_sequence(Seq,Res,unknown,WF).
1393		:- block front_sequence(-,?,?,?).
1394		front_sequence(S1,Res,_Span,WF) :-
1395		is_custom_explicit_set(S1,front_sequence),
1396		front_sequence_custom_explicit_set(S1,_,FRes),!,
1397	?	equal_object_wf(FRes,Res,front_sequence,WF).
1398		front_sequence(Seq,Res,Span,WF) :- expand_custom_set_to_list_wf(Seq,ESeq,_,front_sequence,WF),
1399		front2(ESeq,Res,Span,WF).
1400		front2([],_,Span,WF) :- add_wd_error_span('front applied to empty sequence!',[],Span,WF).
1401		front2([H|T],Res,_Span,WF) :- size_of_sequence([H|T],int(Size),WF),
1402		(number(Size) -> true ; size_of_sequence(Res,SizeRes,WF), int_plus(SizeRes,int(1),int(Size))),
1403		when(ground(Size), domain_subtraction_wf([int(Size)],[H|T],Res,WF)).
1404
1405
1406		:- assert_must_abort_wf(bsets_clp:last_sequence([],_R,WF),WF).
1407		:- assert_must_abort_wf(bsets_clp:last_sequence([],int(1),WF),WF).
1408		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:last_sequence([(int(1),int(4)),(int(2),int(5))],int(5),_WF)) ).
1409		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:last_sequence([(int(1),int(4)),(int(3),int(6)),(int(2),int(5))],int(6),_WF)) ).
1410		:- assert_must_succeed((bsets_clp:last_sequence(X,R,_WF),
1411		X = [(int(1),int(2)),(int(2),int(55))],R = int(55))).
1412		:- assert_must_succeed((bsets_clp:last_sequence(X,R,_WF), X = [(int(1),int(55))], R = int(55))).
1413		:- assert_must_succeed((bsets_clp:last_sequence([(int(1),[(int(1),int(22))]),(int(2),[(int(1),int(55))])],R,_WF), R == [(int(1),int(55))])).
1414
1415		last_sequence(Seq,Res,WF) :- last_sequence(Seq,Res,unknown,WF).
1416		:- block last_sequence(-,?,?,?).
1417		last_sequence(Seq,Res,_Span,WF) :-
1418		is_custom_explicit_set(Seq,last_sequence),
1419		last_sequence_explicit_set(Seq,Last), !,
1420		equal_object_wf(Last,Res,last_sequence,WF).
1421		last_sequence([],_,Span,WF) :- !,add_wd_error_span('last applied to empty sequence!',[],Span,WF).
1422		last_sequence(Seq,Res,Span,WF) :-
1423		size_of_sequence(Seq,int(Size),WF),
1424		last_sequence_aux(Size,Seq,Res,Span,WF).
1425		:- block last_sequence_aux(-,?,?,?,?).
1426		last_sequence_aux(Size,Seq,Res,Span,WF) :-
1427		apply_to(Seq,int(Size),Res,Span,WF).
1428
1429
1430		:- assert_must_succeed(exhaustive_kernel_check_wfdet( bsets_clp:rev_sequence([(int(1),int(4)),(int(2),int(5))],[(int(1),int(5)),(int(2),int(4))],WF),WF )).
1431		:- assert_must_succeed(exhaustive_kernel_check_wfdet( bsets_clp:rev_sequence([(int(1),int(4))],[(int(1),int(4))],WF),WF )).
1432		:- assert_must_succeed(exhaustive_kernel_check_wfdet( bsets_clp:rev_sequence([],[],WF),WF )).
1433		:- assert_must_succeed(exhaustive_kernel_check_wfdet( bsets_clp:rev_sequence([(int(1),int(4)),(int(3),int(6)),(int(2),int(5))],[(int(1),int(6)),(int(3),int(4)),(int(2),int(5))],WF),WF )).
1434		:- assert_must_succeed((bsets_clp:rev_sequence([],[],_WF))).
1435		:- assert_must_succeed((bsets_clp:rev_sequence(X,R,_WF),
1436		X = [(int(1),int(2)),(int(2),int(1))],
1437		kernel_objects:equal_object(R,[(int(2),int(2)),(int(1),int(1))]) )).
1438		:- assert_must_succeed((bsets_clp:rev_sequence(X,R,_WF),
1439		X = [(int(1),int(23)),(int(2),int(1)),(int(3),int(55))],
1440		kernel_objects:equal_object(R,[(int(3),int(23)),(int(2),int(1)),(int(1),int(55))]) )).
1441		:- assert_must_succeed((bsets_clp:rev_sequence(R,X,_WF),
1442		X = [(int(1),int(23)),(int(2),int(1)),(int(3),int(55))],
1443		kernel_objects:equal_object(R,[(int(3),int(23)),(int(2),int(1)),(int(1),int(55))]) )).
1444		:- assert_must_succeed((bsets_clp:rev_sequence(X,_R,_WF),
1445		X = [(int(2),int(1)),(int(1),int(23)),(int(3),int(55))] )).
1446		:- assert_must_succeed((bsets_clp:rev_sequence(_R,X,_WF),
1447		X = [(int(3),int(55)),(int(1),int(23)),(int(2),int(1))] )).
1448
1449		/* reverse of sequence */
1450		:- block rev_sequence(-,-,?).
1451		rev_sequence(S1,Res,WF) :-
1452		(nonvar(S1) -> rev_sequence2(S1,Res,WF)
1453		; rev_sequence2(Res,S1,WF)).
1454
1455		rev_sequence2(S1,Res,WF) :- reverse_custom_explicit_set(S1,RS1),!,
1456		equal_object_wf(Res,RS1,WF).
1457		rev_sequence2(S1,Res,WF) :-
1458		expand_custom_set_to_list_wf(S1,ES1,_,rev_sequence2,WF),
1459		size_of_sequence(ES1,int(Size1),WF),
1460		% TO DO: we could also try and get the size from the result Res
1461		rev_sequence3(ES1,Size1,Res,WF).
1462
1463		:- block rev_sequence3(?,-,-,?).
1464		rev_sequence3(E,_Size,Res,WF) :- nonvar(Res), reverse_custom_explicit_set(Res,RevRes),!,
1465		equal_object_wf(E,RevRes,WF).
1466		rev_sequence3(E,Size,Res,WF) :- var(Size), !,
1467		% try to obtain size from result as well
1468		size_of_sequence(Res,int(Size),WF), rev_sequence3b(E,Size,Res,WF).
1469	?	rev_sequence3(E,S,R,WF) :- rev_sequence4(E,S,R,WF).
1470
1471		:- block rev_sequence3b(?,-,?,?).
1472		rev_sequence3b(E,S,R,WF) :- rev_sequence4(E,S,R,WF).
1473
1474		:- block rev_sequence4(-,?,?,?).
1475		rev_sequence4([],_,Res,WF) :- empty_set_wf(Res,WF).
1476		rev_sequence4([(int(N),El)|Tail],Size1,Res,WF) :-
1477	?	equal_cons_wf(Res,(NewN,El),RTail,WF),
1478		% compute NewN = Size - (N-1)
1479		int_minus(int(N),int(1),N1),
1480		int_minus(int(Size1),N1,NewN),
1481		(ground(NewN) -> true ; in_nat_range(NewN,int(0),int(Size1))),
1482	?	rev_sequence4(Tail,Size1,RTail,WF).
1483
1484
1485		/* --------- */
1486		/* RELATIONS */
1487		/* --------- */
1488
1489		%maplet(X,Y,(X,Y)).
1490
1491		% relation([]).
1492		% relation([(_X,_Y)|T]) :- relation(T).
1493
1494		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:relation_over_wf([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
1495		:- assert_must_succeed(exhaustive_kernel_check( bsets_clp:relation_over([],[int(1),int(2)],[int(2)]) )).
1496		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([(int(1),int(2))],[int(1),int(2)],[int(2)]) )).
1497		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([([int(1)],[int(2)])],[[int(1)],[],[int(2)]],[[int(2)]]) )).
1498		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([(pred_true /* bool_true */,pred_false /* bool_false */)],[pred_false /* bool_false */,pred_true /* bool_true */],[pred_false /* bool_false */]) )).
1499		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([((pred_true /* bool_true */,int(2)),fd(1,'Name'))],[(pred_false /* bool_false */,int(1)),(pred_true /* bool_true */,int(2))],[fd(2,'Name'),fd(1,'Name')]) )).
1500		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([((rec([field(a,fd(1,'Name'))]),int(2)),fd(1,'Name'))],[(rec([field(a,fd(1,'Name'))]),int(1)),(rec([field(a,fd(1,'Name'))]),int(2))],[fd(2,'Name'),fd(1,'Name')]) )).
1501		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([((rec([field(a,fd(2,'Name')),field(b,fd(1,'Name'))]),int(2)),fd(1,'Name'))],[(rec([field(a,fd(1,'Name')),field(b,fd(1,'Name'))]),int(1)),(rec([field(a,fd(1,'Name')),field(b,fd(2,'Name'))]),int(2)),(rec([field(a,fd(2,'Name')),field(b,fd(1,'Name'))]),int(2))],[fd(2,'Name'),fd(1,'Name')]) )).
1502		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([((pred_true /* bool_true */,int(2)),string('STRING1'))],[(pred_false /* bool_false */,int(1)),(pred_true /* bool_true */,int(2))],[string('STRING2'),string('STRING1')]) )).
1503		:- assert_must_succeed(exhaustive_kernel_succeed_check( /* multiple solutions !!*/ bsets_clp:relation_over([(int(1),int(2)),(int(2),int(2))],[int(1),int(2)],[int(2)]) )).
1504		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([(int(1),int(2)),(int(1),int(3))],[int(1),int(2)],[int(3),int(2)]) )).
1505		:- assert_must_succeed(exhaustive_kernel_fail_check( bsets_clp:relation_over([(int(1),int(2)),(int(2),int(1))],[int(1),int(2)],[int(2)]) )).
1506		:- assert_must_fail(( bsets_clp:relation_over([(int(1),int(1))],[int(1),int(2)],[int(2)]) )).
1507		:- assert_must_succeed(( bsets_clp:relation_over(X,[int(1),int(2)],[int(3)]),
1508		X==[(int(1),int(3))] )).
1509		:- assert_must_succeed(( bsets_clp:relation_over(X,[int(1),int(2)],[int(3)]),
1510		X==[(int(1),int(3)),(int(2),int(3))] )).
1511		:- assert_must_succeed(( bsets_clp:relation_over(X,[int(1),int(2)],[int(4),int(5)]),
1512		X==[(int(2),int(4)),(int(2),int(5))] )).
1513
1514		relation_over(R,Dom,Ran) :- init_wait_flags(WF,[relation_over]),
1515		relation_over_wf(R,Dom,Ran,WF),
1516		ground_wait_flags(WF).
1517
1518		:- block relation_over_wf(-,-,-,?).
1519		relation_over_wf(R,Dom,Ran,WF) :-
1520		kernel_equality:get_cardinality_relation_over_wait_flag(Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels),
1521	?	relation_over1(R,Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels).
1522
1523		:- block relation_over1(-,?,?,?,-,?,?).
1524		relation_over1(FF,Domain,Range,WF,_WFR,_MaxCard,_MaxNrOfRels) :-
1525		nonvar(FF),
1526		custom_explicit_sets:is_definitely_maximal_set(Range),
1527		% we do not need the Range; this means we can match more closures (e.g., lambda)
1528		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,_,WF),!,
1529		check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF).
1530		relation_over1(FF,Domain,Range,WF,_WFR,_MaxCard,_MaxNrOfRels) :- nonvar(FF),
1531		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,_,WF),!,
1532		check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF),
1533		check_range_subset_for_closure_wf(FF,FFRange,Range,WF).
1534		relation_over1(R,Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels) :- var(R),!,
1535		expand_custom_set_to_list_wf(R,ER,_,relation_over1,WF),
1536	?	relation_over2(ER,[],Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels,none).
1537		relation_over1(R,Domain,Range,WF,_WFR,_MaxCard,_) :-
1538		expand_and_convert_to_avl_set_catch(R,AER,relation_over1,'ARG : ? <-> ?',ResultStatus,WF),!,
1539		(ResultStatus=avl_set
1540	?	-> is_avl_relation_over_domain(AER,Domain,WF),
1541	?	is_avl_relation_over_range(AER,Range,WF)
1542		; (debug_mode(on) -> add_message_wf(relation_over,'SYMBOLIC <-> check: ',R,unknown,WF) ; true),
1543		symbolic_domain_subset_check(R,Domain,WF),
1544		symbolic_range_subset_check(R,Range,WF)
1545		).
1546		relation_over1(R,Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels) :-
1547		expand_custom_set_to_list_wf(R,ER,_,relation_over1,WF),
1548	?	relation_over2(ER,[],Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels,none).
1549
1550		% check the domain of a symbolic closure value FF whose domain is FFDomain and expected domain is Domain:
1551		check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF) :-
1552		opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
1553		[b_operator(domain,[FF]),Domain],unknown),WF2),
1554		check_subset_of_wf(FFDomain,Domain,WF2).
1555		% ditto for range
1556		check_range_subset_for_closure_wf(FF,FFRange,Range,WF) :-
1557		opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
1558		[b_operator(range,[FF]),Range],unknown),WF2),
1559		check_subset_of_wf(FFRange,Range,WF2).
1560
1561
1562		% try and expand set to AVL and catch enumeration warning exceptions and set OK result value
1563		% if it succeeds with OK = avl_set -> we have an avl_set
1564		% if it fails: it cannot be expanded at the moment
1565		% if it retuns keep_symbolic: expansion cannot be performed and can never be performed; keep set symbolic
1566		expand_and_convert_to_avl_set_catch(R,_AS,_Origin,_Operator,_ResultStatus,_WF) :- var(R),!,fail.
1567		expand_and_convert_to_avl_set_catch(R,_AS,_Origin,_Operator,ResultStatus,_WF) :-
1568		is_infinite_explicit_set(R),!, % we could also use is_infinite_or_symbolic_closure
1569		ResultStatus=keep_symbolic.
1570		expand_and_convert_to_avl_set_catch(R,AS,Origin,Operator,ResultStatus,WF) :-
1571		catch(
1572		(expand_and_convert_to_avl_set(R,AS,Origin,Operator),ResultStatus=avl_set),
1573		enumeration_warning(_,_,_,_,_),
1574		(add_message_wf(Origin,'Attempting symbolic treatment, enumeration warning occured while expanding ARG for ',
1575		Operator,b(value(R),any,[]),WF),
1576		ResultStatus=keep_symbolic)).
1577
1578		expand_and_convert_to_avl_set_warn(R,_AS,_Origin,_Operator,_WF) :- var(R),!,fail.
1579		expand_and_convert_to_avl_set_warn(R,AS,Origin,Operator,WF) :-
1580		% TO DO: check for not fully instantiated closures, like memoization closures where ID not yet known
1581		% it is used before a cut: we need to expand straightaway without choice points
1582		(is_symbolic_closure(R)
1583		-> add_message_wf(Origin,'Expanding symbolic set argument ARG for predicate ',Operator,b(value(R),any,[]),WF)
1584		; true),
1585		% TODO: instead of observe_enumeration_warnings we could push onto the call-stack and pass WF
1586		observe_enumeration_warnings(expand_and_convert_to_avl_set(R,AS,Origin,Operator),
1587		add_message_wf(Origin,'Enumeration warning occured while expanding argument ARG for predicate ',
1588		Operator,b(value(R),any,[]),WF)).
1589		%expand_and_convert_to_avl_set(R,AS,_,Operator,Values) :-
1590		% observe_enumeration_warnings(expand_and_convert_to_avl_set(R,AS,,),
1591		% display_warning_message(Operator,Values)).
1592		%display_warning_message(Operator,Values) :-
1593		% format(user_error,'Enumeration Warning for Operator ~w~n',[Operator]),
1594		% maplist(translate:print_bvalue,Values),nl.
1595
1596		:- block relation_over2(-,?,?,?,?,-,?,?,?).
1597		relation_over2([],_,_,_,_WF,_WFR,_MaxCard,_MaxNrOfRels,_LastPair).
1598		relation_over2(REL,SoFar,Domain,Range,WF,WFR,MaxCard,MaxNrOfRels,LastPair) :-
1599		(var(REL) -> NewLastPair=(X,Y) ; NewLastPair=none), %remember whether we freely chose X,Y
1600		REL = [(X,Y)|T],
1601	?	(number(MaxCard)
1602		-> MaxCard>0,C1 is MaxCard-1 ,(C1=0 -> T=[] ; true)
1603		; C1=MaxCard),
1604		% TO DO: try to enumerate elements in order
1605	?	ordered_pair(LastPair,X,Y,not_equal),
1606	?	check_element_of_wf(X,Domain,WF),
1607	?	check_element_of_wf(Y,Range,WF),
1608	?	not_element_of_wf((X,Y),SoFar,WF),
1609		update_waitflag(MaxNrOfRels,WFR,NewWFR,WF),
1610	?	relation_over2(T,[(X,Y)|SoFar],Domain,Range,WF,NewWFR,C1,MaxNrOfRels,NewLastPair).
1611
1612		% check that new pair is greater than previous pair, if that pair was freely chosen
1613		ordered_pair(none,_,_,_).
1614		ordered_pair((LastX,LastY),NewX,NewY,Eq) :- ordered_value(LastX,NewX,EqualX),
1615		check_second_component(EqualX,LastY,NewY,Eq).
1616
1617		:- block check_second_component(-,?,?,?).
1618		check_second_component(equal,X,Y,EqRes) :- ordered_value(X,Y,EqRes).
1619		check_second_component(not_equal,_X,_Y,not_equal). % no need to check 2nd component
1620
1621		:- block ordered_value(-,?,?), ordered_value(?,-,?).
1622		ordered_value(pred_true /* bool_true */,B,Eq) :- !, (B=pred_true /* bool_true */ -> Eq=equal ; Eq=not_equal).
1623		ordered_value(pred_false /* bool_false */,B,Eq) :- !, B=pred_false /* bool_false */, Eq=equal.
1624		ordered_value(int(X),int(Y),Eq) :- !,
1625		kernel_objects:less_than_equal_direct(X,Y), equal_atomic_term(X,Y,Eq).
1626		ordered_value(fd(NrX,T),fd(NrY,T),Eq) :- !,
1627		kernel_objects:less_than_equal_direct(NrX,NrY),
1628		equal_atomic_term(NrX,NrY,Eq).
1629		ordered_value((X1,X2),(Y1,Y2),Eq) :- !, ordered_pair((X1,X2),Y1,Y2,Eq).
1630		ordered_value(string(X),string(Y),Eq) :- !, less_equal_atomic_term(X,Y,Eq).
1631		ordered_value(rec(FX),rec(FY),Eq) :- !,
1632		ordered_fields(FX,FY,Eq).
1633		ordered_value([],Y,Eq) :- !, (Y==[] -> Eq=equal ; Eq=not_equal). % empty set is the smallest set
1634		ordered_value(avl_set(A),Y,Eq) :- !,
1635		(Y==[] -> fail
1636		; Y=avl_set(B) -> (A @< B -> Eq=not_equal ; A@>B -> fail ; Eq=equal)
1637		; print(assuming_strictly_ordered(avl_set(A),Y)),nl,
1638		Eq=not_equal). % TO DO: treat sets better
1639		ordered_value([H|T],Y,Eq) :- !, ordered_value_cons(Y,H,T,Eq).
1640		ordered_value(term(T1),term(T2),Eq) :- !, ordered_term_value(T1,T2,Eq).
1641		ordered_value(A,B,not_equal) :- write(assuming_strictly_ordered(A,B)),nl.
1642
1643		:- block ordered_term_value(-,?,?),ordered_term_value(?,-,?).
1644		ordered_term_value(floating(F1),floating(F2),Eq) :- !,
1645		kernel_reals:real_less_than_equal_wf(term(floating(F1)),term(floating(F2)),no_wf_available),
1646		equal_atomic_term(F1,F2,Eq).
1647		ordered_term_value(A,B,not_equal) :- write(assuming_strictly_ordered(A,B)),nl.
1648
1649		ordered_value_cons([],_,_,_) :- !,fail.
1650		ordered_value_cons([H2|T2],H,T,Eq) :- !,ordered_pair((H,T),H2,T2,Eq). % Note: order different than for avl_sets!
1651		ordered_value_cons(Y,H,T,not_equal) :- write(assuming_strictly_ordered([H|T],Y)),nl.
1652
1653		:- block ordered_fields(-,?,?).
1654		ordered_fields([],RHS,Eq) :- !,RHS=[], Eq=equal.
1655		ordered_fields([field(Name,ValX)|TX],RHS,Eq) :- !,RHS=[field(Name,ValY)|TY],
1656		ordered_value(ValX,ValY,Equal1), check_next_field(Equal1,TX,TY,Eq).
1657		ordered_fields(FX,FY,Eq) :- add_internal_error('Unknown fields: ',ordered_fields(FX,FY,Eq)), Eq=not_equal.
1658
1659		:- block check_next_field(-,?,?,?).
1660		check_next_field(equal,TX,TY,EqRes) :- ordered_fields(TX,TY,EqRes).
1661		check_next_field(not_equal,_X,_Y,not_equal). % no need to check next field
1662
1663		:- block less_equal_atomic_term(-,?,?), less_equal_atomic_term(?,-,?).
1664		less_equal_atomic_term(A,B,Res) :- (A==B -> Res=equal ; A @<B, Res=not_equal).
1665
1666		:- block equal_atomic_term(-,?,?), equal_atomic_term(?,-,?).
1667		equal_atomic_term(A,B,Res) :- (A==B -> Res=equal ; Res=not_equal).
1668
1669
1670		:- assert_must_succeed(exhaustive_kernel_check( bsets_clp:not_relation_over([(int(1),int(2)),(int(2),int(1))],[int(1),int(2)],[int(2)],_WF) )).
1671		:- assert_must_succeed(exhaustive_kernel_check( bsets_clp:not_relation_over([(int(1),int(2))],[],[int(2)],_WF) )).
1672		:- assert_must_succeed(exhaustive_kernel_fail_check( bsets_clp:not_relation_over([(int(1),pred_true)],[int(1)],[pred_true],_WF) )).
1673		:- assert_must_succeed(exhaustive_kernel_fail_check( bsets_clp:not_relation_over([],[int(1)],[pred_true],_WF) )).
1674		:- assert_must_succeed( bsets_clp:not_relation_over([(int(1),int(2))],[int(3)],[int(1),int(2)],_) ).
1675		:- assert_must_succeed( bsets_clp:not_relation_over([(int(1),int(2))],[int(1)],[int(3)],_) ).
1676		:- assert_must_succeed( bsets_clp:not_relation_over([(int(1),int(3)),(int(1),int(2))],[int(1)],[int(3)],_) ).
1677		:- assert_must_fail( bsets_clp:not_relation_over([(int(1),int(3))],[int(1)],[int(3)],_) ).
1678		:- assert_must_fail( bsets_clp:not_relation_over([],[int(1)],[int(3)],_) ).
1679		:- assert_must_fail( bsets_clp:not_relation_over([],[],[],_) ).
1680		:- block not_relation_over(-,?,?,?).
1681
1682		not_relation_over(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
1683		% we do not need the Range; this means we can match more closures (e.g., lambda)
1684		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,_,WF),!,
1685		not_subset_of_wf(FFDomain,Domain,WF).
1686		not_relation_over(FF,Domain,Range,WF) :- nonvar(FF),
1687		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,_,WF),!,
1688		not_both_subset_of(FFDomain,FFRange,Domain,Range,WF).
1689		/* could be slightly more efficient: but not clear if warrants additional complexity in code:
1690		not_relation_over(FF,Domain,Range,WF) :- nonvar(FF),
1691		check_element_can_be_decided(Domain), % ensures that check_element_of_wf will not block below
1692		check_element_can_be_decided(Range), % ensures that check_element_of_wf will not block below
1693		expand_and_convert_to_avl_set(FF,AER,no_relation_over,''),!,
1694		(is_avl_relation_over_domain(AER,Domain,WF)
1695		-> \+ is_avl_relation_over_range(AER,Range,WF)
1696		; true).
1697		check_element_can_be_decided(X) :- var(X),!,fail.
1698		check_element_can_be_decided(avl_set(_)).
1699		check_element_can_be_decided([]).
1700		check_element_can_be_decided(closure(P,T,B)) :-
1701		custom_explicit_sets:is_interval_closure_or_integerset(closure(P,T,B),Low,Up),
1702		ground(Low), ground(Up).
1703		*/
1704		not_relation_over(R,Dom,Ran,WF) :-
1705		expand_custom_set_to_list_wf(R,ER,_,not_relation_over,WF),
1706		%% print(not_rel(ER,Dom,Ran)),nl,
1707		not_relation_over2(ER,Dom,Ran,WF).
1708
1709
1710		%not_relation_over2(R,_,_) :- when(nonvar(R), (R\=[], R\=[_|_])) . % TYPE ERROR !
1711		:- block not_relation_over2(-,?,?,?).
1712		not_relation_over2([(X,Y)|T],Domain,Range,WF) :-
1713		membership_test_wf(Domain,X,MemRes,WF),
1714		not_relation_over3(MemRes,Y,T,Domain,Range,WF).
1715
1716		:- block not_relation_over3(-,?,?,?,?,?).
1717		not_relation_over3(pred_false,_Y,_T,_Domain,_Range,_WF).
1718		not_relation_over3(pred_true,Y,T,Domain,Range,WF) :-
1719		membership_test_wf(Range,Y,MemRes,WF),
1720		not_relation_over4(MemRes,T,Domain,Range,WF).
1721
1722		:- block not_relation_over4(-,?,?,?,?).
1723		not_relation_over4(pred_false,_T,_Domain,_Range,_WF).
1724		not_relation_over4(pred_true,T,Domain,Range,WF) :-
1725		not_relation_over2(T,Domain,Range,WF).
1726
1727
1728
1729		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf([],[],WF),WF)).
1730		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf([(int(1),int(3))],[int(1)],WF),WF)).
1731		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf(
1732		[(int(0),int(55)),(int(2),int(3)),(int(1),int(3))],[int(1),int(2),int(0)],WF),WF)).
1733		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf(
1734		[(int(99),int(55)),(int(2),int(3)),(int(99),int(4))],[int(2),int(99)],WF),WF)).
1735		:- assert_must_succeed((bsets_clp:domain_wf([],Res,_WF),Res=[])).
1736		:- assert_must_succeed((bsets_clp:domain_wf([(int(1),int(2))],Res,_WF),
1737		kernel_objects:equal_object(Res,[int(1)]))).
1738		:- assert_must_succeed((bsets_clp:domain_wf([(int(1),int(2)),(int(1),int(1))],Res,_WF),
1739		kernel_objects:equal_object(Res,[int(1)]))).
1740		:- assert_must_succeed((bsets_clp:domain_wf([(int(2),int(2)),(int(1),int(2))],Res,_WF),
1741		kernel_objects:equal_object(Res,[int(1),int(2)]))).
1742		:- assert_must_succeed((bsets_clp:domain_wf(X,Res,_WF),kernel_objects:equal_object(Res,[int(1),int(3),int(2)]),
1743		kernel_objects:equal_object(X,[(int(2),int(2)),(int(1),int(1)),(int(3),int(2))]))).
1744		:- assert_must_succeed((bsets_clp:domain_wf(X,Res,_WF),kernel_objects:equal_object(Res,[int(1),int(2)]),
1745		kernel_objects:equal_object(X,[(int(2),int(2)),(int(1),int(1)),(int(1),int(2))]))).
1746		:- assert_must_fail((bsets_clp:domain_wf(X,Res,_WF),kernel_objects:equal_object(Res,[int(1),int(2)]),
1747		kernel_objects:equal_object(X,[(int(2),int(2)),(int(1),int(1)),(int(3),int(2))]))).
1748
1749		:- block domain_wf(-,-,?).
1750		domain_wf(Rel,Res,WF) :- Res == [],!,
1751		empty_set_wf(Rel,WF).
1752		domain_wf(Rel,Res,WF) :- var(Rel),!, % hence Res must me nonvar
1753		(is_custom_explicit_set(Res,domain_wf)
1754		-> expand_custom_set_to_list_wf(Res,Res2,_,propagate_result_to_input2,WF) % avoid expanding twice
1755		; Res2 = Res),
1756		propagate_result_to_input(Res2,Rel,domain,WF),
1757		domain_wf1(Rel,Res2,WF).
1758		domain_wf(Rel,Res,WF) :- domain_wf1(Rel,Res,WF).
1759
1760
1761		% propagate result of domain/range back to original relation
1762		propagate_result_to_input(Result,OriginalRel,DomOrRange,WF) :-
1763		propagate_empty_set_wf(Result,result,OriginalRel,WF), % this will trigger before LWF ground
1764		(preferences:preference(use_smt_mode,true)
1765		-> propagate_result_to_input1(Result,OriginalRel,1,DomOrRange)
1766		% hopefully full CHR implementation will avoid the need for this hack
1767		% ; kernel_objects:is_marked_to_be_computed(OriginalRel) -> true % get_last_wait_flag(propagate_result_to_input,WF,LWF)
1768		;
1769		get_wait_flag(2000,propagate_result_to_input,WF,LWF), % TO DO: determine right value for Priority ?
1770		% higher number for data_validation mode seems slightly counterproductive (on private_source_not_available tests)
1771		propagate_result_to_input1(Result,OriginalRel,LWF,DomOrRange) % this slows down test 289 if not guarded, 1088 if guarded
1772		).
1773
1774		:- block propagate_result_to_input1(-,?,?,?), propagate_result_to_input1(?,-,-,?).
1775		% Note: if arg 2 (Rel) is known we will not propagate
1776		propagate_result_to_input1([],Rel,_,_) :- !, empty_set(Rel).
1777		propagate_result_to_input1(Result,Input,LWF,DomOrRange) :-
1778		(kernel_objects:is_marked_to_be_computed(Input) -> true
1779		; propagate_result_to_input2(Result,Input,LWF,DomOrRange)).
1780
1781		%:- block propagate_result_to_input2(-,?).
1782		:- block propagate_result_to_input2(-,?,?,?), propagate_result_to_input2(?,-,-,?).
1783		% maybe do in CHR in future: x:dom(R) => #z.(x,z) : R
1784		% TO DO: make stronger; also support avl_set ...
1785		propagate_result_to_input2([],_Rel,_,_) :- !. % nothing can be said; we could have repeated entries for previous domain elements
1786		propagate_result_to_input2([D|T],Rel,LWF,DomOrRange) :- %print(propagate_result_to_input2([D|T],Rel,LWF,DomOrRange)),nl,
1787		!,
1788		(Rel == [] -> fail % we would need more relation elements to generate the domain/range
1789		; nonvar(Rel) -> true % no propagation
1790		; (DomOrRange=domain -> Rel = [(D,_)|RT] ; Rel = [(_,D)|RT]),
1791		propagate_result_to_input2(T,RT,LWF,DomOrRange)
1792		).
1793		propagate_result_to_input2(CS,Rel,LWF,DomOrRange) :- var(Rel), is_custom_explicit_set(CS),!,
1794		expand_custom_set_to_list(CS,Res,_,propagate_result_to_input2),
1795		propagate_result_to_input2(Res,Rel,LWF,DomOrRange).
1796		propagate_result_to_input2(_1,_2,_LWF,_DomOrRange).
1797
1798		:- block domain_wf1(-,?,?).
1799		domain_wf1(Rel,Res,WF) :- is_custom_explicit_set(Rel,domain_wf),
1800		domain_of_explicit_set_wf(Rel,Dom,WF), !,
1801		equal_object_wf(Dom,Res,domain_wf1,WF).
1802		domain_wf1(Rel,Res,WF) :-
1803		expand_custom_set_to_list_wf(Rel,Relation,_,domain_wf,WF),
1804		newdomain1(Relation,[],Res,WF),
1805		quick_propagate_domain(Relation,Res,WF).
1806
1807		:- block quick_propagate_domain(-,?,?).
1808		quick_propagate_domain([],_,_WF).
1809		quick_propagate_domain([(X,_)|T],FullRes,WF) :-
1810		quick_propagation_element_information(FullRes,X,WF,FullRes1), % should we use a stronger check ?
1811		quick_propagate_domain(T,FullRes1,WF).
1812
1813		%:- block newdomain1(-,?,-,?). % why was this commented out ?
1814		:- block newdomain1(-,?,?,?).
1815		/* newdomain1(Rel,SoFar,Res,WF) :- var(Rel), !,
1816		domain_propagate_result(Res,Rel,SoFar,WF). */
1817	?	newdomain1(Dom,SoFar,Res,WF) :- newdomain2(Dom,SoFar,Res,WF).
1818
1819		%:- block newdomain2(-,?,?,?).
1820	?	newdomain2([],_SoFar,Res,WF) :- empty_set_wf(Res,WF).
1821		newdomain2([(X,Y)|T],SoFar,Res,WF) :-
1822		(Res==[]
1823		-> MemRes=pred_true, % no new elements can appear, all Xs must already be in SoFar
1824		check_element_of_wf(X,SoFar,WF)
1825		; membership_test_wf(SoFar,X,MemRes,WF),
1826		% now check that card of Relation is greater or equal to Result; if equal set MemRes to pred_false
1827		% if card(Result)=card(dom(Result)) => all elements in Result must be fresh domain elements
1828		card_greater_equal_check([(X,Y)|T],Res,MemRes)
1829		),
1830		newdomain3(MemRes,X,T,SoFar,Res,WF).
1831
1832		:- block newdomain3(-,?,?,?,?,?).
1833		newdomain3(pred_true,_,T,SoFar,Res,WF) :- newdomain1(T,SoFar,Res,WF).
1834		newdomain3(pred_false,X,T,SoFar,Res,WF) :-
1835		kernel_objects:mark_as_non_free(X,domain), % X is linked to a particular Y -> it is not free
1836		add_element_wf(X,SoFar,SoFar2,WF),
1837		equal_cons_wf(Res,X,Res2,WF),
1838		newdomain1(T,SoFar2,Res2,WF).
1839
1840
1841		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_domain_wf(int(2),[(int(2),int(7))],WF),WF)).
1842		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_domain_wf(int(2),[(int(1),int(6)),(int(2),int(7))],WF),WF)). % used to be wfdet; but dom_symbolic can create existential quantifier, not all co-routines/... evaluated in wfdet
1843		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_domain_wf(int(22),[(int(1),int(6)),(int(22),int(7)),(int(33),int(7))],WF),WF)). % used to be wfdet (see above)
1844		:- assert_must_succeed((bsets_clp:in_domain_wf(int(1),[(int(1),int(2))],_))).
1845		:- assert_must_succeed((bsets_clp:in_domain_wf(int(3),[(int(1),int(2)),(int(3),int(4))],_))).
1846		:- assert_must_fail((bsets_clp:in_domain_wf(int(3),[],_))).
1847		:- assert_must_fail((bsets_clp:in_domain_wf(int(3),[(int(1),int(2))],_))).
1848		/* a more efficient version than using element_of and computing domain */
1849
1850		% just like not_empty_set_wf but instantiates with (El,_) as first element
1851		in_domain_wf(El,S,WF) :- var(S),!, force_in_domain_wf(El,S,WF).
1852	?	in_domain_wf(El,Rel,WF) :- in_domain_wf_lazy(El,Rel,WF).
1853
1854		:- use_module(kernel_non_empty_attr,[mark_var_set_as_non_empty/1]).
1855		% next is also used in apply_to/6
1856		force_in_domain_wf(El,S,WF) :-
1857		(preferences:preference(use_smt_mode,true) -> get_wait_flag0(WF,WF0),
1858		when(ground(WF0),delayed_force_in_domain_wf(El,S,WF))
1859		; % TO DO: non-empty flag
1860		mark_var_set_as_non_empty(S),
1861		get_enumeration_starting_wait_flag(not_empty_domain_wf,WF,LWF), in_domain_lwf(El,S,LWF,WF)).
1862		% delay instantiating S somewhat: it can mess up many other optimisations
1863		% fixes trying to deconstruct infinite set enum warning for test 2022
1864		delayed_force_in_domain_wf(El,S,_WF) :- var(S),!, S=[(El,_)|_]. % TODO: mark _ as irrelevant
1865		delayed_force_in_domain_wf(El,Rel,WF) :- in_domain_wf_lazy(El,Rel,WF).
1866
1867		:- block in_domain_lwf(-,-,-,?).
1868		% was :- block in_domain_lwf(-,?,-,?). but this prevents instantiating El in case Rel becomes known ! see e.g. private_examples/ClearSy/ComparePv10Pv11/DebugPv10/ test 1952, 2270
1869		%:- block in_domain_lwf(-,-,?,?),in_domain_lwf(?,-,-,?). % this annotation fails test 1703
1870		in_domain_lwf(El,Rel,LWF,WF) :- % tools_printing:print_term_summary(in_domain_lwf(El,Rel,LWF)),
1871		(var(Rel) -> ground_value_check(El,GrVal),
1872		in_domain_lwf2(El,Rel,LWF,GrVal,WF) % we could also wait at least until WF0 is fully grounded?
1873		; not_empty_set_unless_closure_wf(Rel,WF),
1874		in_domain_wf_lazy(El,Rel,WF)).
1875
1876		:- block in_domain_lwf2(?,-,-,-,?).
1877		in_domain_lwf2(El,Rel,_LWF,_Grval,WF) :- % tools_printing:print_term_summary(in_domain_lwf2(El,Rel,_LWF,_Grval)),
1878		(var(Rel) -> Rel = [(El,_)|_]
1879		% can create a choice point when unifying with large avl_set:, see rule_Rule_DB_PSR_0003_C
1880		% maybe we should delay even further
1881		; not_empty_set_unless_closure_wf(Rel,WF),
1882		in_domain_wf_lazy(El,Rel,WF)).
1883
1884		not_empty_set_unless_closure_wf(closure(_,_,_),_) :- !. % do not check this; in_domain_wf or other call will find a solution anyway; no need to set up closure constraints twice
1885		not_empty_set_unless_closure_wf(Rel,WF) :- not_empty_set_wf(Rel,WF).
1886
1887		% does not instantiate to [(El,_)|_]
1888		:- block in_domain_wf_lazy(?,-,?).
1889		in_domain_wf_lazy(_DomainElement,[],_WF) :- !,fail.
1890		in_domain_wf_lazy(DomainElement,avl_set(A),WF) :-
1891		ground_value(DomainElement), !,
1892		check_in_domain_of_avlset_wf(DomainElement,A,WF).
1893		% TO DO: check for infinite closures
1894		in_domain_wf_lazy(DomainElement,ES,WF) :-
1895		is_custom_explicit_set(ES,in_domain_wf_lazy),
1896		domain_of_explicit_set_wf(ES,Dom,WF),!,
1897	?	check_element_of_wf(DomainElement,Dom,WF).
1898		in_domain_wf_lazy(El,Rel,WF) :-
1899		expand_custom_set_to_list_wf(Rel,Relation,Done,in_domain_wf_lazy,WF),
1900		get_binary_choice_wait_flag(in_domain_wf_lazy(El),WF,LWF), % TO DO: get_pow2_binary_choice_priority(Len,Prio), get_binary_choice_wait_flag_exp_backoff
1901		% if Done == true -> we can use maybe clpfd_inlist or clpfd:element or quick_propagate
1902		quick_propagation_domain_element_list(Done,Relation,El,WF),
1903		in_domain2(El,Relation,WF,LWF).
1904
1905		% a custom implementation of quick_propagation_element_information for checking domain elements and lists only
1906		:- use_module(clpfd_lists,[try_in_fd_value_list_check/4]).
1907		:- block quick_propagation_domain_element_list(-,?,?,?).
1908		quick_propagation_domain_element_list(_,_,_,_) :- preferences:preference(use_clpfd_solver,false),!.
1909		quick_propagation_domain_element_list(_,_,El,_) :- ground(El),!.
1910		quick_propagation_domain_element_list(_,RelList,El,WF) :-
1911		try_in_fd_value_list_check(RelList,(El,_),couple_left(_),WF). % use couple_left to ignore range values
1912
1913
1914		:- block in_domain2(?,-,?,?).
1915		in_domain2(El,[(X,_Y)|T],WF,LWF) :-
1916		(T==[]
1917		-> equal_object_wf(El,X,in_domain2,WF)
1918		; kernel_objects:equality_objects_lwf(El,X,EqRes,LWF,WF),
1919		in_domain3(EqRes,El,T,WF,LWF)
1920		).
1921
1922		:- block in_domain3(-,?,?,?,?).
1923		in_domain3(pred_true,_El,_T,_WF,_LWF).
1924		in_domain3(pred_false,El,T,WF,LWF) :-
1925		get_new_subsidiary_wait_flag(LWF,in_domain2(El,T),WF,NewLWF), % not necessary if T only has single element
1926		in_domain2(El,T,WF,NewLWF).
1927
1928
1929		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_domain_wf(int(3),[],WF),WF)).
1930		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_domain_wf(int(3),[(int(2),int(7))],WF),WF)).
1931		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_domain_wf(int(3),[(int(2),int(7)),(int(4),int(3))],WF),WF)).
1932		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_in_domain_wf(int(4),[(int(2),int(7)),(int(4),int(3))],WF),WF)).
1933		:- assert_must_fail((bsets_clp:not_in_domain_wf(int(1),[(int(1),int(2))],_))).
1934		:- assert_must_fail((bsets_clp:not_in_domain_wf(int(3),[(int(1),int(2)),(int(3),int(4))],_))).
1935		:- assert_must_succeed((bsets_clp:not_in_domain_wf(int(3),[],_))).
1936		:- assert_must_succeed((bsets_clp:not_in_domain_wf(int(3),[(int(1),int(2))],_))).
1937		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_domain_wf(int(3),[(int(1),int(2)),(int(2),int(3))],WF),WF)).
1938		/* a more efficient version than using not_element_of and computing domain */
1939
1940
1941		:- block not_in_domain_wf(?,-,?).
1942		not_in_domain_wf(DomainElement,ES,WF) :- is_custom_explicit_set(ES,not_in_domain),
1943		domain_of_explicit_set_wf(ES,Dom,WF),!,
1944		not_element_of_wf(DomainElement,Dom,WF).
1945		not_in_domain_wf(El,Rel,WF) :-
1946		expand_custom_set_to_list_wf(Rel,Relation,_,not_in_domain,WF),
1947		not_in_domain2(Relation,El,WF).
1948		:- block not_in_domain2(-,?,?).
1949		not_in_domain2([],_,_WF).
1950		not_in_domain2([(X,_Y)|T],E,WF) :- not_equal_object_wf(E,X,WF), not_in_domain2(T,E,WF).
1951
1952
1953
1954
1955		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:range_wf([],[],WF),WF)).
1956		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:range_wf([(int(1),int(3))],[int(3)],WF),WF)).
1957		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:range_wf(
1958		[(int(0),int(55)),(int(2),int(3)),(int(1),int(3))],[int(3),int(55)],WF),WF)).
1959		:- assert_must_succeed((bsets_clp:range_wf([],Res,_WF),Res=[])).
1960		:- assert_must_succeed((bsets_clp:range_wf([(int(1),int(2))],Res,_WF),
1961		kernel_objects:equal_object(Res,[int(2)]))).
1962		:- assert_must_succeed((bsets_clp:range_wf([(int(1),int(1)),(int(2),int(1))],Res,_WF),
1963		kernel_objects:equal_object(Res,[int(1)]))).
1964		:- assert_must_succeed((bsets_clp:range_wf([(int(1),int(2)),(int(1),int(1))],Res,_WF),
1965		kernel_objects:equal_object(Res,[int(1),int(2)]))).
1966		:- assert_must_succeed((bsets_clp:range_wf([(int(1),int(2)),(int(1),int(1)),(int(2),int(3))],Res,_WF),
1967		kernel_objects:equal_object(Res,[int(1),int(3),int(2)]))).
1968		:- assert_must_succeed((bsets_clp:range_wf(X,Res,_WF),
1969		X = [(int(1),int(2)),(int(1),int(1)),(int(2),int(3))],
1970		kernel_objects:equal_object(Res,[int(1),int(3),int(2)]))).
1971		:- assert_must_succeed((bsets_clp:range_wf(X,Res,WF), bsets_clp:domain_wf(X,Res2,WF), kernel_objects:equal_object(Res,Res2),
1972		X = [(int(1),int(2)),(int(1),int(1)),(int(2),int(2))])).
1973		:- assert_must_succeed((bsets_clp:range_wf(X,Res,WF), bsets_clp:domain_wf(X,Res2,WF), kernel_objects:equal_object(Res,Res2),
1974		X = [(int(2),int(1)),(int(1),int(2)),(int(2),int(2))])).
1975		:- assert_must_succeed((bsets_clp:range_wf(X,Res,WF), bsets_clp:domain_wf(X,Res2,WF), kernel_objects:equal_object(Res,Res2),
1976		X = [])).
1977		:- assert_must_succeed((bsets_clp:range_wf([([],[]),([int(0)],[int(0)]),
1978		([int(0),int(1)],[int(0),int(1)]),([int(0),int(2)],[int(0),int(2)]),
1979		([int(0),int(3)],[int(0),int(3)]),([int(0),int(4)],[int(0),int(4)]),([int(1)],[int(1)]),
1980		([int(1),int(2)],[int(1),int(2)]),([int(1),int(3)],[int(1),int(3)]),
1981		([int(1),int(4)],[int(1),int(4)]),([int(2)],[int(2)]),([int(2),int(3)],[int(2),int(3)]),
1982		([int(2),int(4)],[int(2),int(4)]),([int(3)],[int(3)]),([int(3),int(4)],
1983		[int(3),int(4)]),([int(4)],[int(4)])],_Res,_WF))).
1984		:- assert_must_succeed((bsets_clp:range_wf([([],[]),([int(0)],[int(0)]),
1985		([int(0),int(1)],[int(0),int(1)]),
1986		([int(0),int(3)],[int(0),int(3)]),([int(0),int(4)],[int(0),int(4)]),([int(1)],[int(1)]),
1987		([int(1),int(2)],[int(1),int(2)])],_Res,_WF))).
1988
1989
1990		:- block range_wf(-,-,?).
1991		range_wf(Rel,Res,WF) :- Res ==[],!, empty_set_wf(Rel,WF).
1992		range_wf(Rel,Res,WF) :- Rel ==[],!, empty_set_wf(Res,WF).
1993		range_wf(Rel,Res,WF) :- range_wf1(Rel,Res,WF),
1994		propagate_result_to_input(Res,Rel,range,WF).
1995
1996		:- block range_wf1(-,?,?).
1997		range_wf1(Rel,Res,WF) :-
1998		is_custom_explicit_set(Rel,range_wf1),
1999		range_of_explicit_set_wf(Rel,Range,WF), !,
2000	?	equal_object_wf(Range,Res,range_wf1,WF).
2001		range_wf1(Rel,Res,WF) :-
2002		% TO DO : propagate information that card of Res <= card of Rel; similar thing for domain
2003		expand_custom_set_to_list_wf(Rel,Relation,_,range_wf1,WF),
2004		newrange2(Relation,[],Res,WF),
2005		quick_propagate_range(Relation,Res,WF).
2006
2007
2008		:- block quick_propagate_range(-,?,?).
2009		quick_propagate_range([],_,_WF).
2010		quick_propagate_range([(_,Y)|T],FullRes,WF) :-
2011		quick_propagation_element_information(FullRes,Y,WF,FullRes1), % should we use a stronger check ?
2012		quick_propagate_range(T,FullRes1,WF).
2013
2014		:- block newrange2(-,?,?,?).
2015		newrange2([],_SoFar,Res,WF) :-
2016	?	empty_set_wf(Res,WF).
2017		newrange2([(X,Y)|T],SoFar,Res,WF) :-
2018		(Res==[]
2019		-> MemRes=pred_true, check_element_of_wf(Y,SoFar,WF)
2020		; membership_test_wf(SoFar,Y,MemRes,WF),
2021		card_greater_equal_check([(X,Y)|T],Res,MemRes), % check that card of Relation is greater or equal to Result; if equal set MemRes to pred_false
2022		(var(MemRes) -> prop_empty_pred_true(Res,MemRes) %,print(delay_range(Y,T)),nl
2023		% TO DO: we could look further in T if we can decide membership for other elements in T ?
2024		; true)
2025		),
2026		newrange3(MemRes,Y,T,SoFar,Res,WF).
2027
2028		:- block prop_empty_pred_true(-,?).
2029		prop_empty_pred_true([],R) :- !, R=pred_true.
2030		prop_empty_pred_true(_,_).
2031
2032		% card_greater_equal_check(Set1,Set2,EqFlag) : check that cardinality of Set1 is greater or equal to that of Set2; set EqFlag to pred_false if they are equal
2033		% checking is stopped if EqFlag becomes nonvar
2034		% tested by testcase 1061
2035		:- block card_greater_equal_check(-,?,-), card_greater_equal_check(?,-,-).
2036		card_greater_equal_check(_,_,Flag) :- nonvar(Flag),!. % no longer required; even though we could prune failure !? done later in newrange2/newdomain2 ??!!
2037		card_greater_equal_check([],Set2,Flag) :- !,empty_set(Set2),
2038		Flag=pred_false. % Flag set indicates that both sets have same size
2039		card_greater_equal_check(_,[],_) :- !.
2040		card_greater_equal_check([_|T],[_|R],Flag) :- !, card_greater_equal_check(T,R,Flag).
2041		% To do: deal with AVL args as Result + also use efficient_card_for_set for closures
2042		%card_greater_equal_check([_|T],Set,Flag) :- efficient_card_for_set(B,CardB,CodeB),!,
2043		% f: 1..7 -->> 1..n & n>=7 & n<10 still does not work well
2044		% TO DO: can we merge code with check_card_greater_equal
2045		card_greater_equal_check(_,_,_).
2046
2047
2048		:- block newrange3(-,?,?,?,?,?).
2049	?	newrange3(pred_true,_Y,T,SoFar,Res,WF) :- newrange2(T,SoFar,Res,WF).
2050		newrange3(pred_false,Y,T,SoFar,Res,WF) :-
2051		kernel_objects:mark_as_non_free(Y,range), % Y is linked to a particular X -> it is not free
2052		add_element_wf(Y,SoFar,SoFar2,WF),
2053	?	equal_cons_wf(Res,Y,Res2,WF),
2054	?	newrange2(T,SoFar2,Res2,WF).
2055
2056
2057		:- assert_must_succeed((bsets_clp:identity_relation_over_wf([],Res,_WF),Res=[])).
2058		:- assert_must_succeed((bsets_clp:identity_relation_over_wf([int(1),int(2)],Res,_WF),
2059		Res=[(int(1),int(1)),(int(2),int(2))])).
2060		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:identity_relation_over_wf([int(2),int(4)],[(int(4),int(4)),(int(2),int(2))],WF),WF)).
2061		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:identity_relation_over_wf([int(1),int(2),int(4)],[(int(4),int(4)),(int(2),int(2)),(int(1),int(1))],WF),WF)).
2062		:- assert_must_fail((bsets_clp:identity_relation_over_wf([int(1)|_],_,_WF),fail)). /* check: no loop */
2063
2064		:- block identity_relation_over_wf(-,?,?).
2065		identity_relation_over_wf(Set1,IDRel,WF) :-
2066		expand_custom_set_to_list_wf(Set1,ESet1,_,identity_relation_over_wf,WF),
2067		identity_relation_over2(ESet1,IDRel,WF).
2068
2069		:- block identity_relation_over2(-,?,?).
2070		identity_relation_over2([],Res,WF) :- empty_set_wf(Res,WF).
2071		identity_relation_over2([X|T1],Res,WF) :- equal_cons_wf(Res,(X,X),T2,WF), % equal_object([(X,X)|T2],Res),
2072		identity_relation_over2(T1,T2,WF).
2073
2074
2075
2076		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_identity((int(1),int(1)),[int(1),int(2)],WF),WF)).
2077		:- assert_must_fail((bsets_clp:in_identity((int(1),int(2)),[int(1),int(2)],_WF))).
2078		:- assert_must_fail((bsets_clp:in_identity((int(3),int(3)),[int(1),int(2)],_WF))).
2079		:- assert_must_fail((bsets_clp:in_identity((int(1),int(2)),[],_WF))).
2080		in_identity((X,Y),Domain,WF) :-
2081	?	equal_object_wf(X,Y,in_identity,WF), check_element_of_wf(X,Domain,WF).
2082
2083		:- assert_must_fail((bsets_clp:not_in_identity((int(1),int(1)),[int(1),int(2)],_WF))).
2084		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_identity((int(1),int(2)),[int(1),int(2)],WF),WF)).
2085		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_identity((int(3),int(3)),[int(1),int(2)],WF),WF)).
2086		:- assert_must_succeed((bsets_clp:not_in_identity((int(1),int(2)),[],_WF))).
2087		not_in_identity((X,Y),Domain,WF) :-
2088		equality_objects_wf(X,Y,Eq,WF),
2089		not_in_id2(Eq,X,Domain,WF).
2090
2091		:- block not_in_id2(-,?,?,?).
2092		not_in_id2(pred_true,X,Domain,WF) :- not_element_of_wf(X,Domain,WF).
2093		not_in_id2(pred_false,_,_,_).
2094
2095
2096		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:invert_relation_wf([(int(1),int(2)),(int(3),int(4)),(int(5),int(6))], [(int(6),int(5)),(int(2),int(1)),(int(4),int(3))],WF),WF)).
2097		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:invert_relation_wf([(int(1),int(2))], [(int(2),int(1))],WF),WF)).
2098		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:invert_relation_wf([], [],WF),WF)).
2099		:- assert_must_succeed((bsets_clp:invert_relation_wf(X,X,_),X = [])).
2100		:- assert_must_succeed((bsets_clp:invert_relation_wf(X,X,_),X = [(int(2),int(2))])).
2101		:- assert_must_succeed((bsets_clp:invert_relation_wf(X,[(int(1),int(2)),(int(7),int(6))],_WF),
2102		X = [(int(2),int(1)),(int(6),int(7))])).
2103		:- assert_must_succeed((bsets_clp:invert_relation_wf([(int(1),int(2)),(int(7),int(6))],X,_WF),
2104		X = [(int(2),int(1)),(int(6),int(7))])).
2105		:- assert_must_succeed((bsets_clp:invert_relation_wf([(int(1),int(2)),(int(7),int(6))],
2106		[(int(6),int(7)),(int(2),int(1))],_WF))).
2107		:- assert_must_succeed((bsets_clp:invert_relation_wf(closure([a,b],[string,boolean],b(truth,pred,[])),
2108		closure([b,a],[boolean,string],b(truth,pred,[])),_WF))).
2109
2110		:- block invert_relation_wf(-,-,?).
2111		invert_relation_wf(R,IR,WF) :-
2112		% (nonvar(R) -> invert_relation2(R,IR) ; invert_relation2(IR,R)).
2113		invert_relation2(R,IR,WF). % , print_term_summary(invert_relation(R,IR)).
2114		/* Optimization for some types of closures: Instead of expanding the closures, we just
2115		swap the parameters. This does not work with closures wich have only one parameter
2116		wich is a pair */
2117		invert_relation2(CS,R,WF) :- nonvar(CS),is_custom_explicit_set_nonvar(CS),!,
2118		invert_explicit_set(CS,ICS), equal_object_wf(R,ICS,invert_relation2_1,WF).
2119		invert_relation2(R,CS,WF) :- nonvar(CS),is_custom_explicit_set_nonvar(CS),!,
2120		invert_explicit_set(CS,ICS), equal_object_wf(R,ICS,invert_relation2_2,WF).
2121		%invert_relation2(closure([P1,P2],[T1,T2],Clo),closure([P2,P1],[T2,T1],Clo)) :- !.
2122		invert_relation2(R,IR,WF) :- %try_expand_custom_set_wf(R,ER,invert,WF),
2123		% (nonvar(R) -> invert_relation3(R,IR)
2124		% ; invert_relation3(IR,R),(ground(IR)-> true ; invert_relation3(R,IR))).
2125		invert_relation3(R,IR,WF,1), invert_relation3(IR,R,WF,1).
2126
2127		:- block invert_relation3(-,?,?,?).
2128		invert_relation3(closure(P,T,B),Res,WF,_) :- invert_explicit_set(closure(P,T,B),ICS),
2129		equal_object_wf(Res,ICS,invert_relation3_1,WF).
2130		invert_relation3(avl_set(S),Res,WF,_) :- invert_explicit_set(avl_set(S),ICS),
2131		equal_object_wf(Res,ICS,invert_relation3_2,WF).
2132	?	invert_relation3([],Res,WF,_) :- empty_set_wf(Res,WF).
2133		invert_relation3([(X,Y)|T],Res,WF,Depth) :-
2134		D1 is Depth+1, get_wait_flag(D1,invert_relation3,WF,LWF),
2135		equal_cons_lwf(Res,(Y,X),IT,LWF,WF),
2136		invert_relation3(T,IT,WF,D1).
2137
2138
2139
2140
2141		tuple_of(X,Y,R) :- check_element_of((X,Y),R).
2142		%tuple_of_wf(X,Y,R,WF) :- check_element_of_wf((X,Y),R,WF).
2143
2144
2145		% RELATIONAL COMPOSITION (;)
2146
2147		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_composition_wf((int(11),int(22)),
2148		[(int(11),int(33))],[(int(33),int(22))],WF),WF)).
2149		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_composition_wf((int(11),int(22)),
2150		[(int(11),int(12)),(int(11),int(33))],
2151		[(int(33),int(12)),(int(33),int(22))],WF),WF)).
2152		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_composition_wf((int(11),int(12)),
2153		[(int(11),int(12)),(int(11),int(33))],
2154		[(int(33),int(12)),(int(33),int(22))],WF),WF)).
2155		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_composition_wf((int(11),int(22)),
2156		[(int(11),[int(33),int(32)])],
2157		[([int(32),int(33)],int(22))],WF),WF)).
2158		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:in_composition_wf((int(11),int(33)),
2159		[(int(11),int(12)),(int(11),int(33))],
2160		[(int(33),int(12)),(int(33),int(22))],WF),WF)).
2161		% check if (X,Y) element of (F ; G)
2162		in_composition_wf((X,Y),F,G,WF) :-
2163		check_element_of_wf((X,Z1),F,WF), % no need to enumerate Z (TODO: check)
2164		equal_object_wf(Z1,Z2,check_element_of_wf,WF),
2165		check_element_of_wf((Z2,Y),G,WF).
2166
2167		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_composition_wf((int(11),int(33)),
2168		[(int(11),int(33))],[(int(33),int(22))],WF),WF)).
2169		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_composition_wf((int(33),int(22)),
2170		[(int(11),int(33))],[(int(33),int(22))],WF),WF)).
2171
2172		% just evaluates arguments; TODO: improve or at least pass Type (for symbolic composition)
2173		not_in_composition_wf(Couple,F,G,WF) :-
2174		rel_composition_wf(F,G,Comp,_UnknownType,WF),
2175		not_element_of_wf(Couple,Comp,WF).
2176
2177		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_composition([(int(1),int(2)),(int(3),int(4)),(int(5),int(6))], [(int(6),int(7)),(int(2),int(1)),(int(22),int(22)),(int(4),int(33))],
2178		[(int(1),int(1)),(int(5),int(7)),(int(3),int(33))]))).
2179		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_composition([], [(int(6),int(7)),(int(2),int(1)),(int(22),int(22)),(int(4),int(33))],[]))).
2180		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_composition([(int(6),int(7)),(int(2),int(1)),(int(22),int(22)),(int(4),int(33))],[],[]))).
2181		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_composition([],[],[]))).
2182		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(6))],
2183		[(int(1),int(11))],X),X = [])).
2184		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(6))],[],X),X = [])).
2185		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(6))],
2186		[(int(2),int(11))],X),
2187		kernel_objects:equal_object(X,[(int(1),int(11))]))).
2188		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(2))],[(int(2),int(11))],X),
2189		ground(X), bsets_clp:equal_object(X,[(int(1),int(11)),(int(7),int(11))]))).
2190		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(5))],
2191		[(int(2),int(11)),(int(2),int(4))],X),
2192		kernel_objects:equal_object(X,[(int(1),int(11)),(int(1),int(4))]))).
2193		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(1),int(5))],
2194		[(int(2),int(11)),(int(5),int(11))],X),
2195		kernel_objects:equal_object(X,[(int(1),int(11))]))).
2196		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),[int(1)]),(int(1),[int(2),int(5)])],
2197		[([int(1),int(2)],int(13)),([int(5),int(2)],int(12))],X),
2198		kernel_objects:equal_object(X,[(int(1),int(12))]))).
2199
2200		rel_composition(Rel1,Rel2,Comp) :- % only used in unit_tests above
2201		init_wait_flags(WF,[rel_composition]),
2202		rel_composition_wf(Rel1,Rel2,Comp,_UnknownType,WF),
2203		ground_wait_flags(WF).
2204
2205		:- block rel_composition_wf(-,-,?,?,?).
2206		rel_composition_wf(Rel1,Rel2,Comp,_,WF) :-
2207		(Rel1==[] ; Rel2==[]),
2208		!,
2209		empty_set_wf(Comp,WF).
2210		rel_composition_wf(Rel1,Rel2,Comp,Type,WF) :-
2211		opt_push_wait_flag_call_stack_info(WF,b_operator_call(composition,[Rel1,Rel2],unknown),WF2),
2212		rel_composition1(Rel1,Rel2,Comp,Type,WF2).
2213
2214		:- use_module(closures,[is_infinite_non_injective_closure/1]).
2215
2216		:- block rel_composition1(-,?,?,?,?),rel_composition1(?,-,?,?,?).
2217		rel_composition1(Rel1,Rel2,Comp,_,WF) :-
2218		(Rel1==[] ; Rel2==[]),!, empty_set_wf(Comp,WF).
2219		rel_composition1(Rel1,Rel2,Comp,Type,WF) :- keep_symbolic(Rel1),
2220		(Rel2 = avl_set(_), \+ is_infinite_non_injective_closure(Rel1)
2221		-> SYMBOLIC=false
2222		; SYMBOLIC=symbolic),
2223		symbolic_composition(Rel1,Rel2,SYMBOLIC,Type,Rel3),
2224		!,
2225		equal_object_wf(Comp,Rel3,rel_composition1_0,WF).
2226		rel_composition1(Rel1,Rel2,Comp,_,WF) :-
2227		rel_composition_for_explicit_set(Rel1,Rel2,Res),!, % treats finite Rel1 and avl_set for Rel2
2228		equal_object_wf(Res,Comp,rel_composition1_1,WF).
2229		rel_composition1(Rel1,Rel2,Comp,Type,WF) :- Rel2=closure(_,_,_),
2230		keep_symbolic(Rel2),
2231		% we know keep_symbolic(Rel1) is false
2232		(dom_for_specific_closure(Rel2,Domain,function(_),WF) % TO DO: also deal with relations; in SYMBOLIC mode this may be counter productive; see function_composition ast cleanup rule
2233		-> !,
2234		on_enumeration_warning(expand_custom_set_to_list_wf(Rel1,Relation1,_,rel_composition1,WF),R=failed),
2235		(R==failed % expansion of Rel1 failed; use symbolic composition
2236		-> symbolic_composition(Rel1,Rel2,true,Type,Rel3),
2237		equal_object_optimized(Rel3,Comp,rel_composition1_4)
2238		; rel_compose_with_inf_fun(Relation1,Domain,Rel2,Comp,WF)
2239		% this is like map Rel2 over Rel1 in functional programmming
2240		)
2241		; symbolic_composition(Rel1,Rel2,false,Type,Rel3),
2242		!,
2243		expand_custom_set_wf(Rel3,CRes,rel_composition,WF),% do we need to expand ?
2244		equal_object_optimized(CRes,Comp,rel_composition1_4)
2245		).
2246		rel_composition1(Rel1,Rel2,Comp,_,WF) :-
2247		expand_custom_set_to_list_wf(Rel1,Relation1,_,rel_composition1_2,WF),
2248		expand_custom_set_to_list_wf(Rel2,Relation2,_,rel_composition1_3,WF),
2249		rel_compose2(Relation1,Relation2,Comp,WF).
2250
2251
2252		:- use_module(btypechecker, [l_unify_types_strict/2]).
2253		symbolic_composition(Rel1,Rel2,SYMBOLIC,Type,Rel3) :-
2254		get_set_type(Type,couple(TX,TZ)),
2255		mnf_get_relation_types(Rel1,TX1,TY1),
2256		mnf_get_relation_types(Rel2,TY2,TZ2),
2257		(l_unify_types_strict([TX1,TY1,TZ],[TX,TY2,TZ2]) -> true
2258		; add_internal_error('Could not unify range/domain types: ',l_unify_types_strict([TX1,TY1,TZ],[TX,TY2,TZ2])),
2259		fail
2260		),
2261		ground((TX1,TY1,TZ)), % avoid creating a closure with non-ground type list
2262		rel_comp_closure(Rel1,Rel2,TX1,TY1,TZ,SYMBOLIC,Rel3).
2263		% generate a closure for {xx,zz | #(yy).(xx|->yy : Rel1 & yy|->zz : Rel2)}
2264		% TO DO: maybe detect special cases: Rel1 is a function/cartesian product, e.g., (((0 .. 76) * (0 .. 76)) * {FALSE}) ; {(FALSE|->0),(TRUE|->1)}
2265		:- use_module(bsyntaxtree, [conjunct_predicates_with_pos_info/3,update_used_ids/3 ]).
2266		rel_comp_closure(Rel1,Rel2,TX,TY,TZ,SYMBOLIC,closure(Args,Types,CBody)) :-
2267		Args = ['_rel_comp1','_rel_comp2'], Types = [TX,TZ],
2268		couple_member_pred('_rel_comp1',TX,'_zzzz_unary',TY,Rel1, Pred1),
2269		couple_member_pred('_zzzz_unary',TY,'_rel_comp2',TZ,Rel2, Pred2),
2270		UsedIds = ['_rel_comp1','_rel_comp2','_zzzz_unary'], % avoid having to call find_identifier_uses
2271		%conjunct_predicates([Pred1,Pred2],P12a), bsyntaxtree:check_computed_used_ids(P12a,UsedIds),
2272		%safe_create_texpr(conjunct(Pred1,Pred2),pred,[used_ids(UsedIds)],P12),
2273		conjunct_predicates_with_pos_info(Pred1,Pred2,P12a),
2274		update_used_ids(P12a,UsedIds,P12),
2275		%b_interpreter_components:create_unsimplified_exists([b(identifier('_zzzz_unary'),TY,[])],P12,Body),
2276		bsyntaxtree:create_exists_opt_liftable([b(identifier('_zzzz_unary'),TY,[])],P12,Body), % cf Thales_All/rule_zcpa2 test 2287
2277		(SYMBOLIC==symbolic
2278		-> mark_bexpr_as_symbolic(Body,CBody)
2279		; CBody=Body).
2280
2281		% generate predicate for X|->Y : Rel
2282		couple_member_pred(X,TX,Y,TY,Rel, Pred) :-
2283		Pred = b(member(b(couple(b(identifier(X),TX,[]),
2284		b(identifier(Y),TY,[])),couple(TX,TY),[]),
2285		b(value(Rel),set(couple(TX,TY)),[])),pred,[]).
2286
2287
2288
2289		:- block rel_compose2(-,?,?,?).
2290		rel_compose2([],_,Out,WF) :- empty_set_wf(Out,WF).
2291		rel_compose2([(X,Y)|T],Rel2,Out,WF) :-
2292		rel_extract(Rel2,X,Y,OutXY,[],WF),
2293		% rel_extract(Rel2,X,Y,Out,OutRem),
2294		rel_compose2(T,Rel2,OutRem,WF),
2295		union_wf(OutRem,OutXY,Out,WF). % used to call union wihout wf; makes test 1394 fail
2296
2297		:- block rel_extract(-,?,?,?,?,?).
2298		rel_extract([],_,_,Rem,Rem,_WF). % should we use equal_object here ?????
2299		rel_extract([(Y1,Z)|T],X,Y,Res,Rem,WF) :-
2300		rel_extract(T,X,Y,CT,Rem,WF),
2301		equality_objects_wf(Y1,Y,EqRes,WF),
2302		rel_extract2(EqRes,Z,X,CT,Res).
2303
2304		:- block rel_extract2(-,?,?,?,?).
2305	?	rel_extract2(pred_true, Z, X,CT,Res) :- add_element((X,Z),CT,Res).
2306		rel_extract2(pred_false,_Z,_X,CT,Res) :- Res = CT.
2307
2308
2309		% relational composition of a finite relation with an infinite or symbolic function
2310		rel_compose_with_inf_fun(R,Dom,Fun,CompRes,WF) :- !,
2311		rel_compose_with_inf_fun_acc(R,Dom,Fun,[],CompRes,WF).
2312		:- block rel_compose_with_inf_fun_acc(-,?,?,?,?,?).
2313		rel_compose_with_inf_fun_acc([],_Dom,_Rel2,Acc,Comp,WF) :-
2314		equal_object_wf(Comp,Acc,rel_compose_with_inf_fun_acc,WF).
2315		rel_compose_with_inf_fun_acc([(X,Y)|T],Dom,Fun,Acc,CompRes,WF) :-
2316		membership_test_wf(Dom,Y,MemRes,WF), % check if Y is in the domain of the symbolic relation
2317		rel_compose_with_inf_fun_acc_aux(MemRes,X,Y,T,Dom,Fun,Acc,CompRes,WF).
2318
2319		:- block rel_compose_with_inf_fun_acc_aux(-,?,?,?, ?,?,?,?, ?).
2320		rel_compose_with_inf_fun_acc_aux(pred_true,X,Y,T,Dom,Fun,Acc,CompRes,WF) :-
2321		apply_to(Fun,Y,FY,WF), % TO DO: generalize to image so that we can apply it also to infinite relations ?
2322		add_element_wf((X,FY),Acc,NewAcc,WF),
2323		rel_compose_with_inf_fun_acc(T,Dom,Fun,NewAcc,CompRes,WF).
2324		rel_compose_with_inf_fun_acc_aux(pred_false,_X,_Y,T,Dom,Fun,Acc,Comp,WF) :-
2325		rel_compose_with_inf_fun_acc(T,Dom,Fun,Acc,Comp,WF).
2326
2327		% TO DO: if we obtain a list such as [(int(1),X),...] in Acc rather than an avl_set,
2328		% we may still be able to sort and avoid quadratic comparisons if e.g.
2329		% first component is a data-type where equality can be decided by unification (integer, bool, global(GS), ...)
2330		% we could put the optimisation into add_element_wf ?
2331		% TO DO: special version for avl_set as relation?
2332
2333		/*
2334		Note: old version; has performance problem, 2021/02_Feb/CDS
2335		the add_element_wf calls below can only construct/instantiate result when empty_set_wf reached
2336		and a lot of pending co-routines pile up for long relation lists
2337
2338		:- block rel_compose_with_inf_fun(-,?,?,?,?).
2339		rel_compose_with_inf_fun([],_Dom,_Rel2,Comp,WF) :- empty_set_wf(Comp,WF).
2340		rel_compose_with_inf_fun([(X,Y)|T],Dom,Fun,CompRes,WF) :-
2341		membership_test_wf(Dom,Y,MemRes,WF), rel_compose_with_inf_fun_aux(MemRes,X,Y,T,Dom,Fun,CompRes,WF).
2342
2343		:- block rel_compose_with_inf_fun_aux(-,?,?,?, ?,?,?,?).
2344		rel_compose_with_inf_fun_aux(pred_true,X,Y,T,Dom,Fun,CompRes,WF) :-
2345		apply_to(Fun,Y,FY,WF),
2346		add_element_wf((X,FY),CT,CompRes,WF),
2347		rel_compose_with_inf_fun(T,Dom,Fun,CT,WF).
2348		rel_compose_with_inf_fun_aux(pred_false,_X,_Y,T,Dom,Fun,Comp,WF) :-
2349		rel_compose_with_inf_fun(T,Dom,Fun,Comp,WF).
2350		*/
2351
2352		:- assert_must_abort_wf(bsets_clp:rel_iterate_wf([],int(-1),_R,set(couple(integer,integer)),WF),WF).
2353		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_iterate_wf([], int(2),[],set(couple(integer,integer)),_WF))).
2354		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_iterate_wf([(int(1),int(2)),(int(3),int(4)),(int(5),int(6))], int(1),[(int(1),int(2)),(int(3),int(4)),(int(5),int(6))],set(couple(integer,integer)),_WF))).
2355		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_iterate_wf([(pred_true,pred_true)], int(0),
2356		[(pred_true,pred_true),(pred_false,pred_false)],set(couple(boolean,boolean)),_WF))).
2357		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:rel_iterate_wf([(int(1),int(2)),
2358		(int(2),int(4)),(int(4),int(6))], int(2),[(int(1),int(4)),(int(2),int(6))],
2359		set(couple(integer,integer)),WF),WF)).
2360		:- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(1),X,set(couple(integer,integer)),_WF), R=[],
2361		bsets_clp:equal_object(X,R))).
2362		:- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(1),X,set(couple(integer,integer)),_WF),
2363		R=[(int(1),int(2)),(int(2),int(3))],
2364		bsets_clp:equal_object(X,R))).
2365		:- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(2),X,set(couple(integer,integer)),_WF),
2366		R=[(int(1),int(2)),(int(2),int(3))],
2367		bsets_clp:equal_object(X,[(int(1),int(3))]))).
2368		:- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(3),X,set(couple(integer,integer)),_WF),
2369		R=[(int(1),int(2)),(int(2),int(3))],
2370		bsets_clp:equal_object(X,[]))).
2371		:- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(3),X,set(couple(integer,integer)),_WF),
2372		R=[(int(1),int(2)),(int(2),int(3)),(int(1),int(1))],
2373		bsets_clp:equal_object(X,[(int(1),int(1)),(int(1),int(2)),(int(1),int(3))]))).
2374
2375		rel_iterate_wf(Rel,int(Nr),Res,Type,WF) :-
2376		opt_push_wait_flag_call_stack_info(WF,b_operator_call(iterate,
2377		[Nr,Rel],unknown),WF2),
2378		rel_iterate1(Nr,Rel,Res,Type,WF2).
2379
2380		:- block rel_iterate1(-,?,?,?,?).
2381		rel_iterate1(X,Rel,Res,Type,WF) :-
2382		%value_variables(Rel,GrV),
2383		rel_iterate2(X,Rel,Res,Type,WF).
2384
2385		rel_iterate2(X,Rel,Res,Type,WF) :-
2386		( X=1 -> equal_object_wf(Res,Rel,rel_iterate2,WF)
2387		; X>1 -> X1 is X-1,
2388		rel_iterate2(X1,Rel,R1,Type,WF),
2389		rel_composition_wf(Rel,R1,Res,Type,WF)
2390		; X=0 -> rel_iterate0(Rel,Type,Res,WF)
2391		; add_wd_error('negative index in iterate',X,WF)
2392		).
2393
2394		:- use_module(bsyntaxtree,[get_set_type/2]).
2395		:- block rel_iterate0(?,-,?,?).
2396		rel_iterate0(_Rel,EType,Res,WF) :-
2397		get_set_type(EType,couple(Type,Type)),
2398		event_b_identity_for_type(Type,Res,WF).
2399
2400		:- use_module(typing_tools,[is_infinite_type/1]).
2401		event_b_identity_for_type(Type,Res,WF) :-
2402		create_texpr(identifier('_zzzz_unary'),Type,[],TIdentifier1), % was [generated]
2403		create_texpr(identifier('_zzzz_binary'),Type,[],TIdentifier2), % was [generated]
2404		(is_infinite_type(Type) -> Info = [prob_annotation('SYMBOLIC')] ; Info =[]),
2405		create_texpr(equal(TIdentifier1,TIdentifier2),pred,Info,TPred),
2406		construct_closure(['_zzzz_unary','_zzzz_binary'],[Type,Type],TPred,CRes),
2407		% for small types we could do: all_objects_of_type(Type,All), identity_relation_over_wf(All,CRes,WF)
2408		%, print(constructed_eventb_identity(Res)),nl
2409		equal_object_wf(Res,CRes,WF).
2410
2411
2412		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:direct_product_wf([],[(int(1),int(11))],[],_WF))).
2413		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))],
2414		[(int(1),int(11))],[(int(1),(int(2),int(11)))],_WF))).
2415		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))],
2416		[(int(2),int(11))],[],_WF))).
2417		:- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))],
2418		[(int(2),int(11))],X,_WF),
2419		X = [])).
2420		:- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))],
2421		[(int(1),int(11))],X,_WF),
2422		kernel_objects:equal_object(X,[(int(1),(int(2),int(11)))]))).
2423		:- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(1),int(6))],
2424		[(int(1),int(11))],X,_WF),
2425		kernel_objects:equal_object(X,[(int(1),(int(2),int(11))),(int(1),(int(6),int(11)))]))).
2426		:- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(2),int(6))],
2427		[(int(1),int(11)),(int(1),int(12))],X,_WF),
2428		kernel_objects:equal_object(X,[(int(1),(int(2),int(11))),(int(1),(int(2),int(12)))]))).
2429		:- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(2),int(6))],
2430		[(int(1),int(11)),(int(1),int(12))],
2431		[(int(1),(int(2),int(11))),(int(1),(int(2),int(12)))],_WF))).
2432		:- assert_must_succeed((bsets_clp:direct_product_wf(avl_set(node((fd(1,'Name'),fd(2,'Name')),true,1,empty,node((fd(2,'Name'),fd(3,'Name')),true,0,empty,empty))),
2433		avl_set(node((fd(1,'Name'),fd(2,'Name')),true,1,empty,node((fd(2,'Name'),fd(3,'Name')),true,0,empty,empty))),
2434		avl_set(node((fd(1,'Name'),fd(2,'Name'),fd(2,'Name')),true,1,empty,node((fd(2,'Name'),fd(3,'Name'),fd(3,'Name')),true,0,empty,empty)))
2435		,_WF))).
2436
2437		:- block direct_product_wf(-,?,?,?),direct_product_wf(?,-,?,?).
2438		direct_product_wf(Rel1,Rel2,Prod,WF) :-
2439		try_expand_and_convert_to_avl_with_check(Rel1,E1,direct_product), % to do: try_expand_and_convert_to_avl_unless_large_wf(Rel1,E1,WF),
2440		try_expand_and_convert_to_avl_with_check(Rel2,E2,direct_product),
2441		direct_product_wf1(E1,E2,Prod,WF).
2442
2443		direct_product_wf1(Rel1,Rel2,Prod,WF) :-
2444		direct_product_explicit_set(Rel1,Rel2,Res),!,
2445		equal_object_wf(Prod,Res,direct_product_wf1,WF).
2446		direct_product_wf1(Rel1,Rel2,Prod,WF) :-
2447		expand_custom_set_to_list_wf(Rel1,Relation1,_,direct_product_wf1_1,WF),
2448		expand_custom_set_to_list_wf(Rel2,Relation2,_,direct_product_wf1_2,WF),
2449		direct_product2(Relation1,Relation2,Prod,WF),
2450		direct_product_backwards(Relation1,Relation2,Prod,WF).
2451
2452		:- block direct_product2(-,?,?,?).
2453		direct_product2([],_,Out,WF) :- equal_object_wf(Out,[],direct_product2,WF).
2454		direct_product2([(X,Y)|T],Rel2,Out,WF) :-
2455		direct_product_tuple(Rel2,X,Y,Out,OutRem,WF),
2456		direct_product2(T,Rel2,OutRem,WF).
2457
2458		:- block direct_product_tuple(-,?,?,?,?,?).
2459		direct_product_tuple([],_,_,Res,Rem,WF) :- equal_object_optimized_wf(Res,Rem,direct_product_tuple,WF).
2460		direct_product_tuple([(X2,Z)|T],X,Y,Res,Rem,WF) :-
2461		direct_product_tuple(T,X,Y,CT,Rem,WF),
2462		equality_objects_wf(X2,X,EqRes,WF),
2463		direct_product_tuple3(EqRes,X,Y,Z,CT,Res,WF).
2464
2465		:- block direct_product_tuple3(-,?,?,?,?,?,?).
2466		direct_product_tuple3(pred_true,X,Y,Z,CT,Res,WF) :-
2467	?	equal_cons_wf(Res,(X,(Y,Z)),CT,WF). /* no need for add_element as output uniquely determines X,Y,Z !?*/
2468		direct_product_tuple3(pred_false,_X,_Y,_Z,CT,Res,WF) :- equal_object_optimized_wf(Res,CT,direct_product_tuple3,WF).
2469
2470		:- block direct_product_backwards(?,?,-,?).
2471		% Propagate information backwards from result to arguments
2472		direct_product_backwards(R1,R2,Prod,WF) :-
2473		((ground_value(R1) ; ground_value(R2)) -> true
2474		; expand_custom_set_to_list_wf(Prod,ProdList,_,direct_product_backwards,WF),
2475		direct_product_propagate_back(ProdList,R1,R2,WF)
2476		).
2477
2478		:- block direct_product_propagate_back(-,?,?,?).
2479		direct_product_propagate_back([],_,_,_WF).
2480		direct_product_propagate_back([(X,(Y,Z))|T],R1,R2,WF) :-
2481		check_element_of_wf((X,Y),R1,WF), check_element_of_wf((X,Z),R2,WF),
2482		direct_product_propagate_back(T,R1,R2,WF).
2483
2484		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:parallel_product([],[(int(3),int(4))],[]))).
2485		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:parallel_product([(int(1),int(2))],
2486		[(int(3),int(4))],[((int(1),int(3)),(int(2),int(4)))]))).
2487		:- assert_must_succeed((bsets_clp:parallel_product([(int(1),int(2))],
2488		[(int(3),int(4))],X), ground(X),
2489		equal_object(X,[((int(1),int(3)),(int(2),int(4)))]))).
2490		:- assert_must_succeed((bsets_clp:parallel_product([(int(1),int(2))],
2491		[(int(3),int(4))],[((int(1),int(3)),(int(2),int(4)))]))).
2492		:- assert_must_succeed((bsets_clp:parallel_product([(int(1),int(2))], [],X),X == [])).
2493		:- assert_must_succeed((bsets_clp:parallel_product([], [(int(3),int(4))],X),X == [])).
2494
2495		parallel_product(Rel1,Rel2,Prod) :- parallel_product_wf(Rel1,Rel2,Prod,no_wf_available).
2496
2497		:- block parallel_product_wf(-,?,?,?),parallel_product_wf(?,-,?,?).
2498		% NOTE: we now have in_parallel_product; as such parallel products are kept symbolic
2499		%parallel_product_wf(Rel1,Rel2,Prod,WF) :- (keep_symbolic(Rel1) -> true ; keep_symbolic(Rel2)),
2500		% print_term_summary(parallel_product(Rel1,Rel2,Prod)),nl,
2501		%% % TO DO: generate closure
2502		% %{xy,mn|#(x,y,m,n).(xy=(x,y) & mn=(m,n) & (x,m):S & (y,n):R)}
2503		% fail.
2504		parallel_product_wf(Rel1,Rel2,Prod,WF) :-
2505		expand_custom_set_to_list_wf(Rel1,Relation1,_,parallel_product_1,WF),
2506		expand_custom_set_to_list_wf(Rel2,Relation2,_,parallel_product_2,WF),
2507		parallel_product2(Relation1,Relation2,ProdRes,WF),
2508		equal_object_optimized_wf(ProdRes,Prod,parallel_product,WF).
2509
2510		:- use_module(kernel_equality,[conjoin_test/4]).
2511		%(Rel1||Rel2) = {(x,y),(m,n)| (x,m):Rel1 & (y,n):Rel2}
2512
2513		% TO DO: use this in b_interpreter_check:
2514		in_parallel_product_test(((X,Y),(M,N)),Rel1,Rel2,Result,WF) :-
2515		conjoin_test(MemRes1,MemRes2,Result,WF),
2516		membership_test_wf(Rel1,(X,M),MemRes1,WF),
2517		membership_test_wf(Rel2,(Y,N),MemRes2,WF).
2518
2519		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_parallel_product_wf(((int(1),int(2)),(int(11),int(22))),[(int(1),int(11))],[(int(2),int(22))],WF),WF)).
2520
2521		in_parallel_product_wf(El,Rel1,Rel2,WF) :-
2522		in_parallel_product_test(El,Rel1,Rel2,pred_true,WF).
2523
2524
2525		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_in_parallel_product_wf(((int(1),int(11)),(int(2),int(22))),[(int(1),int(11))],[(int(2),int(22))],_WF))).
2526
2527		not_in_parallel_product_wf(El,Rel1,Rel2,WF) :-
2528		in_parallel_product_test(El,Rel1,Rel2,pred_false,WF).
2529
2530
2531		:- block parallel_product2(-,?,?,?).
2532		parallel_product2([],_,Out,WF) :- empty_set_wf(Out,WF).
2533		parallel_product2([(X,Y)|T],Rel2,Out,WF) :-
2534		parallel_product_tuple(Rel2,X,Y,Out,Tail,WF),
2535		parallel_product2(T,Rel2,Tail,WF).
2536
2537		:- block parallel_product_tuple(-,?,?,?,?,?).
2538		parallel_product_tuple([],_,_,Tail1,Tail2,WF) :- equal_object_wf(Tail1,Tail2,parallel_product_tuple,WF).
2539		parallel_product_tuple([(X2,Y2)|T],X,Y,Rel2,Tail,WF) :-
2540		equal_object_wf(Rel2,[((X,X2),(Y,Y2))|RT],parallel_product_tuple,WF),
2541		parallel_product_tuple(T,X,Y,RT,Tail,WF).
2542
2543
2544		% -------------------------------------------------
2545
2546		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_function([(int(1),int(6)),(int(2),int(7))],[int(1)],[int(7),int(6)],WF),WF)). %% with wf_det leads to residue custom_explicit_sets:b_not_test_closure_enum
2547		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_function([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(8),int(6)],WF),WF)).
2548		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_function([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2549		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_function([(int(1),int(6)),(int(1),int(7))],[int(1)],[int(7),int(6)],WF),WF)).
2550		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_partial_function([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2551		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_partial_function([(int(1),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2552		:- assert_must_fail((bsets_clp:not_partial_function([],[int(1)],[int(7)],_WF))).
2553		:- assert_must_fail((bsets_clp:not_partial_function(X,[int(1)],[int(7)],_WF),
2554		X = [(int(1),int(7))])).
2555		:- assert_must_fail((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7)],_WF),
2556		X = [(int(2),int(7)),(int(1),int(7))])).
2557		:- assert_must_fail((bsets_clp:not_partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2558		[int(7),int(6)],_WF),
2559		X = [([(int(1),int(2))],int(7)),
2560		([(int(2),int(3)),(int(1),int(3))],int(6))])).
2561		:- assert_must_fail((bsets_clp:not_partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2562		[int(7),int(6)],_WF),
2563		X = [([(int(2),int(3)),(int(1),int(3))],int(6))])).
2564		:- assert_must_fail((bsets_clp:not_partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2565		[int(7),int(6)],_WF),
2566		X = [([(int(1),int(2))],int(7)),
2567		([(int(2),int(3)),(int(1),int(3))],int(6))])).
2568		:- assert_must_fail((bsets_clp:not_partial_function(X,[int(1)],[[int(7),int(6)]],_WF),
2569		X = [(int(1),[int(6),int(7)])])).
2570		:- assert_must_fail((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2571		X = [(int(2),int(7)),(int(1),int(7))])).
2572		:- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2573		X = [(int(2),int(7)),(int(2),int(6))])).
2574		:- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2575		X = [(int(2),int(7)),(int(1),int(2))])).
2576		:- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2577		X = [(int(2),int(7)),(int(3),int(6))])).
2578		:- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2579		X = [(int(2),int(7)),(int(2),int(5))])).
2580		:- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2581		X = [(int(1),int(7)),(int(2),int(6)),(int(2),int(7))])).
2582		:- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF),
2583		X = [(int(1),int(7)),(int(5),int(75))])).
2584		:- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('NATURAL1'),_WF),
2585		X = [(int(1),int(7)),(int(0),int(7))])).
2586		:- assert_must_succeed((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('NATURAL1'),_WF),
2587		X = [(int(1),int(7)),(int(-1),int(7))])).
2588		:- assert_must_succeed((bsets_clp:not_partial_function(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF),
2589		X = [(int(1),int(7)),(int(0),int(7))])).
2590		:- assert_must_fail((bsets_clp:not_partial_function(X,global_set('Name'),global_set('Code'),_WF),
2591		X = [(fd(1,'Name'),fd(1,'Code'))])).
2592		:- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('Code'),_WF),
2593		X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(88),fd(2,'Code'))])).
2594		:- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('Code'),_WF),
2595		X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(2),fd(2,'Code'))])).
2596		:- assert_must_succeed((bsets_clp:not_partial_function([(fd(1,'Code'),int(1)),(fd(1,'Code'),int(2))],
2597		global_set('Code'),global_set('NAT1'),_WF) )).
2598
2599		:- block not_partial_function(-,?,?,?).
2600		not_partial_function([],_Domain,_Range,_WF) :- !,fail.
2601		not_partial_function(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
2602		% we do not need the Range; this means we can match more closures (e.g., lambda)
2603	?	custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
2604		not_subset_of_wf(FFDomain,Domain,WF).
2605		not_partial_function(FF,Domain,Range,WF) :- nonvar(FF),
2606		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_),WF),!,
2607		not_both_subset_of(FFDomain,FFRange,Domain,Range,WF).
2608		not_partial_function(FF,Domain,Range,WF) :- nonvar(FF), FF=closure(P,T,Pred),
2609		% example: f = %t.(t : NATURAL|t + 100) & f /: NATURAL +-> NATURAL
2610		is_lambda_value_domain_closure(P,T,Pred, FFDomain,_Expr),
2611		get_range_id_expression(P,T,TRangeID),!,
2612		subset_test(FFDomain,Domain,SubRes,WF),
2613		when(nonvar(SubRes),
2614		(SubRes=pred_false -> true % not a subset -> it is not a partial function over the domain
2615		; check_not_lambda_closure_range(P,T,Pred,TRangeID,Range,WF))).
2616		not_partial_function(R,Domain,Range,WF) :-
2617		expand_and_convert_to_avl_set_warn(R,AER,not_partial_function,'ARG /: ? +-> ?',WF),!,
2618		% TO DO: expand_and_convert_to_avl_set_catch and provide symbolic treatment similar to partial_function
2619		% e.g., to support f = NATURAL1 * {22,33} & not(f: NATURAL1 +-> NATURAL)
2620		is_not_avl_partial_function(AER,Domain,Range,WF).
2621		not_partial_function(R,Domain,Range,WF) :-
2622		expand_custom_set_to_list_wf(R,ER,_,not_partial_function,WF),
2623		not_pf(ER,[],Domain,Range,WF).
2624
2625		is_not_avl_partial_function(AER,Domain,Range,WF) :-
2626		(is_avl_partial_function(AER)
2627		-> is_not_avl_relation_over_domain_range(AER,Domain,Range,WF)
2628		; true
2629		).
2630
2631		:- block not_pf(-,?,?,?,?).
2632		not_pf([],_,_,_,_) :- fail.
2633		not_pf([(X,Y)|T],SoFar,Dom,Ran,WF) :-
2634		membership_test_wf_with_force(SoFar,X,MemRes,WF),
2635		not_pf2(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
2636
2637		:- block not_pf2(-,?,?,?,?,?,?,?).
2638		not_pf2(pred_true,_X,_Y,_T,_SoFar,_Dom,_Ran,_WF). /* then not a function */
2639		not_pf2(pred_false,X,Y,T,SoFar,Dom,Ran,WF) :-
2640		membership_test_wf_with_force(Dom,X,MemRes,WF), % creates a choice point in SMT mode
2641		not_pf2a(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
2642
2643		:- block not_pf2a(-,?,?,?,?,?,?,?).
2644		not_pf2a(pred_false,_X,_Y,_T,_SoFar,_Dom,_Ran,_WF). /* function, but domain wrong */
2645		not_pf2a(pred_true,X,Y,T,SoFar,Dom,Ran,WF) :-
2646		remove_element_wf_if_not_infinite_or_closure(X,Dom,Dom2,WF,_LWF,Done), %% provide _LWF ??
2647		not_pf2b(Done,X,Y,T,SoFar,Dom2,Ran,WF).
2648
2649		:- block not_pf2b(-, ?,?,?, ?,?,?, ?).
2650		not_pf2b(_Done, X,Y,T, SoFar,Dom2,Ran, WF) :-
2651		add_element_wf(X,SoFar,SoFar2,WF),
2652		(T==[] -> not_element_of_wf(Y,Ran,WF)
2653		; membership_test_wf_with_force(Ran,Y,MemRes,WF),
2654		prop_empty_pred_false(T,MemRes), % if T=[] -> Y must not be in Ran
2655		not_pf3(MemRes,T,SoFar2,Dom2,Ran,WF)).
2656
2657		:- block prop_empty_pred_false(-,?).
2658		prop_empty_pred_false([],R) :- !, R=pred_false.
2659		prop_empty_pred_false(_,_).
2660
2661		:- block not_pf3(-,?,?,?,?,?).
2662		not_pf3(pred_false,_T,_SoFar,_Dom2,_Ran,_WF). /* illegal range */
2663		not_pf3(pred_true,T,SoFar,Dom2,Ran,WF) :-
2664		not_pf(T,SoFar,Dom2,Ran,WF).
2665
2666		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2667		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_wf([(int(1),int(1)),(int(2),int(1))],global_set('NATURAL'),global_set('NATURAL'),WF),WF)).
2668		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_wf([(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2669		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:partial_function_wf([(int(2),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
2670		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:partial_function_wf([(pred_true,int(6)),(pred_true,int(7))],[pred_false,pred_true],[int(7),int(6)],WF),WF)).
2671		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:partial_function_wf([(term(floating(1.0)),int(6)),(term(floating(1.0)),int(7))],[term(floating(1.0)),term(floating(2.0))],[int(7),int(6)],WF),WF)).
2672		:- assert_must_succeed((bsets_clp:partial_function([],[int(1)],[int(7)]))).
2673		:- assert_must_succeed((bsets_clp:partial_function(X,[int(1)],[int(7)]),
2674		X = [(int(1),int(7))])).
2675		:- assert_must_succeed((bsets_clp:partial_function(X,[int(1),int(2)],[int(7)]),
2676		equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
2677		:- assert_must_succeed((findall(X,bsets_clp:partial_function(X,[int(1),int(2)],[int(7)]),L),
2678		length(L,Len), Len >= 4,
2679		(preferences:get_preference(convert_comprehension_sets_into_closures,true) -> true ; Len=4) )).
2680		:- assert_must_succeed((bsets_clp:partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2681		[int(7),int(6)]),
2682		equal_object(X,[([(int(1),int(2))],int(7)),
2683		([(int(2),int(3)),(int(1),int(3))],int(6))]))).
2684		:- assert_must_succeed((bsets_clp:partial_function_wf(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2685		[int(7),int(6)],_WF),
2686		X = [([(int(2),int(3)),(int(1),int(3))],int(6))])).
2687		:- assert_must_succeed((bsets_clp:partial_function_wf(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2688		[int(7),int(6)],_WF),
2689		X = [([(int(1),int(2))],int(7)),
2690		([(int(2),int(3)),(int(1),int(3))],int(6))])).
2691		:- assert_must_succeed((bsets_clp:partial_function_wf(X,[int(1)],[[int(7),int(6)]],_WF),
2692		X = [(int(1),[int(6),int(7)])])).
2693		:- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF),
2694		X = [(int(1),int(7)),(int(5),int(75))])).
2695		:- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('NATURAL1'),_WF),
2696		X = [(int(1),int(7)),(int(0),int(7))])).
2697		:- assert_must_fail((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('NATURAL1'),_WF),
2698		X = [(int(1),int(7)),(int(-1),int(7))])).
2699		:- assert_must_fail((bsets_clp:partial_function_wf(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF),
2700		X = [(int(1),int(7)),(int(0),int(7))])).
2701		:- assert_must_fail((bsets_clp:partial_function_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
2702		X = [(int(2),int(7)),(int(2),int(6))])).
2703		:- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('Name'),global_set('Code'),_WF),
2704		X = [(fd(1,'Name'),fd(1,'Code'))])).
2705		:- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('Code'),_WF),
2706		X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(88),fd(2,'Code'))])).
2707		:- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('Code'),_WF),
2708		X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(2),fd(2,'Code'))])).
2709
2710		partial_function(R,Domain,Range) :- init_wait_flags(WF,[partial_function]),
2711		partial_function_wf(R,Domain,Range,WF),
2712		ground_wait_flags(WF).
2713
2714		:- use_module(kernel_equality,[get_cardinality_powset_wait_flag/5]).
2715		:- use_module(closures,[is_lambda_value_domain_closure/5]).
2716		:- block partial_function_wf(-,-,?,?).
2717		partial_function_wf(R,_Domain,_Range,_WF) :- R==[], !.
2718		partial_function_wf(R,Domain,Range,WF) :- (Domain==[] ; Range==[]), !, empty_set_wf(R,WF).
2719		partial_function_wf(FF,Domain,Range,WF) :- nonvar(FF),
2720		custom_explicit_sets:is_definitely_maximal_set(Range),
2721		% we do not need the Range; this means we can match more closures (e.g., lambda)
2722	?	custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
2723		check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF).
2724		partial_function_wf(FF,Domain,Range,WF) :- nonvar(FF),
2725		% TODO: this will fail if is_definitely_maximal_set was true above !
2726		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_),WF),!,
2727		% same as for total_function_wf check
2728		check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF),
2729		check_range_subset_for_closure_wf(FF,FFRange,Range,WF).
2730		partial_function_wf(FF,Domain,Range,WF) :- nonvar(FF), FF=closure(P,T,Pred),
2731		% example: f = %x.(x:NATURAL1|x+1) & f: NATURAL1 +-> NATURAL
2732		is_lambda_value_domain_closure(P,T,Pred, FFDomain,_Expr),
2733		get_range_id_expression(P,T,TRangeID),
2734		!,
2735		check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF),
2736		opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
2737		[b_operator(range,[FF]),Range],unknown),WF3),
2738		check_lambda_closure_range(P,T,Pred,TRangeID,Range,WF3). % we could use symbolic_range_subset_check
2739		partial_function_wf(R,Domain,Range,WF) :-
2740		expand_and_convert_to_avl_set_catch(R,AER,partial_function_wf,'ARG : ? +-> ?',ResultStatus,WF),!,
2741		(ResultStatus=avl_set
2742	?	-> is_avl_partial_function_over(AER,Domain,Range,WF)
2743		; % keep symbolic
2744		(debug_mode(off) -> true ; print('SYMBOLIC +-> check : '),translate:print_bvalue(R),nl),
2745		% can deal with, e.g., f = %x.(x:NATURAL|x+1) & g = f <+ {0|->0} & g : INTEGER +-> INTEGER
2746		symbolic_domain_subset_check(R,Domain,WF),
2747		symbolic_range_subset_check(R,Range,WF),
2748		symbolic_functionality_check(R,WF)
2749		).
2750		partial_function_wf(R,Domain,Range,WF) :-
2751		get_cardinality_powset_wait_flag(Domain,partial_function_wf,WF,Card,CWF),
2752		% probably we should compute real cardinality of set of partial functions over Domain +-> Range ?
2753		% the powset waitflag uses 2^Card as priority; is the number of partial functions when Range contains just a single element
2754		% slows down test 1088: TO DO investigate
2755		% get_cardinality_partial_function_wait_flag(Domain,Range,partial_function_wf,WF,Card,_,CWF),
2756		%% Maybe we should only enumerate partial functions for domain variables ; e.g., not f <+ {x |-> y} : T +-> S
2757		%% print_bt_message(pf_dom_card(Card)),nl, %%%
2758		% probably we should use a special version when R is var
2759		propagate_empty_set_wf(Domain,dom_pf,R,WF),
2760		propagate_empty_set_wf(Range,ran_pf,R,WF),
2761		(var(R) -> pf_var_r(R,var,Domain,Range,Card,WF,CWF) ; pf_var_r(R,nonvar,Domain,Range,Card,WF,CWF)).
2762
2763		% symbolic dom(R) <: Domain check for closures
2764		symbolic_domain_subset_check(R,Domain,WF) :-
2765		opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
2766		[b_operator(domain,[R]),Domain],unknown),WF2),
2767		domain_subtraction_wf(Domain,R,Res,WF2), % works symbolically
2768		(debug_mode(off) -> true ; print('Domain Violations: '),translate:print_bvalue(Res),nl),
2769		empty_set_wf(Res,WF2). % empty_set does a symbolic treatment calling gen_typed_ids and b_not_test_exists:
2770		% symbolic ran(R) <: Range check for closures
2771		symbolic_range_subset_check(R,Range,WF) :-
2772		opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
2773		[b_operator(range,[R]),Range],unknown),WF2),
2774		range_subtraction_wf(R,Range,Res,WF2), % works symbolically
2775		(debug_mode(off) -> true ; print('Range Violations: '),translate:print_bvalue(Res),nl),
2776		empty_set_wf(Res,WF2). % works symbolically
2777		symbolic_functionality_check(Closure,WF) :-
2778		custom_explicit_sets:symbolic_functionality_check_closure(Closure,ViolationsClosure),!,
2779		(debug_mode(off) -> true ; print('FUNCTIONALITY Violations: '),translate:print_bvalue(ViolationsClosure),nl),
2780		empty_set_wf(ViolationsClosure,WF). % works symbolically
2781		symbolic_functionality_check(R,WF) :-
2782		add_error_wf(symbolic_functionality_check,'Could not check functionality of:',R,R,WF).
2783
2784		symbolic_injectivity_check(Closure,WF) :-
2785		custom_explicit_sets:symbolic_injectivity_check_closure(Closure,ViolationsClosure),!,
2786		(debug_mode(off) -> true ; print('INJECTIVITY Violations: '),translate:print_bvalue(ViolationsClosure),nl),
2787		empty_set_wf(ViolationsClosure,WF). % works symbolically
2788		symbolic_injectivity_check(R,WF) :-
2789		add_error_wf(symbolic_functionality_check,'Could not check injectivity of:',R,R,WF).
2790
2791
2792		is_avl_partial_function_over(AER,Domain,Range,WF) :-
2793		is_avl_partial_function(AER),
2794	?	is_avl_relation_over_domain(AER,Domain,WF),
2795	?	is_avl_relation_over_range(AER,Range,WF).
2796
2797		% symbolically check that the range of lambda closure is a subset of a given Range
2798		% TRangeID is obtained by calling get_range_id_expression(P,T,TRangeID)
2799		check_lambda_closure_range(P,T,Pred,TRangeID,Range,WF) :-
2800		opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
2801		[b_operator(range,[closure(P,T,Pred)]),Range],unknown),WF2),
2802		% CHECK not(#P.(Pred & TRangeID /: Range))
2803		get_not_in_range_pred_aux(Pred,TRangeID,Range,Pred2),
2804		is_empty_closure_wf(P,T,Pred2,WF2). % do we need to rename _lambda_result_ using rename_lambda_result_id ?
2805		% now the negation thereof:
2806		check_not_lambda_closure_range(P,T,Pred,TRangeID,Range,WF) :-
2807		opt_push_wait_flag_call_stack_info(WF,b_operator_call(not_subset,
2808		[b_operator(range,[closure(P,T,Pred)]),Range],unknown),WF2),
2809		% CHECK (#P.(Pred & TRangeID /: Range))
2810		get_not_in_range_pred_aux(Pred,TRangeID,Range,Pred2),
2811		is_non_empty_closure_wf(P,T,Pred2,WF2).
2812		test_lambda_closure_range(P,T,Pred,TRangeID,Range,Res,WF) :-
2813		opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset, % it is actually a reify check
2814		[b_operator(range,[closure(P,T,Pred)]),Range],unknown),WF2),
2815		% reify not(#P.(Pred & TRangeID /: Range))
2816		get_not_in_range_pred_aux(Pred,TRangeID,Range,Pred2),
2817		test_empty_closure_wf(P,T,Pred2,Res,WF2).
2818
2819		get_not_in_range_pred_aux(Pred,TRangeID,Range,NewPred) :- % construct (Pred & TRangeID /: Range)
2820		ExpectedRange = b(value(Range),set(RanT),[]),
2821		get_texpr_type(TRangeID,RanT),
2822		safe_create_texpr(not_member(TRangeID,ExpectedRange),pred,NotMemCheck),
2823		conjunct_predicates([Pred,NotMemCheck],NewPred).
2824
2825
2826		% if first argument is empty, second argument must also be empty
2827		:- block propagate_empty_set_wf(-,?,?,?).
2828		propagate_empty_set_wf([],_PP,A,WF) :- !, %print(prop_empty(_PP,A)),nl,
2829		kernel_objects:empty_set_wf(A,WF). % TO DO: add WF
2830		propagate_empty_set_wf(_,_,_,_).
2831
2832		:- block pf_var_r(-,?,?,?,?,?,-).
2833		pf_var_r(R,var,Domain,Range,_Card,WF,_CWF) :- % if R was var: see if it is now an AVL set; otherwise we have already checked it
2834		expand_and_convert_to_avl_set_warn(R,AER,pf_var_r,'ARG : ? +-> ?',WF),!,
2835		is_avl_partial_function_over(AER,Domain,Range,WF).
2836		pf_var_r(R,_,Domain,Range,Card,WF,CWF) :-
2837		expand_custom_set_to_list_wf(R,ER,_,partial_function_wf,WF),
2838		%get_last_wait_flag(partial_fun(Domain),WF,LWF),
2839	?	pf_w(ER,[],Domain,Range,Card,_Large,WF,CWF).
2840
2841		pf_w(T,SoFar,Dom,Ran,Card,Large,WF,LWF) :-
2842		(Card==0 -> T=[]
2843	?	; pf(T,SoFar,Dom,Ran,Card,Large,WF,LWF)).
2844
2845		:- block pf(-,?,?,?,?,?,?,-).
2846		pf(LIST,_,_,_,_,_WF,_,_LWF) :- LIST==[],!. % avoid leaving choicepoint
2847		pf(AVL,SoFar,Dom,Ran,Card,Large,WF,LWF) :- nonvar(AVL),AVL=avl_set(_A),
2848		add_internal_error('AVL arg: ',pf(AVL,SoFar,Dom,Ran,Card,Large,WF,LWF)),fail.
2849		pf([],_,_,_,_,_WF,_,_LWF).
2850		pf(LIST,SoFar,Dom,Ran,Card,Large,WF,LWF) :-
2851		(var(LIST) -> ListWasVar = true ; ListWasVar = false), % is ListWasVar = true we are doing the enumeration driven by LWF being ground
2852		LIST = [(X,Y)|T],
2853	?	dec_card(Card,NC),/* Card ensures we do not build too big lists */
2854		Dom \== [],
2855	?	remove_domain_element(ListWasVar,X,Y,Dom,Dom2,Large,WF,LWF,Done),
2856	?	check_element_of_wf(Y,Ran,WF),
2857	?	pf1(Done, X,Y,T,SoFar,Dom2,Ran,NC,Large,WF,LWF).
2858
2859		:- block dec_card(-,?).
2860		dec_card(inf,NewC) :- !, NewC=inf.
2861		dec_card(inf_overflow,NewC) :- !, NewC=inf_overflow.
2862		dec_card(C,NewC) :- C>0, NewC is C-1.
2863
2864		:- block pf1(-, ?,?,?,?,?,?,?,?,?,?).
2865		pf1(_Done, X,_Y,T,SoFar,Dom2,Ran,Card,Large,WF,LWF) :-
2866		not_element_of_wf(X,SoFar,WF), /* check that it is a function */
2867		%% check_element_of_wf(Y,Ran,WF), % this check is now done above in pf
2868		add_new_element_wf(X,SoFar,SoFar2,WF),
2869	?	pf_w(T,SoFar2,Dom2,Ran,Card,Large,WF,LWF).
2870
2871		remove_domain_element(ListWasVar,X,Y,Dom,Dom2,Large,WF,LWF,Done) :- compute_large(Dom,Large),
2872		((ListWasVar==true,var(X),var(Y),Large==false,
2873		preference(convert_comprehension_sets_into_closures,false), % not in symbolic mode
2874		ground_value(Dom))
2875		-> %% (X, Y are free and we drive the enumeration: we can influence which element is taken from Dom
2876		remove_a_minimal_element(X,Dom,Dom2,WF,Done) %%%%%%%%%% added Jul 15 2008
2877	?	; remove_element_wf_if_not_infinite_or_closure(X,Dom,Dom2,WF,LWF,Done)
2878		).
2879		compute_large(Dom,Large) :- % check if the domain is large; ensure that we compute this only once
2880		(nonvar(Large) -> true
2881		; var(Dom) -> true
2882		; dont_expand_this_explicit_set(Dom) -> Large=large
2883		; Large=false).
2884
2885		:- assert_must_succeed(( bsets_clp:remove_a_minimal_element(X,[int(1)],R,_WF,Done),
2886		X==int(1), Done==true, R=[] )).
2887		:- assert_must_succeed(( init_wait_flags(WF), bsets_clp:remove_a_minimal_element(X,[int(1),int(2),int(3)],R,WF,Done), ground_wait_flags(WF),
2888		X==int(2), Done==true, R=[int(3)] )).
2889		:- assert_must_succeed(( init_wait_flags(WF), bsets_clp:remove_a_minimal_element(X,[int(1),int(2),int(3)],R,WF,Done), ground_wait_flags(WF),
2890		X==int(1), R=[int(2),int(3)], Done==true )).
2891		:- assert_must_succeed(( init_wait_flags(WF), bsets_clp:remove_a_minimal_element(X,[int(1),int(2),int(3)],R,WF,Done), ground_wait_flags(WF),
2892		X==int(3), R=[], Done==true )).
2893		:- assert_must_succeed(( init_wait_flags(WF), CL=closure(['_zzzz_binary'],[integer],b(member( b(identifier('_zzzz_binary'),integer,[]),
2894		b(interval(b(value(int(1)),integer,[]),b(value(int(10)),integer,[])),set(integer),[])),pred,[])),
2895		bsets_clp:remove_a_minimal_element(X,CL,R,WF,Done), ground_wait_flags(WF),
2896		X=int(9), Done==true, kernel_objects:equal_object(R,[int(10)]) )).
2897
2898		/* usage: restrict number of possible choices if element to remove is free */
2899		/* select one element; and disallow all elements appearing before it in the list */
2900		remove_a_minimal_element(X,Set,Res,WF,Done) :-
2901		expand_custom_set_to_list_wf(Set,ESet,EDone,remove_a_minimal_element,WF),
2902		remove_a_minimal_element2(X,ESet,EDone,Res,WF,Done).
2903
2904		:- use_module(kernel_equality,[get_cardinality_wait_flag/4]).
2905		:- block remove_a_minimal_element2(?,?,-,?,?,?).
2906		remove_a_minimal_element2(X,ESet,EDone,Res,WF,Done) :- var(ESet),
2907		% should not happen as we wait for EDone
2908		add_internal_error('Illegal call: ',remove_a_minimal_element2(X,ESet,EDone,Res,WF,Done)),
2909		fail.
2910		remove_a_minimal_element2(X,ESet,_EDone,Res,WF,Done) :-
2911		ESet \= [],
2912		(ESet = [El]
2913		-> X=El, empty_set_wf(Res,WF), Done=true % only one choice
2914		; get_cardinality_wait_flag(ESet,remove_a_minimal_element2,WF,CWF),
2915		remove_a_minimal_element3(X,ESet,Res,WF,Done,CWF)
2916		).
2917
2918		:- block remove_a_minimal_element3(?,?,?,?,?,-).
2919		remove_a_minimal_element3(X,ESet,Res,WF,Done,_) :- var(Res), !,
2920		append(_,[X|TRes],ESet), % WHAT IF Res has been instantiated in the meantime ???
2921		equal_object_wf(Res,TRes,remove_a_minimal_element2_2,WF),Done=true.
2922		remove_a_minimal_element3(X,ESet,Res,WF,Done,_) :- %print(remove_min_nonvar_res(Res)),nl,
2923		equal_cons_wf(ESet,X,Res,WF), Done=true.
2924
2925
2926		% reified version of partial function test partial_function_wf:
2927		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_test_wf([],[int(1),int(2)],[int(7),int(6)],pred_true,WF),WF)).
2928		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_test_wf([(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],pred_true,WF),WF)).
2929		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_test_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],pred_true,WF),WF)).
2930		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_test_wf([(int(2),int(8))],[int(1),int(2)],[int(7),int(6)],pred_false,WF),WF)).
2931		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_test_wf([(int(3),int(7))],[int(1),int(2)],[int(7),int(6)],pred_false,WF),WF)).
2932		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_function_test_wf([(int(1),int(7)),(int(1),int(6))],[int(1),int(2)],[int(7),int(6)],pred_false,WF),WF)).
2933
2934		:- use_module(kernel_equality,[subset_test/4]).
2935		:- block partial_function_test_wf(-,?,?,-,?), partial_function_test_wf(?,-,-,-,?).
2936		partial_function_test_wf(FF,Domain,Range,Res,WF) :- Res==pred_true,!,
2937		partial_function_wf(FF,Domain,Range,WF).
2938		partial_function_test_wf(FF,Domain,Range,Res,WF) :- Res==pred_false,!,
2939		not_partial_function(FF,Domain,Range,WF). % TO DO: remove not_partial_function to use check_is_partial_function?
2940		partial_function_test_wf(FF,Domain,Range,Res,WF) :- nonvar(FF),
2941		custom_explicit_sets:is_definitely_maximal_set(Range),
2942		% we do not need the Range; this means we can match more closures (e.g., lambda)
2943		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
2944		subset_test(FFDomain,Domain,Res,WF).
2945		partial_function_test_wf(FF,Domain,Range,Res,WF) :- nonvar(FF),
2946		% TODO: this will fail if is_definitely_maximal_set was true above !
2947		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_),WF),!,
2948		% same as for total_function_wf check
2949		subset_test(FFDomain,Domain,DomainOk,WF),
2950		(DomainOk==pred_false -> Res = pred_false
2951		; conjoin_test(DomainOk,RangeOk,Res,WF),
2952		subset_test(FFRange,Range,RangeOk,WF)).
2953		partial_function_test_wf(FF,Domain,Range,Res,WF) :- nonvar(FF), FF=closure(P,T,Pred),
2954		% example: f = %x.(x:NATURAL1|x+1) & f: NATURAL1 +-> NATURAL
2955		is_lambda_value_domain_closure(P,T,Pred, FFDomain,_Expr),
2956		get_range_id_expression(P,T,TRangeID),
2957		!,
2958		subset_test(FFDomain,Domain,DomainOk,WF),
2959		(DomainOk == pred_false -> Res=pred_false
2960		; conjoin_test(DomainOk,RangeOk,Res,WF),
2961		test_lambda_closure_range(P,T,Pred,TRangeID,Range,RangeOk,WF)
2962		).
2963		partial_function_test_wf(R,Domain,Range,Res,WF) :-
2964		expand_and_convert_to_avl_set_warn(R,AER,partial_function_test_wf,'ARG : ? +-> ?',WF),!,
2965		% TO DO: use expand_and_convert_to_avl_set_catch
2966		(is_avl_partial_function(AER)
2967		-> % TO DO: we could do something similar to this instead: is_not_avl_relation_over_domain_range
2968		domain_of_explicit_set_wf(avl_set(AER),FFDomain,WF),
2969		subset_test(FFDomain,Domain,DomainOk,WF),
2970		(DomainOk == pred_false -> Res=pred_false
2971		; range_of_explicit_set_wf(avl_set(AER),FFRange,WF),
2972		conjoin_test(DomainOk,RangeOk,Res,WF),
2973		subset_test(FFRange,Range,RangeOk,WF)
2974		)
2975		; Res=pred_false).
2976		partial_function_test_wf(R,Domain,Range,Res,WF) :-
2977		expand_custom_set_to_list_wf(R,ER,_,partial_function_test_wf,WF),
2978		check_is_partial_function_acc_wf(ER,[],Domain,Range,Res,WF).
2979
2980		:- block check_is_partial_function_acc_wf(-,?,?,?,?,?).
2981		check_is_partial_function_acc_wf([],_,_,_,Res,_WF) :- !, Res=pred_true.
2982		check_is_partial_function_acc_wf([(A,FA)|T],Acc,Dom,Ran,Res,WF) :- !,
2983		check_pair_in_domain_range(A,FA,Dom,Ran,MemResDomRan,WF),
2984		(MemResDomRan==pred_false
2985		-> Res = pred_false
2986		; membership_test_wf(Acc,A,MemResNotFunc,WF),
2987		negate(MemResNotFunc,MemResFunctionality),
2988		conjoin_test(MemResDomRan,MemResFunctionality,PF_Head,WF),
2989		(PF_Head == pred_false -> Res = pred_false
2990		; T==[] -> Res=PF_Head
2991		; add_element_wf(A,Acc,NewAcc,WF),
2992	?	conjoin_test(PF_Head,PF_Tail,Res,WF),
2993		check_is_partial_function_acc_wf(T,NewAcc,Dom,Ran,PF_Tail,WF))
2994		).
2995
2996		check_pair_in_domain_range(A,FA,Dom,Ran,MemResDomRan,WF) :-
2997		membership_test_wf(Dom, A,MemResDom,WF), % use membership_test_wf_with_force for SMT mode ??
2998		(MemResDom == pred_false -> MemResDomRan = pred_false
2999		; membership_test_wf(Ran,FA,MemResRan,WF),
3000		conjoin_test(MemResDom,MemResRan,MemResDomRan,WF)).
3001
3002		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_function_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
3003		:- assert_must_succeed((bsets_clp:total_function(X,[int(1)],[int(7)]),
3004		X = [(int(1),int(7))])).
3005		:- assert_must_succeed((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]),
3006		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
3007		:- assert_must_succeed((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3))]],[int(7),int(6)]),
3008		kernel_objects:equal_object(X,[([(int(1),int(3))],int(7)),([(int(1),int(2))],int(7))]))).
3009		:- assert_must_succeed((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
3010		[int(7),int(6)]),
3011		kernel_objects:equal_object(X,[([(int(1),int(2))],int(7)),
3012		([(int(2),int(3)),(int(1),int(3))],int(6))]))).
3013		:- assert_must_succeed((bsets_clp:total_function(X,[int(1)],[[int(7),int(6)]]),
3014		kernel_objects:equal_object(X,[(int(1),[int(6),int(7)])]))).
3015		:- assert_must_succeed((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
3016		[[int(7),int(6)]]),
3017		kernel_objects:equal_object(X,[([(int(1),int(2))],[int(6),int(7)]),
3018		([(int(2),int(3)),(int(1),int(3))],[int(6),int(7)])]))).
3019		:- assert_must_succeed((bsets_clp:total_function(X,[ [(int(1),int(3)),(int(2),int(3))]],
3020		[int(6)]),
3021		kernel_objects:equal_object(X,[ ([(int(2),int(3)),(int(1),int(3))], int(6)) ]))).
3022		:- assert_must_succeed((bsets_clp:total_function(X,global_set('Name'),
3023		[[],[fd(1,'Code'),fd(2,'Code')],[fd(1,'Code')],[fd(2,'Code')]]),
3024		kernel_objects:enumerate_basic_type(X,set(couple(global('Name'),set(global('Code'))))),
3025		kernel_objects:equal_object(X,[(fd(3,'Name'),[fd(2,'Code')]),(fd(1,'Name'),[fd(2,'Code')]),(fd(2,'Name'),[])]))).
3026
3027		%:- assert_must_succeed(( kernel_waitflags:init_wait_flags(WF),bsets_clp:total_function_wf(TF,global_set('Code'),
3028		% closure([zzzz],[set(set(couple(integer,boolean)))],
3029		% member(identifier(zzzz),
3030		% pow_subset(value(closure([zzzz],[set(couple(integer,boolean))],
3031		% member('ListExpression'(['Identifier'(zzzz)]),
3032		% 'Seq'(value([pred_true /* bool_true */,pred_false /* bool_false */])))))))),WF),
3033		% kernel_objects:equal_object(TF,[ (fd(1,'Code'), [[],[(int(1),pred_true /* bool_true */)],[(int(1),pred_true /* bool_true */),(int(2),pred_true /* bool_true */)]]),
3034		% (fd(2,'Code'), [[],[(int(1),pred_true /* bool_true */)],[(int(1),pred_true /* bool_true */),(int(2),pred_true /* bool_true */)]]) ]),
3035		% kernel_waitflags:ground_wait_flags(WF) )).
3036
3037		:- assert_must_succeed((bsets_clp:total_function([],[],[int(7)]))).
3038
3039		:- assert_must_fail((bsets_clp:total_function([],[int(1)],[int(7)]))).
3040		:- assert_must_fail((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]),
3041		kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
3042		:- assert_must_fail((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]),
3043		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(5))]))).
3044		:- assert_must_fail((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]),
3045		kernel_objects:equal_object(X,[(int(2),int(7))]))).
3046		:- assert_must_fail((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
3047		[int(7),int(6)]),
3048		kernel_objects:equal_object(X,[([(int(1),int(2))],int(7)),
3049		([(int(1),int(3)),(int(1),int(3))],int(6))]))).
3050		:- assert_must_fail((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
3051		[int(7),int(6)]),
3052		kernel_objects:equal_object(X,[([(int(1),int(3)),(int(1),int(3))],int(6))]))).
3053
3054		total_function(R,Domain,Range) :- init_wait_flags(WF,[total_function]),
3055		total_function_wf(R,Domain,Range,WF),
3056		ground_wait_flags(WF).
3057
3058
3059		:- assert_must_succeed((bsets_clp:total_function_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
3060		nonvar(X),X=[(A,B),(C,D)],A==int(1),C==int(2),\+ ground(B),\+ ground(D), B=int(7),D=int(7) )).
3061
3062		:- block total_function_wf(-,-,-,?).
3063		total_function_wf(FF,Domain,_Range,WF) :- FF == [],!,
3064		empty_set_wf(Domain,WF).
3065		total_function_wf(FF,Domain,Range,WF) :-
3066		Range == [],!,
3067		empty_set_wf(FF,WF), empty_set_wf(Domain,WF).
3068		total_function_wf(FF,Domain,Range,WF) :-
3069		% TO DO: if FF or Domain nonvar but \= [] -> check if other variable becomes []
3070	?	total_function_wf1(FF,Domain,Range,WF).
3071
3072		:- block total_function_wf1(?,-,?,?).
3073		total_function_wf1(FF,Domain,_Range,WF) :-
3074		FF==[],!,
3075		empty_set_wf(Domain,WF).
3076		total_function_wf1(FF,Domain,Range,WF) :-
3077		custom_explicit_sets:is_definitely_maximal_set(Range),
3078		% we do not need the Range; this means we can match more closures (e.g., lambda)
3079		(nonvar(FF)
3080	?	-> custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),
3081		!,
3082		equal_object_wf(FFDomain,Domain,total_function_wf1_1,WF)
3083		; var(FF),
3084		get_wait_flag1(WF,WF1), var(WF1),
3085		\+ (custom_explicit_sets:get_card_for_specific_custom_set(Domain,Card), number(Card)),
3086		% we have a total_function over a possibly infinite domain,
3087		% better wait: maybe a recursive of other closure will be produced for FF
3088		!,
3089		when( (nonvar(FF) ; nonvar(WF1)), total_function_wf1(FF,Domain,Range,WF))
3090		).
3091		total_function_wf1(FF,Domain,Range,WF) :- nonvar(FF),
3092		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_),WF),!,
3093		equal_object_wf(FFDomain,Domain,total_function_wf1_2,WF),
3094		check_range_subset_for_closure_wf(FF,FFRange,Range,WF).
3095		total_function_wf1(R,Domain,Range,WF) :- nonvar(R), R=avl_set(AEF), !,
3096	?	total_function_avl_set(AEF,Domain,Range,WF).
3097		total_function_wf1(FF,Domain,Range,WF) :-
3098		% want to replace FF by closure: needs to be a variable!
3099		var(FF),
3100		% if the total function can not be build up explicitly (i.e. infinite domain)
3101		% TODO: can / should this be relaxed?
3102		custom_explicit_sets:is_infinite_explicit_set(Domain), % get_card_for_specific_custom_set or is_infinite_or_symbolic_closure
3103		% TO DO: delay if Domain infinite or closure and not yet known and range is type
3104		kernel_objects:infer_value_type(Domain,set(DomT)),
3105		kernel_objects:infer_value_type(Range,set(RanT)),
3106		!,
3107		% IDEA : TF = %x.(x:Domain|DEFAULT) <+ SFF, where SFF is partial function and DEFAULT is some default value
3108		% build up a partial function instead (fulfilling all constraints)
3109		% better? : %x.(x:Domain|IF x:dom(SFF) THEN SFF(x) ELSE DEFAULT)?
3110		partial_function_wf(SFF,Domain,Range,WF),
3111		% next, build up a total function mapping everything to a default value
3112		% this function will be overriden by the partial function to fulfilling
3113		% given constraints
3114		% 1. identifiers for closure
3115		create_texpr(identifier('__domid__'),DomT,[],TDomId),
3116		create_texpr(identifier('__ranid__'),RanT,[],TRanId),
3117		% 2. domain identifier might take all values of the domain
3118		create_texpr(member(TDomId,b(value(Domain),set(DomT),[])),pred,[],DomMember),
3119		% 3. pick a single value for the range identifier
3120		check_element_of_wf(RangeElement,Range,WF),
3121		%% external_functions:observe_value(RangeElement,"range"),external_functions:observe_value(SFF,"pf"),
3122		create_texpr(equal(TRanId,b(value(RangeElement),RanT,[])),pred,[],RanMember),
3123		% 4. conjunct and form closure (should be treated symbolically)
3124		conjunct_predicates([RanMember,DomMember],Pred),
3125		Default = closure(['__domid__','__ranid__'],[DomT,RanT],Pred),
3126		% 5. override default values where needed
3127		override_relation(Default,SFF,FF,WF),
3128		get_last_wait_flag(enum_symb_tf,WF,LastWF),
3129		when(nonvar(LastWF), % if we enum too early test 1619 fails; see also test 2022
3130		% as partial_function_wf does not fully enumerate the new variable SFF we may have to enumerate SFF; see test 2328
3131		(enumerate_basic_type_wf(RangeElement,RanT,WF),
3132		enumerate_basic_type_wf(SFF,set(couple(DomT,RanT)),WF)
3133		)).
3134		total_function_wf1(R,Domain,Range,WF) :-
3135		try_expand_and_convert_to_avl_with_check(Domain,EDomain,keep_intervals(1000),total_function), % avoid multiple expansions, but useless when dom_for_lambda_closure case triggers below ! TO DO: fix
3136		% TO DO: maybe avoid converting intervals which are not fully instantiated ?
3137		% TODO: done by clause above? % TO DO ?: if Range singleton set {R} and Domain infinite: return %x.(x:Domain|R); if Range not empty choose one element
3138		try_expand_and_convert_to_avl_unless_large_wf(R,ER,WF),
3139		propagate_empty_set_wf(Range,tf_range,ER,WF), % if the range of a total function is empty then the function must be empty
3140	?	total_function_wf2(ER,EDomain,Range,WF).
3141
3142		:- block total_function_wf2(?,-,?,?).
3143		total_function_wf2(R,Domain,Range,WF) :- nonvar(R), R=avl_set(AEF), !,
3144		total_function_avl_set(AEF,Domain,Range,WF).
3145		total_function_wf2(R,Domain,Range,WF) :-
3146		cardinality_as_int_wf(Domain,int(Card),WF),
3147	?	total_function_wf3(R,Card,Domain,Range,WF).
3148
3149		:- use_module(kernel_card_arithmetic,[is_inf_or_overflow_card/1]).
3150		total_function_wf3(FF,Card,Domain,Range,WF) :-
3151		nonvar(FF),
3152		(number(Card) -> (Card >= 1000 -> true ; is_symbolic_closure(FF)) ; true),
3153		% note: we can have symbolic closures with a finite domain: /*@symbolic */ %p.(p:BOOL|(%t.(t:NATURAL|t+100)))
3154		custom_explicit_sets:dom_for_lambda_closure(FF,FFDomain),
3155		% we have a lambda closure where we cannot determine the range,
3156		% otherwise dom_range_for_specific_closure would have succeeded
3157		% example: f = %x.(x:NATURAL1|x+1) & f: NATURAL1 --> NATURAL
3158		FF = closure(P,T,Pred),
3159		get_range_id_expression(P,T,TRangeID),
3160		!,
3161		equal_object_wf(FFDomain,Domain,total_function1_closure,WF),
3162		% CHECK not(#P.(Pred & P /: Range))
3163		check_lambda_closure_range(P,T,Pred,TRangeID,Range,WF).
3164		total_function_wf3(R,Card,Domain,Range,WF) :- nonvar(Card),is_inf_or_overflow_card(Card),!,
3165		when(nonvar(R), total_function_symbolic(R,Domain,Range,WF)).
3166		total_function_wf3(R,Card,Domain,Range,WF) :-
3167		card_convert_int_to_peano(Card,PeanoCard),
3168		((nonvar(R);ground(PeanoCard))
3169		-> true
3170		; get_last_wait_flag(total_fun(Domain),WF,WF1)),
3171	?	when((nonvar(R);ground(PeanoCard);
3172		(nonvar(PeanoCard),nonvar(WF1))), /* mal 12/5/04: changed , into ; 17/3/2008: added WF1 */
3173		/* reason for delaying nonvar(Card): Card grounded bit by bit by cardinality; avoid
3174		triggering too early and missing tf_var */
3175		total_function1(R,Card,PeanoCard,Domain,Range,WF
3176		)).
3177
3178		:- use_module(library(lists),[last/2]).
3179		% for a closure get the identifier or proj expression that represents range values
3180		get_range_id_expression([PairID],[Type],Res) :- !,
3181		Type = couple(_,TX),
3182		TP = b(identifier(PairID),Type,[]),
3183		safe_create_texpr(second_of_pair(TP),TX,Res). % prj2(PairID) ,
3184		%TO DO: test this e.g. with f = /*@symbolic*/ {x|x:NATURAL1*INTEGER & prj2(INTEGER,INTEGER)(x)=prj1(INTEGER,INTEGER)(x)+1} & f: NATURAL1 --> NATURAL
3185		% but currently lambda closure detection in dom_for_lambda_closure cannot handle such closures anyway
3186		get_range_id_expression(P,T,b(identifier(ID),Type,[])) :- last(P,ID), last(T,Type).
3187
3188		total_function_avl_set(AEF,Domain,Range,WF) :-
3189		(Domain = avl_set(Dom) -> is_avl_total_function_over_domain(AEF,Dom)
3190		; is_avl_partial_function(AEF),
3191		domain_of_explicit_set_wf(avl_set(AEF),AEF_Domain,WF),
3192		equal_object_wf(AEF_Domain,Domain,total_function_avl_set,WF)
3193		),
3194	?	is_avl_relation_over_range(AEF,Range,WF).
3195
3196		total_function_symbolic(FF,Domain,Range,WF) :-
3197		(debug_mode(off) -> true ; print('SYMBOLIC --> check : '),translate:print_bvalue(FF),nl),
3198		% can deal with, e.g., f = %x.(x:NATURAL|x+1) & g = f <+ {0|->0} & g : INTEGER +-> INTEGER
3199		domain_wf(FF,Domain,WF),
3200		symbolic_range_subset_check(FF,Range,WF),
3201		symbolic_functionality_check(FF,WF).
3202
3203		total_function1(FF,Card,PeanoCard,Domain,Range,WF) :- nonvar(Card),is_inf_or_overflow_card(Card),
3204		nonvar(PeanoCard),is_inf_or_overflow_card(PeanoCard),!,
3205		total_function_symbolic(FF,Domain,Range,WF).
3206		total_function1(FF,_,_,Domain,Range,WF) :-
3207		expand_and_convert_to_avl_set_catch(FF,AEF,total_function1,'ARG : ? --> ?',ResultStatus,WF),!,
3208		(ResultStatus=avl_set -> total_function_avl_set(AEF,Domain,Range,WF)
3209		; % keep symbolic
3210		% TO DO: ensure no pending co-routine infinite_peano in card_convert_int_to_peano
3211		total_function_symbolic(FF,Domain,Range,WF)
3212		).
3213		total_function1(R,_,Card,Domain,Range,WF) :-
3214		try_expand_custom_set_wf(R,ER,total_function1,WF),
3215	?	total_function2(ER,Card,Domain,Range,WF).
3216
3217		total_function2(ER,Card,Domain,Range,WF) :-
3218		var(ER),ground(Card),!,
3219		tf_var(TotalFunction,[],Card,Domain,Range,WF),
3220		ER=TotalFunction.
3221		total_function2(ER,Card,Domain,Range,WF) :-
3222		(ground(Card)
3223		-> get_wait_flag(0,tot_fun,WF,LWF) % we seem to know the domain exactly now; see e.g. test 1316
3224		; get_wait_flag(2,total_function2,WF,LWF)), % ensure we don't start binding function as soon as Card is bound; important for test 1393; should we use another priority ?
3225	?	tf(ER,[],Card,Domain,Range,WF,LWF).
3226
3227		:- block tf(-,?,-,?,?,?,?),tf(-,?,?,?,?,?,-).
3228		tf([],_,0,Dom,_,WF,_) :- empty_set_wf(Dom,WF).
3229		tf(FUN,SoFar,s(Card),Dom,Ran,WF,LWF) :- var(FUN),nonvar(Dom), % try setting up skeleton for total fun
3230		remove_exact_first_element(X,Dom,Dom2),not_element_of_wf(X,SoFar,WF),var(FUN),!,
3231		FUN = [(X,Y)|T], tf1(X,Y,T,SoFar,Card,Dom2,Ran,WF,LWF).
3232		tf([(X,Y)|T],SoFar,s(Card),Dom,Ran,WF,LWF) :-
3233		not_element_of_wf(X,SoFar,WF),
3234		remove_element_wf(X,Dom,Dom2,WF), %mal: 17/3/08 changed to _wf version
3235	?	tf1(X,Y,T,SoFar,Card,Dom2,Ran,WF,LWF).
3236		tf(CS,SoFar,Card,Dom,Ran,WF,LWF) :- nonvar(CS), is_custom_explicit_set(CS),
3237		expand_custom_set_to_list_wf(CS,ER,_,tf,WF),
3238		tf(ER,SoFar,Card,Dom,Ran,WF,LWF).
3239		tf1(X,Y,T,SoFar,Card,Dom2,Ran,WF,LWF) :-
3240		check_element_of_wf(Y,Ran,WF),
3241		%when((nonvar(T);nonvar(Card)), /* mal 12/5/04: changed , into ; */
3242		add_new_element_wf(X,SoFar,SoFar2,WF), %%% try_expand_and_convert_to_avl
3243	?	tf(T,SoFar2,Card,Dom2,Ran,WF,LWF).
3244
3245		:- block tf_var(-,?,-,?,?,?).
3246		tf_var(F,_,Card,Dom,_,WF) :- Card==0,!,F=[],empty_set_wf(Dom,WF). % avoid choice point
3247		tf_var([],_,0,Dom,_,WF) :- empty_set_wf(Dom,WF).
3248		tf_var([(X,Y)|T],SoFar,s(Card),Dom,Ran,WF) :-
3249		/* supposes that X + Y are unbound */
3250		/* TO DO: rewrite like enumerate <-------------------------- */
3251		((var(X),var(Y)) -> true ; (print_message(warning,'Nonvar in tf_var: '),
3252		print_message(warning,((X,Y))))),
3253		remove_exact_first_element(X,Dom,Dom2),
3254		not_element_of_wf(X,SoFar,WF),
3255		check_element_of_wf(Y,Ran,WF),
3256		add_new_element_wf(X,SoFar,SoFar2,WF),
3257		tf_var(T,SoFar2,Card,Dom2,Ran,WF).
3258
3259
3260
3261		:- assert_must_succeed((bsets_clp:total_bijection(X,[int(1)],[int(7)]),
3262		X = [(int(1),int(7))])).
3263		:- assert_must_succeed((bsets_clp:total_bijection(X,[int(1),int(2)],[int(7),int(8)]),
3264		kernel_objects:equal_object(X,[(int(2),int(8)),(int(1),int(7))]))).
3265		:- assert_must_fail((bsets_clp:total_bijection(X,[int(1)],[int(7),int(3)]),
3266		X = [(int(1),int(7))])).
3267		:- assert_must_fail((bsets_clp:total_bijection(X,[int(1),int(2)],[int(3)]),
3268		X = [(int(1),int(3)),(int(2),int(3))])).
3269		:- assert_must_fail((bsets_clp:total_bijection(X,[int(1),int(2)],[int(7),int(8)]),
3270		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
3271		:- assert_must_fail((bsets_clp:total_bijection(X,[int(1),int(2)],[int(7),int(8)]),
3272		X = [(int(1),int(7)),(int(1),int(8))])).
3273
3274
3275
3276		total_bijection(R,Domain,Range) :- init_wait_flags(WF,[total_bijection]),
3277		total_bijection_wf(R,Domain,Range,WF),
3278		ground_wait_flags(WF).
3279
3280		:- block total_bijection_wf(?,-,?,?).
3281		total_bijection_wf(FF,Domain,Range,WF) :- nonvar(FF),
3282		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection),WF),!,
3283		equal_object_wf(FFDomain,Domain,total_bijection_wf_1,WF),
3284		equal_object_wf(FFRange,Range,total_bijection_wf_2,WF).
3285		%(R,Domain,Range,WF) :- Domain==Range,!, print(eq_domain_range),nl, total_injection_wf(R,Domain,Range,WF).
3286		total_bijection_wf(R,Domain,Range,WF) :-
3287		same_cardinality_wf(Domain,Range,WF),
3288	?	total_injection_wf2(R,Domain,Range,WF). % TO DO: use cardinality_as_int_wf ? makes test 1194 fail
3289
3290		%Note: we used to call custom code: total_bijection_wf2(R,Domain,Card,Range,WF).
3291		% total_injection_wf2 gives a considerable performance boost, e.g., for test 1222 ClearSy/alloc_large.mch or NQueens with >->>
3292
3293		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_function([(int(1),int(6)),(int(2),int(7))],[int(1),int(2),int(3)],[int(7),int(6)],WF),WF)).
3294		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_function([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(8),int(6)],WF),WF)).
3295		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_function([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
3296		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_function([(int(1),int(6)),(int(1),int(7))],[int(1)],[int(7),int(6)],WF),WF)).
3297		:- assert_must_fail((bsets_clp:not_total_function(X,[int(1)],[int(7)],_WF),
3298		X = [(int(1),int(7))])).
3299		:- assert_must_fail((bsets_clp:not_total_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
3300		X = [(int(2),int(7)),(int(1),int(7))])).
3301		:- assert_must_succeed((bsets_clp:not_total_function([],[int(1)],[int(7)],_WF))).
3302		:- assert_must_succeed((bsets_clp:not_total_function([],[global_set('NAT1')],[global_set('Name')],_WF))).
3303		:- assert_must_succeed((bsets_clp:not_total_function([(int(7),int(7))],[int(1)],[int(7)],_WF))).
3304		:- assert_must_succeed((bsets_clp:not_total_function([(int(1),int(7)), (int(2),int(1))],
3305		[int(1),int(2)],[int(7)],_WF))).
3306		:- assert_must_succeed((bsets_clp:not_total_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
3307		X = [(int(2),int(7)),(int(2),int(6))])).
3308
3309		:- block not_total_function(-,?,?,?), not_total_function(?,-,?,?).
3310		not_total_function(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
3311		% we do not need the Range; this means we can match more closures (e.g., lambda)
3312	?	custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
3313		not_equal_object_wf(FFDomain,Domain,WF).
3314		not_total_function(FF,Domain,Range,WF) :- nonvar(FF),
3315		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_),WF),!,
3316		equality_objects_wf(FFDomain,Domain,Result,WF), % not yet implemented ! % TODO ! -> sub_set,equal,super_set
3317		when(nonvar(Result),(Result=pred_false -> true ; not_subset_of_wf(FFRange,Range,WF))).
3318		not_total_function(FF,Domain,Range,WF) :- nonvar(FF), FF=closure(P,T,Pred),
3319		% example: f = %t.(t : NATURAL|t + 100) & f /: NATURAL +-> NATURAL
3320		is_lambda_value_domain_closure(P,T,Pred, FFDomain,_Expr),
3321		get_range_id_expression(P,T,TRangeID),!,
3322		equality_objects_wf(FFDomain,Domain,SubRes,WF), % compare: subset_test for not_partial_function
3323		when(nonvar(SubRes),
3324		(SubRes=pred_false -> true % not equal -> it is not a total function over the domain
3325		; check_not_lambda_closure_range(P,T,Pred,TRangeID,Range,WF))).
3326		not_total_function(R,Domain,Range,WF) :-
3327		try_expand_and_convert_to_avl_with_check(R,ER,not_total_function_range),
3328		try_expand_and_convert_to_avl_unless_large_wf(Range,ERange,WF),
3329		not_total_function2(ER,Domain,ERange,WF).
3330
3331		% repeat block, in case Domain or R is a closure
3332		:- block not_total_function2(-,?,?,?), not_total_function2(?,-,?,?).
3333		not_total_function2(R,Domain,Range,WF) :-
3334		expand_and_convert_to_avl_set_warn(R,AER,not_total_function2,'ARG /: ? --> ?',WF),
3335		!,
3336		not_total_function_avl(AER,Domain,Range,WF).
3337		not_total_function2(R,Domain,ERange,WF) :-
3338		expand_custom_set_to_list_wf(R,ER,_,not_total_function2,WF),
3339		try_expand_and_convert_to_avl_with_check(Domain,EDomain,keep_intervals(1000),not_total_function_domain),
3340		not_tf(ER,[],EDomain,ERange,WF).
3341
3342		not_total_function_avl(_AER,Domain,_Range,_WF) :- is_infinite_explicit_set(Domain),!,
3343		true. % a finite AVL set cannot be a total function over an infinite domain
3344		not_total_function_avl(AER,Domain,Range,WF) :-
3345		expand_and_convert_to_avl_set_warn(Domain,ADom,not_total_function2,'? /: ARG --> ?',WF),
3346		!,
3347		(is_avl_total_function_over_domain(AER,ADom)
3348		->
3349		is_not_avl_relation_over_range(AER,Range,WF)
3350		; true
3351		).
3352		not_total_function_avl(AER,EDomain,ERange,WF) :-
3353		expand_custom_set_to_list_wf(avl_set(AER),ER,_,not_total_function_avl,WF),
3354		not_tf(ER,[],EDomain,ERange,WF).
3355
3356
3357		:- use_module(kernel_equality,[membership_test_wf_with_force/4]).
3358
3359		:- block not_tf(-,?,?,?,?).
3360		not_tf([],_,Domain,_,WF) :- not_empty_set_wf(Domain,WF).
3361		not_tf([(X,Y)|T],SoFar,Dom,Ran,WF) :- membership_test_wf_with_force(SoFar,X,MemRes,WF),
3362		not_tf2(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
3363
3364		:- block not_tf2(-,?,?,?, ?,?,?,?). %, not_tf2(?,?,?,?, -,?,?), not_tf2(?,?,?,?, ?,-,?).
3365		not_tf2(pred_true,_X,_,_T,_SoFar,_Dom,_Ran,_WF).% :- check_element_of_lazy(X,SoFar,WF).
3366		not_tf2(pred_false,X,Y,T,SoFar,Dom,Ran,WF) :-
3367		%not_element_of_wf(X,SoFar,WF),
3368		membership_test_wf_with_force(Dom,X,MemRes,WF),
3369		not_tf3(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
3370
3371		:- block not_tf3(-, ?,?,?,?, ?,?,?).
3372		not_tf3(pred_false,_X,_Y,_T,_SoFar,_Dom,_Ran,_WF).
3373		not_tf3(pred_true,X,Y,T,SoFar,Dom,Ran,WF) :-
3374		remove_element_wf(X,Dom,Dom2,WF),
3375		membership_test_wf_with_force(Ran,Y,MemRes,WF),
3376		not_tf4(MemRes,X,Y,T,SoFar,Dom2,Ran,WF).
3377
3378		:- block not_tf4(-, ?,?,?,?, ?,?,?).
3379		not_tf4(pred_false,_X,_Y,_T,_SoFar,_Dom2,_Ran,_WF).
3380		not_tf4(pred_true,X,_Y,T,SoFar,Dom2,Ran,WF) :-
3381		%check_element_of_wf(Y,Ran,WF), %DO WE NEED THIS ????
3382		add_new_element_wf(X,SoFar,SoFar2,WF),
3383		not_tf(T,SoFar2,Dom2,Ran,WF).
3384
3385
3386
3387		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_bijection([(int(1),int(6)),(int(2),int(7))],[int(1),int(2),int(3)],[int(7),int(6)],WF),WF)).
3388		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_bijection([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(8),int(6)],WF),WF)).
3389		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_bijection([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
3390		:- assert_must_fail((bsets_clp:not_total_bijection(X,[int(1)],[int(7)],_WF),
3391		X = [(int(1),int(7))])).
3392		:- assert_must_fail((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF),
3393		X = [(int(2),int(7)),(int(1),int(6))])).
3394		:- assert_must_fail((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF),
3395		X = [(int(1),int(7)),(int(2),int(6))])).
3396		:- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(3)],_WF),
3397		X = [(int(1),int(3)),(int(2),int(3))])).
3398		:- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF),
3399		X = [(int(2),int(7)),(int(1),int(7))])).
3400		:- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1)],[int(7),int(8)],_WF),
3401		X = [(int(1),int(7))])).
3402		:- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7)],_WF),
3403		X = [(int(2),int(7))])).
3404		:- assert_must_succeed((bsets_clp:not_total_bijection([],[int(1)],[int(7)],_WF))).
3405		:- assert_must_succeed((bsets_clp:not_total_bijection([(int(7),int(7))],[int(1)],[int(7)],_WF))).
3406		:- assert_must_succeed((bsets_clp:not_total_bijection([(int(1),int(7)), (int(2),int(1))],
3407		[int(1),int(2)],[int(7)],_WF))).
3408		:- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF),
3409		X = [(int(2),int(7)),(int(2),int(6))])).
3410
3411		:- block not_total_bijection(-,?,?,?), not_total_bijection(?,-,?,?).
3412		not_total_bijection(FF,Domain,Range,WF) :-
3413		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection),WF),!,
3414		not_equal_object_wf((FFDomain,FFRange),(Domain,Range),WF).
3415		not_total_bijection(avl_set(_),Domain,_Range,_WF) :-
3416	?	is_infinite_explicit_set(Domain),!.
3417		% a finite set cannot be a total bijection over an infinite domain, see test 1641
3418		not_total_bijection(R,Domain,Range,WF) :-
3419		try_expand_custom_set_wf(R,ER,not_total_bijection,WF),
3420		not_tot_bij(ER,[],Domain,Range,WF).
3421
3422		:- block not_tot_bij(-,?,?,?,?).
3423		not_tot_bij([],_,Domain,Range,WF) :- empty_not_tot_bij(Domain,Range,WF).
3424		not_tot_bij([(X,Y)|T],SoFar,Dom,Ran,WF) :- membership_test_wf(SoFar,X,MemRes,WF),
3425		not_tot_bij2(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
3426
3427		:- use_module(kernel_equality,[empty_set_test_wf/3]).
3428		:- block empty_not_tot_bij(-,?,?).
3429		empty_not_tot_bij(Domain,Range,WF) :-
3430		empty_set_test_wf(Domain,EqRes,WF),
3431		empty_not_tot_bij2(EqRes,Range,WF).
3432		:- block empty_not_tot_bij2(-,?,?).
3433		empty_not_tot_bij2(pred_false,_,_).
3434		empty_not_tot_bij2(pred_true,Range,WF) :- not_empty_set_wf(Range,WF).
3435
3436		:- block not_tot_bij2(-,?,?,?,?,?,?,?).
3437		not_tot_bij2(pred_true,_X,_,_T,_SoFar,_Dom,_Ran,_WF).
3438		not_tot_bij2(pred_false,X,Y,T,SoFar,Dom,Ran,WF) :-
3439		membership_test_wf(Dom,X,MemRes,WF),
3440		not_tot_bij3(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
3441
3442		:- block not_tot_bij3(-,?,?,?,?,?,?,?).
3443		not_tot_bij3(pred_false,_X,_,_T,_SoFar,_Dom,_Ran,_WF). % X not a member of domain
3444		not_tot_bij3(pred_true,X,Y,T,SoFar,Dom,Ran,WF) :-
3445		remove_element_wf(X,Dom,Dom2,WF),
3446		membership_test_wf(Ran,Y,MemRes,WF),
3447		not_tot_bij4(MemRes,X,Y,T,SoFar,Dom2,Ran,WF).
3448
3449		:- block not_tot_bij4(-,?,?,?,?,?,?,?).
3450		not_tot_bij4(pred_false,_X,_,_T,_SoFar,_Dom2,_Ran,_WF). % Y not a member of range
3451		not_tot_bij4(pred_true,X,Y,T,SoFar,Dom2,Ran,WF) :-
3452		remove_element_wf(Y,Ran,Ran2,WF),
3453		add_element_wf(X,SoFar,SoFar2,WF),
3454		not_tot_bij(T,SoFar2,Dom2,Ran2,WF).
3455
3456
3457
3458		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_restriction_wf([(int(1),int(2)),(int(2),int(3))],[int(3)],[(int(2),int(3))],WF),WF)).
3459		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_restriction_wf([(int(1),int(2)),(int(2),int(3))],[int(2),int(3)],[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3460		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_restriction_wf([],[int(2),int(3)],[],WF),WF)).
3461		:- assert_must_succeed((bsets_clp:range_restriction_wf([],[int(1)],[],_WF))).
3462		:- assert_must_succeed((bsets_clp:range_restriction_wf([],[],[],_WF))).
3463		:- assert_must_succeed((bsets_clp:range_restriction_wf([(int(1),int(2))],[int(1)],[],_WF))).
3464		:- assert_must_succeed((bsets_clp:range_restriction_wf([(int(1),int(2))],[int(2)],[(int(1),int(2))],_WF))).
3465		:- assert_must_succeed((bsets_clp:range_restriction_wf(X,[fd(3,'Name')],R,_WF),
3466		X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],
3467		kernel_objects:equal_object(X,R))).
3468		:- assert_must_succeed((bsets_clp:range_restriction_wf(X,Y,R,_WF),
3469		X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],Y=global_set('Name'),
3470		kernel_objects:equal_object(X,R))).
3471		:- assert_must_fail((bsets_clp:range_restriction_wf(X,[fd(3,'Name')],R,_WF),
3472		X = [(int(1),fd(3,'Name')),(int(2),fd(1,'Name'))],
3473		kernel_objects:equal_object(X,R))).
3474
3475		:- block range_restriction_wf(-,?,?,?),range_restriction_wf(?,-,-,?).
3476
3477		range_restriction_wf(R,S,Res,WF) :- /* R |> S */
3478		ok_to_try_restriction_explicit_set(S,R,Res),
3479		range_restriction_explicit_set_wf(R,S,SR,WF),!,
3480		equal_object_wf(SR,Res,range_restriction,WF).
3481		range_restriction_wf(R,S,Res,WF) :- /* R |> S */
3482		expand_custom_set_to_list_wf(R,ER,_,range_restriction,WF),
3483		relation_restriction_wf(ER,S,Res,pred_true,range,WF).
3484
3485		% heuristic: should we try restriction_explicit_set or
3486		% is relation_restriction with its stronger constraint propagation better
3487		ok_to_try_restriction_explicit_set(S,R,Res) :-
3488		nonvar(S),
3489		(var(Res) -> true
3490		; S=avl_set(_),
3491		nonvar(R), R=avl_set(_) % otherwise constraint propagation from normal relation_restriction better
3492		).
3493
3494		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_subtraction_wf([],[int(2)],[],WF),WF)).
3495		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_subtraction_wf([(int(1),int(2)),(int(2),int(3))],[int(2)],[(int(2),int(3))],WF),WF)).
3496		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_subtraction_wf([(int(1),int(2)),(int(2),int(3))],[],[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3497		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_subtraction_wf([(int(1),int(2)),(int(2),int(3))],[int(1)],[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3498
3499		:- block range_subtraction_wf(-,?,?,?),range_subtraction_wf(?,-,-,?).
3500		range_subtraction_wf(R,S,Res,WF) :- /* R |>> S */
3501		S==[],!,
3502		equal_object_wf(R,Res,range_subtraction1,WF).
3503		range_subtraction_wf(R,S,Res,WF) :- /* R |>> S */
3504		ok_to_try_restriction_explicit_set(S,R,Res),
3505		range_subtraction_explicit_set_wf(R,S,SR,WF),!,
3506		equal_object_wf(SR,Res,range_subtraction2,WF).
3507		range_subtraction_wf(R,S,Res,WF) :- /* R |>> S */
3508		expand_custom_set_to_list_wf(R,ER,_,range_subtraction,WF),
3509		relation_restriction_wf(ER,S,Res,pred_false,range,WF).
3510
3511		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_range_restriction_wf((int(2),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(33),int(3)],WF),WF)).
3512		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_range_restriction_wf((int(1),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(3)],WF),WF)).
3513
3514		:- block in_range_restriction_wf(-,-,-,?).
3515		in_range_restriction_wf(Pair,Rel,Set,WF) :-
3516		(treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel)
3517		; preference(convert_comprehension_sets_into_closures,true)),
3518		!,
3519		Rel \== [], % avoid setting up check_element_of for X then
3520		% x |-> y : Rel |>> Set <=> x|->y : Rel & y: Set
3521		check_element_of_wf(Pair,Rel,WF),
3522		Pair = (_,P2),
3523		check_element_of_wf(P2,Set,WF).
3524		in_range_restriction_wf(Pair,Rel,Set,WF) :-
3525		range_restriction_wf(Rel,Set,Res,WF),
3526		check_element_of_wf(Pair,Res,WF).
3527
3528		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_range_restriction_wf((int(2),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(1),int(2)],WF),WF)).
3529		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_range_restriction_wf((int(11),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(33),int(2)],WF),WF)).
3530
3531		:- block not_in_range_restriction_wf(-,-,-,?).
3532		not_in_range_restriction_wf(Pair,Rel,Set,WF) :-
3533		range_restriction_wf(Rel,Set,Res,WF),
3534		not_element_of_wf(Pair,Res,WF).
3535
3536		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_range_subtraction_wf((int(2),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(33),int(1)],WF),WF)).
3537		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_range_subtraction_wf((int(1),int(3)),[(int(2),int(3)),(int(1),int(3))],[],WF),WF)).
3538
3539		:- block in_range_subtraction_wf(-,-,-,?).
3540		in_range_subtraction_wf(Pair,Rel,Set,WF) :-
3541		(treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel)
3542		; preference(convert_comprehension_sets_into_closures,true)),
3543		!,
3544		Rel \== [], % avoid setting up check_element_of for X then
3545		% x |-> y : Rel |>> Set <=> x|->y : Rel & y/: Set
3546		check_element_of_wf(Pair,Rel,WF),
3547		Pair = (_,P2),
3548		not_element_of_wf(P2,Set,WF).
3549		in_range_subtraction_wf(Pair,Rel,Set,WF) :-
3550		range_subtraction_wf(Rel,Set,Res,WF),
3551		check_element_of_wf(Pair,Res,WF).
3552
3553		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_range_subtraction_wf((int(2),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(3),int(2)],WF),WF)).
3554		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_range_subtraction_wf((int(11),int(3)),[(int(2),int(3)),(int(1),int(3))],[int(33),int(2)],WF),WF)).
3555
3556		:- block not_in_range_subtraction_wf(-,-,-,?).
3557		not_in_range_subtraction_wf(Pair,Rel,Set,WF) :-
3558		range_subtraction_wf(Rel,Set,Res,WF),
3559		not_element_of_wf(Pair,Res,WF).
3560
3561
3562
3563		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_domain_restriction_wf((int(2),int(3)),[int(33),int(2)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3564		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_domain_restriction_wf((int(1),int(3)),[int(1)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3565
3566		:- block in_domain_restriction_wf(-,-,-,?).
3567		in_domain_restriction_wf(Pair,Set,Rel,WF) :-
3568		(treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel)
3569		; preference(convert_comprehension_sets_into_closures,true)),
3570		!,
3571		Rel \== [], % avoid setting up check_element_of for X then
3572		% x |-> y : Set <| Rel <=> x|->y : Rel & x: Set
3573		check_element_of_wf(Pair,Rel,WF),
3574		Pair = (P1,_),
3575		check_element_of_wf(P1,Set,WF).
3576		in_domain_restriction_wf(Pair,Set,Rel,WF) :-
3577		domain_restriction_wf(Set,Rel,Res,WF),
3578		check_element_of_wf(Pair,Res,WF).
3579
3580		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_domain_restriction_wf((int(2),int(3)),[int(33),int(1)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3581		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_domain_restriction_wf((int(11),int(3)),[int(11),int(2)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3582
3583		:- block not_in_domain_restriction_wf(-,-,-,?).
3584		not_in_domain_restriction_wf(Pair,Set,Rel,WF) :-
3585		domain_restriction_wf(Set,Rel,Res,WF),
3586		not_element_of_wf(Pair,Res,WF).
3587
3588		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_restriction_wf([int(2),int(4)],[(int(1),int(4)),(int(2),int(3))],[(int(2),int(3))],WF),WF)).
3589		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_restriction_wf([int(1),int(2)],[(int(1),int(2)),(int(2),int(3))],[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3590		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_restriction_wf([int(2),int(3)],[],[],WF),WF)).
3591		:- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[],[],_WF))).
3592		:- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[],R,_WF), R==[])).
3593		:- assert_must_fail((bsets_clp:domain_restriction_wf(_,[],R,_WF), R=[int(_)|_])).
3594		:- assert_must_succeed((bsets_clp:domain_restriction_wf([int(2)],[(int(1),int(2))],[],_WF))).
3595		:- assert_must_succeed((bsets_clp:domain_restriction_wf([],[(int(1),int(2))],[],_WF))).
3596		:- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[(int(1),int(2))],[(int(1),int(2))],_WF))).
3597		:- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[(int(1),int(2)),(int(2),_)],_,_WF))).
3598		:- assert_must_succeed((bsets_clp:domain_restriction_wf([int(2),int(1)],X,R,_WF),
3599		X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],
3600		kernel_objects:equal_object(X,R))).
3601
3602
3603		:- block domain_restriction_wf(?,-,?,?),domain_restriction_wf(-,?,-,?).
3604		domain_restriction_wf(S,R,Res,WF) :- /* S <| R */
3605		ok_to_try_restriction_explicit_set(S,R,Res),
3606		domain_restriction_explicit_set_wf(S,R,SR,WF),!,
3607		equal_object_wf(SR,Res,domain_restriction,WF).
3608		domain_restriction_wf(S,R,Res,WF) :- /* S <| R */
3609		expand_custom_set_to_list_wf(R,ER,_,domain_restriction,WF),
3610		relation_restriction_wf(ER,S,Res,pred_true,domain,WF).
3611
3612		% a predicate to compute domain/range restriction/subtraction
3613		:- block relation_restriction_wf(?,-,- ,?,?,?),
3614		relation_restriction_wf(-,?,? ,?,?,?).
3615		relation_restriction_wf([],_S,Res,_AddWhen,_DomOrRange,WF) :-
3616	?	empty_set_wf(Res,WF).
3617		relation_restriction_wf([(X,Y)|T],S,Res,AddWhen,DomOrRange,WF) :-
3618		(DomOrRange=domain
3619		-> membership_test_wf(S,X,MemRes,WF) % TO DO: pass WF !
3620		; membership_test_wf(S,Y,MemRes,WF)),
3621		(nonvar(MemRes)
3622		%MemRes==AddWhen % MemRes already set; we will ensure that (X,Y) in Res below; this slows down Alstom Compilation Regle !
3623		% doing the membership_test on the result Res if MemRes\==AddWhen only makes sense if we cannot fully compute the restriction ?? i.e. if T is not a closed list ?
3624		-> true %,(MemRes==AddWhen -> true ; print_term_summary(relation_restriction([(X,Y)|T],S,Res,AddWhen,DomOrRange)),nl)
3625		; (AddWhen=pred_true -> InResult=MemRes
3626		; negate(InResult,MemRes)), % from bool_pred
3627		membership_test_wf(Res,(X,Y),InResult,WF)
3628		% TO DO: same for explicit version; gets called e.g. if S = 1..n (1..n <| [1,2,3] = [1,2])
3629		% can now solve e.g. {x|x <| [1,2,3] = [1,2] & card(x)=2} = {{1,2}}
3630		% or x <| s = [1,2,3] \/ {29|->29} & x <: 1..100 & s = %i.(i:1..50|i)
3631		),
3632		relation_restriction_aux(MemRes,X,Y,T,S,Res,AddWhen,DomOrRange,WF).
3633		:- block relation_restriction_aux(-,?,?,?,?,?, ?,?,?).
3634		relation_restriction_aux(MemRes,X,Y,T,S,Res,AddWhen,DomOrRange,WF) :-
3635		MemRes==AddWhen,!, % (X,Y) should be added to result
3636		% TO DO: collect result until we delay ? and then do equal_object ?
3637		equal_cons(Res,(X,Y),RT), % was : equal_object([(X,Y)|RT],Res),
3638		%equal_cons_wf(Res,(X,Y),RT,WF), % makes tests 982, 1302, 1303 fail; TO DO: investigate
3639		%when(nonvar(RT), % causes problem for test 982
3640	?	relation_restriction_wf(T,S,RT,AddWhen,DomOrRange,WF).
3641		relation_restriction_aux(_MemRes,_X,_,T,S,RT,AddWhen,DomOrRange,WF) :-
3642		% the couple is filtered out
3643	?	relation_restriction_wf(T,S,RT,AddWhen,DomOrRange,WF).
3644
3645
3646		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_subtraction_wf([int(1),int(3)],[(int(1),int(4)),(int(2),int(3))],[(int(2),int(3))],WF),WF)).
3647		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_subtraction_wf([int(3),int(4)],[(int(1),int(2)),(int(2),int(3))],[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3648		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_subtraction_wf([int(1)],[],[],WF),WF)).
3649		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_subtraction_wf([],[(int(11),int(21))],[(int(11),int(21))],WF),WF)).
3650		:- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(1)],[(int(1),int(2))],[],_WF))).
3651		:- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(3)],[(int(1),int(2))],[(int(1),int(2))],_WF))).
3652		:- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(1)],[(int(1),int(2)),(int(2),int(X))],R,_WF),
3653		R=[(int(2),int(YY))], YY==X)).
3654		:- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(5),int(3)],X,R,_WF),
3655		X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],
3656		kernel_objects:equal_object(X,R))).
3657		:- block domain_subtraction_wf(?,-,?,?),domain_subtraction_wf(-,?,-,?).
3658		domain_subtraction_wf(S,R,Res,WF) :- S==[],!,
3659		equal_object_wf(R,Res,domain_subtraction1,WF).
3660		domain_subtraction_wf(S,R,Res,WF) :- /* S <<| R */
3661		ok_to_try_restriction_explicit_set(S,R,Res),
3662		domain_subtraction_explicit_set_wf(S,R,SR,WF),!,
3663		equal_object_wf(SR,Res,domain_subtraction2,WF).
3664		domain_subtraction_wf(S,R,Res,WF) :- /* S <<| R */
3665		expand_custom_set_to_list_wf(R,ER,_,domain_subtraction,WF),
3666		try_expand_and_convert_to_avl_with_check(S,AS,keep_intervals(500),domain_subtraction),
3667		% (ground(ER) -> domain_subtraction_acc(ER,AS,[],Res) ;
3668		relation_restriction_wf(ER,AS,Res,pred_false,domain,WF)
3669		% )
3670		.
3671
3672
3673
3674		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_domain_subtraction_wf((int(2),int(3)),[int(33),int(1)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3675		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_domain_subtraction_wf((int(2),int(3)),[],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3676
3677		:- block in_domain_subtraction_wf(-,-,-,?).
3678
3679		in_domain_subtraction_wf(Pair,Set,Rel,WF) :-
3680		(treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel)
3681		; preference(convert_comprehension_sets_into_closures,true)),
3682		!,
3683		Rel \== [], % avoid setting up check_element_of for X then
3684		% x |-> y : Set <<| Rel <=> x|->y : Rel & x/: Set
3685		check_element_of_wf(Pair,Rel,WF),
3686		Pair = (P1,_),
3687		not_element_of_wf(P1,Set,WF).
3688		in_domain_subtraction_wf(Pair,Set,Rel,WF) :-
3689		domain_subtraction_wf(Set,Rel,Res,WF),
3690		check_element_of_wf(Pair,Res,WF).
3691
3692
3693		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_domain_subtraction_wf((int(2),int(3)),[int(33),int(2)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3694		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_in_domain_subtraction_wf((int(11),int(3)),[int(33),int(2)],[(int(2),int(3)),(int(1),int(3))],WF),WF)).
3695
3696		:- block not_in_domain_subtraction_wf(-,-,-,?).
3697		not_in_domain_subtraction_wf(Pair,Set,Rel,WF) :-
3698		domain_subtraction_wf(Set,Rel,Res,WF),
3699		not_element_of_wf(Pair,Res,WF).
3700
3701		% similar to kernel_objects, but adds case for [_|_]
3702		treat_arg_symbolically(X) :- var(X),!.
3703		treat_arg_symbolically([H|T]) :- \+ ground(H) ; treat_arg_symbolically(T).
3704		treat_arg_symbolically(global_set(_)).
3705		treat_arg_symbolically(freetype(_)).
3706		treat_arg_symbolically(closure(P,T,B)) :- \+ kernel_objects:small_interval(P,T,B).
3707
3708		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:override_relation([(int(1),int(2))],[(int(1),int(3))],[(int(1),int(3))],WF),WF)).
3709		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:override_relation([(int(1),int(2))],[(int(2),int(3))],[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3710		:- assert_must_succeed((bsets_clp:override_relation([(int(1),int(2)),(int(2),int(4))],[(int(1),int(3))],X,_WF),
3711		kernel_objects:equal_object(X,[(int(2),int(4)),(int(1),int(3))]))).
3712		:- assert_must_succeed((bsets_clp:override_relation([(int(1),int(2)),(int(2),int(4))],[(int(3),int(6))],X,_WF),
3713		kernel_objects:equal_object(X,[(int(2),int(4)),(int(1),int(2)),(int(3),int(6))]))).
3714
3715		:- block override_relation(-,-,?,?). % overwrite AST node
3716		override_relation(R,S,Res,WF) :- R==[],!, equal_object_wf(S,Res,override_relation1,WF).
3717		override_relation(R,S,Res,WF) :- S==[],!, equal_object_wf(R,Res,override_relation2,WF).
3718		override_relation(R,S,Res,WF) :-
3719		opt_push_wait_flag_call_stack_info(WF,b_operator_call(overwrite,[R,S],unknown),WF2),
3720		override_relation2(R,S,Res,WF2).
3721
3722		override_relation2(R,S,Res,WF) :- Res==[],!, empty_set_wf(S,WF), empty_set_wf(R,WF).
3723		override_relation2(R,S,Res,WF) :- /* R <+ S */
3724		override_custom_explicit_set_wf(R,S,ORes,WF),!,
3725		equal_object_wf(ORes,Res,override_relation3,WF).
3726		override_relation2(R,S,Res,WF) :- /* R <+ S */
3727		domain_wf(S,DS,WF),
3728		domain_subtraction_wf(DS,R,DSR,WF),
3729		union_wf(DSR,S,Res,WF). % in principle we could call disjoint_union_wf, but fails 1112, 1751
3730
3731		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_override_relation_wf((int(1),int(2)),[(int(1),int(2))],[(int(2),int(3))],WF),WF)).
3732		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_override_relation_wf((int(2),int(3)),[(int(1),int(2))],[(int(2),int(3))],WF),WF)).
3733		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_override_relation_wf((int(2),int(3)),[(int(1),int(2)),(int(2),int(4))],[(int(2),int(3))],WF),WF)).
3734		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:in_override_relation_wf((int(2),int(4)),[(int(1),int(2)),(int(2),int(4))],[(int(2),int(3))],WF),WF)).
3735
3736		:- block in_override_relation_wf(-,-,-,?).
3737		in_override_relation_wf(Pair,Rel1,S,WF) :- S==[],!, % Pair: Rel1 <+ S
3738		check_element_of_wf(Pair,Rel1,WF).
3739		in_override_relation_wf(Pair,Rel1,S,WF) :- Rel1==[],!,
3740		check_element_of_wf(Pair,S,WF).
3741		in_override_relation_wf((X,Y),Rel1,S,WF) :-
3742		(treat_arg_symbolically(S) ; treat_arg_symbolically(Rel1)
3743		; preference(convert_comprehension_sets_into_closures,true)),
3744		!,
3745		domain_wf(S,DS,WF),
3746		membership_test_wf(DS,X,MemRes,WF),
3747		in_override_aux(MemRes,X,Y,Rel1,S,WF).
3748		in_override_relation_wf(Pair,Rel1,S,WF) :-
3749		override_relation(Rel1,S,Res,WF),
3750		check_element_of_wf(Pair,Res,WF).
3751
3752		:- block in_override_aux(-,?,?,?,?,?).
3753		in_override_aux(pred_true,X,Y,_R,S,WF) :-
3754		check_element_of_wf((X,Y),S,WF).
3755		in_override_aux(pred_false,X,Y,R,_S,WF) :-
3756		check_element_of_wf((X,Y),R,WF).
3757
3758		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_in_override_relation_wf((int(2),int(3)),[(int(1),int(2)),(int(2),int(4))],[(int(2),int(3))],WF),WF)).
3759		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_override_relation_wf((int(2),int(4)),[(int(1),int(2)),(int(2),int(4))],[(int(2),int(3))],WF),WF)).
3760
3761		:- block not_in_override_relation_wf(-,-,-,?).
3762		not_in_override_relation_wf(Pair,Rel1,S,WF) :- S==[],!, % Pair: Rel1 <+ S
3763		not_element_of_wf(Pair,Rel1,WF).
3764		not_in_override_relation_wf(Pair,Rel1,S,WF) :- Rel1==[],!,
3765		not_element_of_wf(Pair,S,WF).
3766		not_in_override_relation_wf((X,Y),Rel1,S,WF) :-
3767		(treat_arg_symbolically(S) ; treat_arg_symbolically(Rel1)
3768		; preference(convert_comprehension_sets_into_closures,true)),
3769		!,
3770		domain_wf(S,DS,WF),
3771		membership_test_wf(DS,X,MemRes,WF),
3772		not_in_override_aux(MemRes,X,Y,Rel1,S,WF).
3773		not_in_override_relation_wf(Pair,Rel1,S,WF) :-
3774		override_relation(Rel1,S,Res,WF),
3775		not_element_of_wf(Pair,Res,WF).
3776
3777		:- block not_in_override_aux(-,?,?,?,?,?).
3778		not_in_override_aux(pred_true,X,Y,_R,S,WF) :-
3779		not_element_of_wf((X,Y),S,WF).
3780		not_in_override_aux(pred_false,X,Y,R,_S,WF) :-
3781		not_element_of_wf((X,Y),R,WF).
3782
3783		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:override([],int(1),int(3),[(int(1),int(3))],WF),WF)).
3784		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:override([(int(1),int(2)),(int(2),int(6))],int(1),int(3),[(int(1),int(3)),(int(2),int(6))],WF),WF)).
3785		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:override([(int(1),int(2)),(int(2),int(6))],int(2),int(3),[(int(1),int(2)),(int(2),int(3))],WF),WF)).
3786
3787		% override for a single pair
3788		:- block override(-,?,?,?,?), override(?,-,?,?,?),
3789		override(?,?,-,?,?). % also wait on Y; try to generate avl if possible; can only be used in substitution anyway
3790		/* R <+ {X |-> Y} as used by substitution R(X) := Y */
3791		override(R,X,Y,Res,WF) :-
3792		override_pair_explicit_set(R,X,Y,ORes),!,
3793		equal_object_wf(ORes,Res,override1,WF).
3794		override(R,X,Y,Res,WF) :-
3795		if(try_expand_custom_set_to_list(R,ER,_,override),
3796		(
3797		override2(ER,X,Y,[(X,Y)],ORes,WF),
3798		equal_object_wf(ORes,Res,override2,WF)),
3799		( %print_term_summary(exception(R)), % Virtual Timeout exception occured
3800		override_relation(R,[(X,Y)],Res,WF)
3801		)).
3802
3803		:- block override2(-,?,?,?,?,?).
3804		override2([],_X,_Y,Remainder,Res,WF) :- equal_object_optimized_wf(Remainder,Res,override2,WF). %equal_object(Remainder,Res).
3805		override2([(V,W)|T],X,Y,Remainder,Res,WF) :-
3806		equality_objects_wf(V,X,EqRes,WF),
3807		override2c(EqRes,V,W,T,X,Y,Remainder,Res,WF).
3808
3809		:- block override2c(-, ?,?,?, ?,?,?,?,?).
3810		override2c(pred_true,_V,_W,T,X,Y,_Remainder,Res,WF) :-
3811		equal_cons_wf(Res,(X,Y),T2,WF),
3812		override2(T,X,Y,[],T2,WF). /* set remainder to [], we have already added (X,Y) */
3813		override2c(pred_false,V,W,T,X,Y,Remainder,Res,WF) :-
3814		equal_cons_wf(Res,(V,W),T2,WF),
3815		override2(T,X,Y,Remainder,T2,WF).
3816
3817
3818
3819		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[int(2)],WF),WF)).
3820		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_wf([(int(1),int(2)),(int(2),int(2)),(int(3),int(3))],[int(1),int(2)],[int(2)],WF),WF)).
3821		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_wf([(int(1),int(2)),(int(2),int(2)),(int(1),int(3)),(int(4),int(4))],[int(1),int(2)],[int(2),int(3)],WF),WF)).
3822		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:image_wf([(int(1),int(2)),(int(2),int(2)),(int(1),int(3)),(int(4),int(4))],[int(2)],[int(2),int(3)],WF),WF)).
3823		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:image_wf([(term(floating(1.0)),term(floating(2.0))),(term(floating(2.0)),term(floating(2.0))),(term(floating(1.0)),term(floating(3.0))),(term(floating(4.0)),term(floating(4.0)))],[term(floating(2.0))],[term(floating(2.0)),term(floating(3.0))],WF),WF)).
3824		:- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[int(2)],_WF)).
3825		:- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2))],[int(2)],[],_WF)).
3826		:- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2))],[int(3)],[],_WF)).
3827		:- assert_must_succeed((bsets_clp:image_wf([(int(1),int(2)),(int(1),int(3))],
3828		[int(X)],R,_WF), X=1, kernel_objects:equal_object(R,[int(2),int(3)]))).
3829		:- assert_must_succeed((bsets_clp:image_wf([([int(1),int(2)],int(6)),
3830		([int(1),int(2),int(3)],int(7)),
3831		([int(2),int(1)],int(8))],
3832		[[int(X),int(1)]],R,_WF), X=2,
3833		kernel_objects:equal_object(R,[int(6),int(8)]))).
3834		:- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2)),(int(2),int(2))],[int(1),int(2)],[int(2)],_WF)).
3835		:- assert_must_fail(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[int(1)],_WF)).
3836		:- assert_must_fail(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[],_WF)).
3837
3838
3839		:- block image_wf(-,?,?,?).
3840		image_wf(Rel,_,Res,WF) :- Rel==[],!,empty_set_wf(Res,WF).
3841		image_wf(Rel,S,Res,WF) :-
3842		image_for_id_closure(Rel,S,Img),!, % we don't require S to be known here
3843		equal_object_wf(Img,Res,image_wf_id_closure,WF).
3844		image_wf(Rel,S,Res,WF) :-
3845		image_wf0(Rel,S,Res,WF).
3846
3847		:- block image_wf0(?,-,?,?).
3848		image_wf0(Rel,S,Res,WF) :- /* Res = Rel[S] */
3849		(S==[] -> empty_set_wf(Res,WF)
3850		; opt_push_wait_flag_call_stack_info(WF,b_operator_call(image,[Rel,S],unknown),WF2),
3851		image1(Rel,S,Res,WF2) ).
3852
3853		keep_symbolic(R) :- var(R),!,fail.
3854		keep_symbolic(closure(_,_,_)) :- preferences:get_preference(convert_comprehension_sets_into_closures,true),!.
3855		keep_symbolic(R) :- dont_expand_this_explicit_set(R).
3856
3857		:- block image1(-,?,?,?).
3858		image1(Rel,S,Res,WF) :-
3859		image_for_explicit_set(Rel,S,Img,WF),!,
3860		equal_object_wf(Img,Res,image1_1,WF),
3861		quick_propagate_subset_range(Res,Rel,WF).
3862		%image1(Rel,S,Res,WF) :- expand_custom_set_to_list(S,ES),!, image_of_set(ES,Rel,Res,WF).
3863		image1(Rel,Set,Res,WF) :-
3864		keep_symbolic(Rel),
3865		(preferences:get_preference(convert_comprehension_sets_into_closures,true), % in this case keep_symbolic is always true
3866		nonvar(Set),is_infinite_explicit_set(Set) % in this case we have to expand Rel below; what if Rel also infinite ?? --> TO DO : symbolic treatment
3867		-> debug_println(9,infinite_for_image1(Set)),
3868		fail
3869		; true),
3870		( dom_for_specific_closure(Rel,Domain,function(_),WF)
3871		-> !,
3872		expand_custom_set_to_list_wf(Set,ESet,_,image1,WF), % TO DO: what if keep_symbolic(Set)
3873		image_for_inf_fun(ESet,Domain,Rel,[],Res,WF)
3874		; get_relation_types(Rel,DomType,RangeType),!,
3875		image_symbolic(Set,Rel,DomType,RangeType,Res,WF)
3876		).
3877		image1(Rel,S,Res,WF) :-
3878		on_enumeration_warning(expand_custom_set_to_list_wf(Rel,Relation,_,image1_2,WF), R=failed),
3879		% bad if Rel is a big closure ! image_for_list_relation(Relation,S,Res).
3880		(R==failed -> write(failed),nl,
3881		mnf_get_relation_types(Rel,DomType,RangeType),% must succeed, as Rel is a closure with types
3882		image_symbolic(S,Rel,DomType,RangeType,Res,WF) % does not treat special case image_for_inf_fun
3883		; propagate_singleton_image(Relation,S,Res,WF),
3884		% TO DO: we could propagate cardinality constraints about Relation,S and Res
3885		% we could also try to infer all_different constraints in case card(S)=card(Res) and f is a function
3886		image_for_list_relation(Relation,S,[],Res,WF)
3887		).
3888
3889		% keep_symbolic for Rel has succeeded
3890		image_symbolic(Set,Rel,_DomType,_RangeType,Res,WF) :-
3891		is_cartesian_product_closure(Rel,Dom,Ran),!, % (A*B)[Set] == if A/\Set={} THEN {} ELSE B END
3892		test_disjoint_wf(Set,Dom,DisjointResult,WF),
3893		image_sym_disj(DisjointResult,Ran,Res,WF).
3894		image_symbolic(Set,Rel,DomType,RangeType,Res,WF) :-
3895		expand_custom_set_to_list_wf(Set,ESet,_,image1_2,WF),
3896	?	(is_symbolic_closure(Rel) % what if infinite?
3897		-> Symbolic=symbolic_try_expand, ground_value_check((Rel,ESet),GRel) % also wait for ESet to be ground so that we can catch enumeration warning exceptions, cf. test 2428 when theorem and foralls not expanded
3898		; Symbolic=expand, ground_value_check(Rel,GRel)
3899		),
3900		when(nonvar(GRel), image_for_large_relation(ESet,Rel,Symbolic,DomType,RangeType,[],Res,WF)).
3901		% Alternative: We could compute closure by calculating {yy|#(xx).(xx:Set & xx|->yy:Rel)}
3902		% image_closure(Set,Rel,DomType,RangeType,Closure ),
3903
3904		:- block image_sym_disj(-,?,?,?). % TODO: also propagate from Res to pred_true
3905		image_sym_disj(pred_true,_,Res,WF) :- empty_set_wf(Res,WF).
3906		image_sym_disj(pred_false,Ran,Res,WF) :- equal_object_wf(Res,Ran,WF).
3907
3908		% propagate that f[{x}] = {r1,...,rk} => x|->ri : f (or {x}*{r1,...,rk} <: f); see test 1532
3909		propagate_singleton_image(R,S,Res,_) :-
3910		(var(S) ; var(Res) ; nonvar(R), is_custom_explicit_set(R,psi)), !.
3911		propagate_singleton_image(Relation,S,avl_set(Res),WF) :-
3912		custom_explicit_sets:singleton_set(S,El), % we have the image by a singleton set {El}
3913		expand_custom_set_to_list_wf(avl_set(Res),LR,_,prop_singleton,WF),
3914		!,
3915		l_check_element_of(LR, El, Relation, WF). % propagate x|->ri : f (will force membership)
3916		propagate_singleton_image(_,_,_,_).
3917
3918		l_check_element_of([],_,_,_).
3919		l_check_element_of([H|T],El,Relation,WF) :-
3920		check_element_of_wf((El,H),Relation,WF),
3921		l_check_element_of(T,El,Relation,WF).
3922
3923		% quick_propagate_in_range(Set, Relation,WF) : propagate that Set <: ran(Relation)
3924		:- block quick_propagate_subset_range(-,?,?).
3925		quick_propagate_subset_range(avl_set(_),_,_) :- !.
3926		quick_propagate_subset_range([],_,_) :- !.
3927		quick_propagate_subset_range([H|T],Relation,WF) :- is_custom_explicit_set(Relation,range_wf1),
3928		range_of_explicit_set_wf(Relation,Range,WF), !,
3929		quick_propagation_element_information(Range,H,WF,NewRange),
3930		quick_propagate_subset_range2(T,NewRange,WF).
3931		quick_propagate_subset_range(_,_,_).
3932
3933		:- block quick_propagate_subset_range2(-,?,?).
3934		quick_propagate_subset_range2([H|T],NewRange,WF) :- !,
3935		quick_propagation_element_information(NewRange,H,WF,NewRange1),
3936		quick_propagate_subset_range2(T,NewRange1,WF).
3937		quick_propagate_subset_range2(_,_,_).
3938
3939		:- use_module(btypechecker, [unify_types_strict/2]).
3940		get_relation_types(Value,Domain,Range) :-
3941		kernel_objects:infer_value_type(Value,VT),
3942		unify_types_strict(VT,set(couple(Domain,Range))). % deal also with seq types
3943		% VT=set(couple(Domain,Range)).
3944		% a version that must not fail:
3945		mnf_get_relation_types(Value,Domain,Range) :-
3946		(get_relation_types(Value,Domain,Range) -> true
3947		; add_internal_error('Failed: ',get_relation_types(Value,Domain,Range)),
3948		Domain=any, Range=any).
3949
3950		:- block image_for_large_relation(-,?,?,?,?,?,?,?), image_for_large_relation(?,?,?,?,?,-,?,?).
3951		image_for_large_relation([],_,_,_,_,Acc,Res,WF) :- equal_object_wf(Acc,Res,WF).
3952		image_for_large_relation([XX|T],Rel,Symbolic,DomType,RangeType,Acc,Res,WF) :-
3953		get_image_singleton_closure(XX,DomType,RangeType,Rel, Par,TPara,Body),
3954		expand_closure_direct_if_possible(Symbolic,Par,TPara,Body,ImagesForXX,WF),
3955		union_wf(Acc,ImagesForXX,NewAcc,WF),
3956		(T == [] -> equal_object_wf(NewAcc,Res,WF)
3957		; image_for_large_relation(T,Rel,Symbolic,DomType,RangeType,NewAcc,Res,WF)).
3958
3959		get_image_singleton_closure(XX,DomType,RangeType,Rel, [yy], [RangeType], Body) :-
3960		Body = b(member(b(couple(b(value(XX),DomType,[]),
3961		b(identifier(yy),RangeType,[])),couple(DomType,RangeType),[]),
3962		b(value(Rel),set(couple(DomType,RangeType)),[])),pred,[]).
3963		% TO DO: simplify above if we have Rel = closure(P,T,B); which we usually will
3964
3965		expand_closure_direct_if_possible(symbolic_try_expand,Par,Types,Body,Result,WF) :- !,
3966		catch_enumeration_warning_exceptions(
3967		custom_explicit_sets:expand_normal_closure_direct(Par,Types,Body,Result,_Done,WF),
3968		(mark_bexpr_as_symbolic(Body,SBody),
3969		Result = closure(Par,Types,SBody) % TODO: we could set definitely_symbolic for next iteration
3970		),
3971		false,
3972		ignore(image_for_large_relation)).
3973		expand_closure_direct_if_possible(definitely_symbolic,Par,Types,Body,Result,_WF) :- !,
3974		mark_bexpr_as_symbolic(Body,SBody),
3975		Result = closure(Par,Types,SBody).
3976		expand_closure_direct_if_possible(_,Par,Types,Body,Result,WF) :-
3977		% do not memoize this (many different values):
3978		custom_explicit_sets:expand_normal_closure_direct(Par,Types,Body,Result,_Done,WF).
3979
3980
3981		/* no longer used
3982		% construct a closure for {yy|#(xx).(xx:Set & xx|->yy:Rel)}
3983		image_closure(Set,Rel,DomType,RangeType,Closure ) :- custom_explicit_sets:singleton_set(Set,XX),!,
3984		% do not set up existential quantifier if Set is singleton set
3985		Closure = closure([yy],[RangeType],Body),
3986		Body = b(member(b(couple(b(value(XX),DomType,[]),
3987		b(identifier(yy),RangeType,[])),couple(DomType,RangeType),[]),
3988		b(value(Rel),set(couple(DomType,RangeType)),[])),pred,[]).
3989		image_closure(Set,Rel,DomType,RangeType,Closure ) :-
3990		Closure = closure([yy],[RangeType],Body),
3991		couple_member_pred(xx,DomType,yy,RangeType,Rel, Predxxyy),
3992		Body = b(exists([b(identifier(xx),DomType,[])],
3993		b(conjunct(
3994		b(member(b(identifier(xx),DomType,[]),b(value(Set),set(DomType),[])),pred,[]), % TO DO : force evaluation !
3995		Predxxyy),
3996		pred,[])),pred,[used_ids([yy])]).
3997		*/
3998
3999		% very similar to rel_compose_with_inf_fun, indeed f[S] = ran((id(S);f))
4000		:- block image_for_inf_fun(-,?,?,?,?,?).
4001		image_for_inf_fun([],_Dom,_Rel2,Acc,Comp,WF) :- equal_object_wf(Acc,Comp,WF).
4002		image_for_inf_fun([X|T],Dom,Fun,Acc,CompRes,WF) :-
4003		membership_test_wf(Dom,X,MemRes,WF),
4004		image_for_inf_fun_aux(MemRes,X,T,Dom,Fun,Acc,CompRes,WF).
4005
4006		:- block image_for_inf_fun_aux(-,?,?, ?,?,?,?,?).
4007		image_for_inf_fun_aux(pred_true,X,T,Dom,Fun,Acc,CompRes,WF) :-
4008		apply_to(Fun,X,FX,WF), % TO DO: generalize to image so that we can apply it also to infinite relations ?
4009		add_element_wf(FX,Acc,NewAcc,WF), % will block until Acc Known !!
4010		% TO DO USE: equal_cons_wf(CompRes,FX,CT,WF) + accumulator !,
4011		image_for_inf_fun(T,Dom,Fun,NewAcc,CompRes,WF).
4012		image_for_inf_fun_aux(pred_false,_X,T,Dom,Fun,Acc,Comp,WF) :-
4013		image_for_inf_fun(T,Dom,Fun,Acc,Comp,WF).
4014
4015
4016		/*
4017		:- block image_of_set(-,?,?,?,?), image_of_set(?,?,-,?,?).
4018		image_of_set([],Rel,ImageSoFar,Res,WF) :- equal_object(ImageSoFar,Res).
4019		image_of_set([H|T],Rel,ImageSoFar,Res,WF) :-
4020		image_of_element(Rel,H,ImageSoFar,SF2,WF),
4021		image_of_set(T,Rel,SF2,Res,WF).
4022
4023		image_of_element([],_,Acc,Res,WF) :- equal_object(Acc,Res).
4024		image_of_element([(A,B)|T],H,Acc,Res,WF) :- equality....
4025		image_of_element(avl_set(),H,Acc,Res,WF) :- ....
4026		image_of_element(closure(),....
4027		*/
4028
4029		% Computing the image of a relation which is stored as a list: traverse the relation
4030		:- block image_for_list_relation(-,?,?,?,?).
4031	?	image_for_list_relation([],_,_,Res,WF) :- empty_set_wf(Res,WF).
4032		image_for_list_relation([(X,Y)|T],S,ImageSoFar,Res,WF) :-
4033		((T==[], definitely_not_empty(Res))
4034		-> MemRes=pred_true, % we need at least one more element for Res
4035		check_element_of_wf(X,S,WF)
4036		; (Res==[],ImageSoFar==[]) -> MemRes=pred_false, not_element_of_wf(X,S,WF) % Result empty: X cannot be in S
4037		; membership_test_wf(S,X,MemRes,WF)
4038		),
4039	?	image4(MemRes,Y,T,S,ImageSoFar,Res,WF).
4040
4041		definitely_not_empty(Set) :- nonvar(Set), Set \== [], \+ functor(Set,closure,3). % Set \= closure(_,_,_).
4042
4043		:- block image4(-, ?,?,?, ?,?,?).
4044		image4(pred_true, Y,T,S, ImageSoFar,Res,WF) :-
4045		(Res==[]
4046		-> MemRes=pred_true, check_element_of_wf(Y,ImageSoFar,WF)
4047		; membership_test_wf(ImageSoFar,Y,MemRes,WF)
4048		),
4049	?	image5(MemRes,Y,T,S,ImageSoFar,Res,WF).
4050		image4(pred_false, _Y,T,S, ImageSoFar,Res,WF) :-
4051	?	image_for_list_relation(T,S,ImageSoFar,Res,WF).
4052
4053		:- block image5(-, ?,?,? ,?,?,?).
4054		image5(pred_true,_Y,T,S,ImageSoFar,Res,WF) :- /* we have already added Y to the image */
4055	?	image_for_list_relation(T,S,ImageSoFar,Res,WF).
4056		image5(pred_false,Y,T,S,ImageSoFar,Res,WF) :-
4057		add_element_wf(Y,ImageSoFar,ImageSoFar2,WF),
4058		kernel_objects:mark_as_non_free(Y,image), % Y has been added to image, no longer freely choosable
4059		equal_cons_wf(Res,Y,Res2,WF),
4060	?	image_for_list_relation(T,S,ImageSoFar2,Res2,WF).
4061
4062
4063
4064		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_for_closure1_wf([(int(1),int(2)),(int(2),int(1)),(int(3),int(3))],[int(2)],[int(1),int(2)],WF),WF)).
4065		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_for_closure1_wf([(int(1),int(2)),(int(2),int(1)),(int(3),int(3))],[],[],WF),WF)).
4066		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_for_closure1_wf([(int(1),int(2)),(int(2),int(1)),(int(3),int(3))],[int(3)],[int(3)],WF),WF)).
4067		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_for_closure1_wf([(term(floating(1.0)),term(floating(2.0))),(term(floating(2.0)),term(floating(1.0))),(term(floating(3.0)),term(floating(3.0)))],[term(floating(2.0))],[term(floating(1.0)),term(floating(2.0))],WF),WF)).
4068		% version for computing closure1(Rel)[S]
4069		:- block image_for_closure1_wf(-,?,?,?),image_for_closure1_wf(?,-,?,?).
4070		image_for_closure1_wf(Rel,S,Res,WF) :- (Rel==[] ; S==[]),!,empty_set_wf(Res,WF).
4071		image_for_closure1_wf(Rel,Set,Res,WF) :-
4072		try_expand_and_convert_to_avl_unless_large_wf(Set,ESet,WF),
4073	?	image_for_closure1_wf_aux(Rel,ESet,Res,WF).
4074
4075		:- use_module(library(avl),[avl_height/2]).
4076		image_for_closure1_wf_aux(Rel,S,Res,WF) :-
4077		(nonvar(S),S=avl_set(_)
4078		-> closure1_for_explicit_set_from(Rel,S,Closure1Rel),!,
4079		% if S is known: start from S (currently only deals with Rel=avl_set(_)
4080		range_wf(Closure1Rel,Res,WF)
4081		; Rel=avl_set(AR), avl_height(AR,AR_Height),
4082		(set_smaller_than(S,4),AR_Height>4
4083		-> !, % TO DO: we could do the same for small S if Rel is large
4084		when(ground(S), (expand_and_convert_to_avl_set(S,ES,image_for_closure1_wf_aux,'closure1(ARG)[?]') ->
4085		closure1_for_explicit_set_from(Rel,avl_set(ES),Closure1Rel),
4086		range_wf(Closure1Rel,Res,WF)
4087		; image_for_closure1_iterate(Rel,S,[],Res,WF,first_iteration(S))
4088		))
4089		; % Don't do this if avl_height too large; then it is probably better to compute the image for S only
4090		AR_Height < 13, % how big should we make this magic constant; or should we time-out ? 2^14=16384
4091		closure1_for_explicit_set(Rel,Closure1Rel),!, % we can compute it effiently; don't use code below
4092		image_wf(Closure1Rel,S,Res,WF)
4093		)
4094		).
4095		image_for_closure1_wf_aux(Rel,S,Res,WF) :-
4096		propagate_result_in_range(Rel,S,Res,WF),
4097	?	image_for_closure1_iterate(Rel,S,[],Res,WF,first_iteration(S)).
4098
4099		% no need to treat avl_sets; already covered as special case above
4100		set_smaller_than([],_).
4101		set_smaller_than([_|T],N) :- N>1, nonvar(T), N1 is N-1, set_smaller_than(T,N1).
4102
4103		image_for_closure1_iterate(Rel,S,Acc,Res,WF,FIRST) :-
4104		image_wf0(Rel,S,Res1,WF),
4105		ground_value_check(Res1,RV),
4106	?	image_for_closure1_check_fix(RV,Rel,Acc,Res1,Res,WF,FIRST).
4107
4108		:- block image_for_closure1_check_fix(-,?,?,?,?,?,?).
4109		image_for_closure1_check_fix(_,Rel,Acc,Res1,Res,WF,FIRST) :-
4110		%try_expand_and_convert_to_avl_unless_large_wf(Res1,ERes1,WF),
4111		difference_set(Res1,Acc,New),
4112		try_expand_and_convert_to_avl(New,ENew), % we compute difference_set below; we most definitely will need an explicit finite representation
4113		(not_empty_set_wf(ENew,WF),
4114		union(ENew,Acc,Acc1), % Note: we do not call union_wf - should we do this
4115		% upon first iteration remove also S from New -> New2 and pass New2 to image_for_closure1_iterate
4116		% TO DO: investigate whether this also makes sense for further iterations; always remove S
4117		(FIRST=first_iteration(S) -> difference_set(ENew,S,New2) ; New2=ENew),
4118	?	image_for_closure1_iterate(Rel,New2,Acc1,Res,WF,not_first)
4119		;
4120		empty_set_wf(ENew,WF),equal_object_optimized_wf(Acc,Res,image_for_closure1_check_fix,WF)).
4121
4122		% propagate information that if closure1(Rel)[.] = Res => Res <: range(Rel)
4123		% x: 1..n --> 1..n & closure1(x)[{1}] = {} & n=100
4124		:- block propagate_result_in_range(?,?,-,?).
4125		propagate_result_in_range(Rel,_S,_Res,_WF) :-
4126		ground_value(Rel),!. % no propagation required
4127		propagate_result_in_range(Rel,S,[],WF) :- !,
4128		domain_wf(Rel,Domain,WF),
4129		not_subset_of_wf(S,Domain,WF).
4130		propagate_result_in_range(Rel,_,Res,WF) :-
4131		range_wf(Rel,Range,WF),
4132		check_subset_of_wf(Res,Range,WF).
4133
4134		:- use_module(probsrc(avl_tools),[avl_height_less_than/2]).
4135
4136		% version for computing iterate(K,Rel)[S]
4137		% iteration
4138		:- block image_for_iterate_wf(?,-,?,?,?,?), image_for_iterate_wf(?,?,-,?,?,?).
4139		image_for_iterate_wf(_Rel,_K,S,Res,_,WF) :- S==[],!,empty_set_wf(Res,WF).
4140		image_for_iterate_wf(Rel,int(K),S,Res,Type,WF) :-
4141		image_for_iterate_k(K,Rel,S,Res,Type,WF).
4142
4143		:- block image_for_iterate_k(-,?,?,?,?,?).
4144		image_for_iterate_k(K,Rel,S,Res,Type,WF) :-
4145		nonvar(Rel),
4146		Rel=avl_set(AVL),
4147		(var(S) -> avl_height_less_than(AVL,11) ; avl_height_less_than(AVL,3)),
4148		!, % compute the iteration once; possibly better constraint propagation and performance if S enumerated
4149		% e.g. x:{1,10,20} & iterate({1|->10,20|->1,10|->20},2)(x) = 20
4150		rel_iterate_wf(Rel,int(K),RelIterated,Type,WF),
4151		image_wf(RelIterated,S,Res,WF).
4152		image_for_iterate_k(K,Rel,S,Res,_,WF) :-
4153		image_for_iterate_k_loop(K,Rel,S,Res,WF).
4154
4155		:- block image_for_iterate_k_loop(?,?,-,?,?).
4156		image_for_iterate_k_loop(0,_Rel,Acc,Result,WF) :- !,
4157		equal_object_optimized_wf(Acc,Result,image_for_iterate_k,WF).
4158		image_for_iterate_k_loop(K,Rel,Acc,Result,WF) :-
4159		image_wf0(Rel,Acc,Acc1,WF), % we could try and detect fix point if K> some limit or time for iteration is measurable
4160		if((K>10, K mod 10 =:= 0, % check for fixpoint every 10 iterations
4161		nonvar(Acc1), Acc1=avl_set(_), quick_custom_explicit_set_approximate_size(Acc1,Size1),
4162		quick_custom_explicit_set_approximate_size(Acc,Size0),
4163		Size0=Size1, % only check for equality if approximate sizes match
4164		equal_explicit_sets_wf(Acc,Acc1,WF)),
4165		K1=0, % fixpoint found, no need to continue iterating
4166		K1 is K-1),
4167		image_for_iterate_k_loop(K1,Rel,Acc1,Result,WF).
4168
4169		special_operator_for_image(b(Rel,Type,_),Kind,Args) :- special_image_aux(Rel,Type,Kind,Args).
4170		special_image_aux(closure(Rel),_,closure,[Rel]). % we have closure1(Rel)[Set] -> avoid computing full closure
4171		special_image_aux(iteration(Rel,K),Type,iteration(Type),[Rel,K]).
4172		% TODO: reflexive closure, id_closure (this will probably be more natural as special case for a value)
4173
4174	?	image_for_special_operator(closure,[Rel],S,Res,WF) :- image_for_closure1_wf(Rel,S,Res,WF).
4175		image_for_special_operator(iteration(Type),[Rel,K],S,Res,WF) :-
4176		image_for_iterate_wf(Rel,K,S,Res,Type,WF).
4177
4178		:- use_module(kernel_objects,[singleton_set_element/4]).
4179		apply_fun_for_special_operator(Kind,EArgs,FunArg,Res,WF,Span) :-
4180		InitialSet = [FunArg], % TODO: try convert to AVL, note: closure1 not really useful in fun. application context
4181		image_for_special_operator(Kind,EArgs,InitialSet,SetRes,WF),
4182		singleton_set_element(SetRes,Res,Span,WF).
4183
4184		% iterate(%x.(x:NATURAL|x+2),2000)(20) much faster this way, 15 ms vs 4 seconds
4185		% iterate(%x.(x:NATURAL|x+2),2000)[{20}]: ditto
4186
4187
4188		% -----------------------------------
4189
4190		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:apply_to([(int(2),int(22))],int(2),int(22),WF),WF)).
4191		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:apply_to([(int(1),int(22)),(int(3),int(33)),(int(4),int(44))],int(3),int(33),WF),WF)). % used to be wfdet (see in_domain_wf above)
4192		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:apply_to([(int(1),[int(22)]),(int(3),[int(32),int(33)]),(int(4),[int(44)])],int(3),[int(32),int(33)],WF),WF)). % used to be wfdet (see in_domain_wf above)
4193		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:apply_to([(term(floating(1.0)),int(22)),(term(floating(3.0)),int(33)),(term(floating(4.0)),int(44))],term(floating(3.0)),int(33),WF),WF)).
4194		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:apply_to([(string(one),int(22)),(string(three),int(33)),(string(four),int(44))],string(three),int(33),WF),WF)).
4195		:- assert_must_succeed(bsets_clp:apply_to([(int(1),int(2))],int(1),int(2),_WF)).
4196		:- assert_must_succeed((bsets_clp:apply_to(F,int(3),int(2),_WF),F=[(int(3),int(2)),(int(2),int(1))])).
4197		:- assert_must_succeed((bsets_clp:apply_to(F,X,int(1),_WF),F=[(int(3),int(2)),(int(2),int(1))],X=int(2))).
4198		:- assert_must_succeed((bsets_clp:apply_to(F,int(3),_,_WF),F=[(int(3),[int(2),int(3)]),(int(2),[])])).
4199
4200		:- assert_must_fail(bsets_clp:apply_to([(int(1),int(2)),(int(1),int(3))],int(1),int(3),_WF)).
4201		/* input not a function */
4202		apply_to(R,X,Y,WF) :- apply_to(R,X,Y,unknown,unknown,WF).
4203		apply_to(R,X,Y,Span,WF) :- apply_to(R,X,Y,unknown,Span,WF).
4204
4205		% comment in to perform profiling at function call level; can lead to big slowdowns
4206		%:- load_files(library(system), [when(compile_time), imports([environ/2])]).
4207		%:- use_module(source_profiler,[opt_add_source_location_hits/2]).
4208		%apply_to(_R,_X,_Y,_FunctionType,Span,_WF) :- opt_add_source_location_hits(Span,1),fail.
4209
4210		:- block apply_to(-,-,-,?,?,?).
4211		apply_to(R,X,Y,_FunctionType,Span,WF) :-
4212		% we could check if WD condition discharged in Span
4213		(\+ preferences:preference(find_abort_values,false) ; preference(data_validation_mode,true)),
4214		!,
4215	?	apply_to_var_block_abort(R,X,Y,R,Span,WF). % we have to know R before we can do anything
4216		apply_to(R,X,Y,FunctionType,Span,WF) :-
4217		(var(R),var(X) -> force_in_domain_wf(X,R,WF) ; true),
4218	?	apply_to1(R,X,Y,R,FunctionType,Span,WF).
4219
4220
4221
4222		:- use_module(preferences,[preference/2]).
4223		:- use_module(clpfd_tables,[can_translate_function_to_element_constraint/2,check_apply_with_element_constraint/5]).
4224		:- block apply_to1(-,-,?,?,?,?,?).
4225		apply_to1(R,X,Y,InitialRel,FunctionType,Span,WF) :-
4226		(var(R) -> apply_to_var(R,X,Y,InitialRel,Span,WF)
4227		; R\=[], can_translate_function_to_element_constraint(R,FunctionType) ->
4228	?	check_apply_with_element_constraint(R,X,Y,FunctionType,WF)
4229	?	; apply_to_nonvar(R,X,Y,InitialRel,Span,WF),
4230		propagate_range_membership(R,Y)
4231		).
4232		:- block apply_to2(-,-,?,?,?,?).
4233		apply_to2(R,X,Y,InitialRel,Span,WF) :-
4234		(var(R)
4235		-> apply_to_var(R,X,Y,InitialRel,Span,WF)
4236		; apply_to_nonvar(R,X,Y,InitialRel,Span,WF)
4237		).
4238
4239		:- use_module(clpfd_lists,[get_finite_fdset_information/2,combine_fdset_information/3,
4240		assert_fdset_information/2,get_fdset_information/2]).
4241		% tested in test 1478; initially slows down NQueens
4242		%:- block propagate_range_membership(-,?). % not necessary
4243		propagate_range_membership([(_,RanEl)|T],X) :- nonvar(RanEl),
4244		preferences:preference(use_clpfd_solver,true),
4245		preferences:preference(find_abort_values,false),
4246		get_finite_fdset_information(RanEl,Info), % TO DO: try and detect if we can apply element/3 from clpfd
4247		\+ ground(X),
4248		get_fdset_information(X,InfoX),
4249		Info \= InfoX, % avoids NQueens slowdown; TO DO: check if more precise than InfoX; otherwise no use in collecting info
4250		!,
4251		propagate_range_membership(T,Info,X).
4252		propagate_range_membership(_,_).
4253		:- block propagate_range_membership(-,?,?).
4254		propagate_range_membership([],Info,El) :- !,
4255		% note: the information for the first few elements might have become more precise; TO DO: wait until list known and then propagate ?+ keep on propagating ??
4256		assert_fdset_information(Info,El).
4257		propagate_range_membership([(_,RanEl)|T],Acc,X) :-
4258		nonvar(RanEl), % otherwise we have no info: we may just as well stop
4259		get_finite_fdset_information(RanEl,RInfo),
4260		combine_fdset_information(Acc,RInfo,NewAcc),
4261		NewAcc \= no_fdset_info,
4262		!,
4263		propagate_range_membership(T,NewAcc,X).
4264		propagate_range_membership(_,_,_).
4265
4266
4267		apply_to_var(R,X,Y,InitialRel,Span,WF) :-
4268		mark_var_set_as_non_empty(R),
4269		get_wait_flag(1.0,apply_to_var,WF,WF1), % see tests 1393, 1562??
4270		% was: get_wait_flag0(WF,WF1), but see test 1706 (in conjunction for improvement for test 2033)
4271		when(((nonvar(WF1),ground(X));nonvar(R)), % only instantiate R when X sufficiently instantiated (TO DO: maybe use some for of equality_objects with existing relation R set up so far ??)
4272		(var(R) ->
4273		R=[(X,Y)|Tail],
4274		optional_functionality_check(Tail,X,WF)
4275		; apply_to_nonvar(R,X,Y,InitialRel,Span,WF))).
4276
4277		:- block apply_to_var_block_abort(-,?,?,?,?,?).
4278		apply_to_var_block_abort(R,X,Y,InitialRel,Span,WF) :-
4279	?	apply_to_nonvar(R,X,Y,InitialRel,Span,WF).
4280
4281		optional_functionality_check(Tail,X,WF) :-
4282		preferences:preference(disprover_mode,true),!,
4283		not_in_domain_wf(X,Tail,WF). % we assert that R is a function ; when disproving we can assume well-definedness
4284		% Note: this can cut down the search space ; see e.g. test 1230 (but e.g. it will not find a problem with test 1169, RULE_r967_1)
4285		optional_functionality_check(_,_X,_WF). % TO DO: maybe lazily check if we have other elements with X as first arg if find_abort_values is true
4286
4287
4288		:- use_module(closures,[is_recursive_closure/3]).
4289		:- use_module(memoization,[is_memoization_closure/4,apply_to_memoize/8]).
4290		:- load_files(library(system), [when(compile_time), imports([environ/2])]).
4291		:- if(\+ environ(no_wd_checking,true)).
4292		apply_to_nonvar([],X,_Y,InitialRel,Span,WF) :-
4293		\+ preferences:preference(find_abort_values,false),
4294		add_wd_error_span('function applied outside of domain (#2): ', '@fun'(X,InitialRel),Span,WF).
4295		:- endif.
4296		apply_to_nonvar([(X2,Y2)|T],X,Y,InitialRel,Span,WF) :-
4297		equality_objects_wf(X2,X,EqRes,WF),
4298		% this check on Y2 below is important if both Y and Y2 are instantiated but X,X2 not yet
4299		% example: aload_R07_cbc.mch (Savary) or cbc_sequence check for R08_ByteArray for aload_R07 event (test 1349)
4300		% however: slows down test 583 !
4301		(var(EqRes) -> equality_objects_wf(Y2,Y,EqResY,WF),
4302		prop_apply_eqxy(EqResY,EqRes) % propagate: if Y/=Y2 => X/=X2
4303		; EqResY=not_called),
4304	?	apply_to4(EqRes,EqResY,Y2,T,X,Y,InitialRel,Span,WF).
4305		apply_to_nonvar(avl_set(A),X,Y,_InitialRel,Span,WF) :-
4306	?	apply_to_avl_set(A,X,Y,Span,WF).
4307		apply_to_nonvar(closure(P,T,B),X,Y,_InitialRel,Span,WF) :-
4308		%is_custom_explicit_set(Closure,apply), % should also work for avl_set,...
4309	?	(is_memoization_closure(P,T,B,MemoID)
4310		% Function application with memoization; currently enabled by add /*@desc memo */ pragma to abstract constant
4311		-> apply_to_memoize(MemoID,P,T,B,X,Y,Span,WF)
4312		; is_recursive_closure(P,T,B) % TO DO: maybe we should do the same for functions marked as memoize symbolic/uni-directional/computed ? (although we have new rule for check_element_of_function_closure which makes this redundant ??)
4313		-> % print_term_summary(apply_recursive_closure(X,P,T,B)),
4314		%hit_profiler:add_profile_hit(rec_apply_closure_to_nonvar(X,Y,P,T,B,Span,WF)),
4315		ground_value_check(X,XV), block_apply_closure_to_nonvar_groundx(XV,X,Y,P,T,B,Span,WF)
4316		; %hit_profiler:add_profile_hit(apply_closure_to_nonvar(X,Y,P,T,B,Span,WF)),
4317		apply_closure_to_nonvar(X,Y,P,T,B,Span,WF)).
4318
4319
4320		:- block block_apply_closure_to_nonvar_groundx(-,?,?, ?,?,?, ?,?).
4321		block_apply_closure_to_nonvar_groundx(_,X,Y, P,T,B, Span,WF) :- apply_closure_to_nonvar_groundx(X,Y,P,T,B,Span,WF).
4322
4323		apply_closure_to_nonvar_groundx(X,Y,P,T,B,Span,WF) :-
4324		kernel_tools:ground_bexpr(B),
4325		!, % then if the element of function succeeds there is no need to check WD
4326		if(check_element_of_function_closure(X,Y,P,T,B,WF),
4327		true, % No need to check for well-definedness; no pending choice points
4328		apply_closure_to_nonvar_wd_check(X,P,T,B,Span,WF) % here we need to check; it could be that the result Y was instantiated
4329		).
4330		apply_closure_to_nonvar_groundx(X,Y,P,T,B,Span,WF) :-
4331		apply_closure_to_nonvar(X,Y,P,T,B,Span,WF).
4332
4333		% if we first check preferences:preference(find_abort_values,false) to avoid a choice
4334		% point, we get a big slow-down on Alstom models; e.g., vesg_Mar12
4335		% WARNING: This choice point can be set up in WF0 !
4336		apply_closure_to_nonvar(X,Y,P,T,B,_,WF) :-
4337		(preferences:preference(find_abort_values,false) -> ! ; true), % slow down ???!
4338		check_element_of_function_closure(X,Y,P,T,B,WF) .
4339		apply_closure_to_nonvar(X,_,P,T,B,Span,WF) :- % removing this clause doubles runtime of COMPUTE_GRADIENT_CHANGE
4340		apply_closure_to_nonvar_wd_check(X,P,T,B,Span,WF).
4341
4342		apply_closure_to_nonvar_wd_check(X,P,T,B,Span,WF) :-
4343		\+ preferences:preference(find_abort_values,false),
4344		not_in_domain_wf(X,closure(P,T,B),WF),
4345		when((ground(X),ground(closure(P,T,B))),
4346		add_wd_error_span('function applied outside of domain (#3): ', '@fun'(X,closure(P,T,B)),Span,WF)).
4347
4348
4349		% propagate equality_objects between range and domain elements for function application:
4350		:- block prop_apply_eqxy(-,-).
4351		prop_apply_eqxy(Eqy,Eqx) :- var(Eqy),!, (Eqx = pred_true -> Eqy = pred_true ; true).
4352		prop_apply_eqxy(pred_false,pred_false).
4353		prop_apply_eqxy(pred_true,_).
4354
4355		:- block apply_to4(-,?,?, -,?,?,?,?,?).
4356		apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) :-
4357		var(EqResX),!, % Tail bound
4358		(Tail == []
4359		-> (preferences:preference(find_abort_values,false)
4360		-> EqResX = pred_true,
4361		apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)
4362		; apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)
4363		)
4364		; Tail = avl_set(_) -> apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) % TO DO: improve ! (e.g., expand to list if small or check if X can be in domain,...)
4365		; Tail = closure(_,_,_) -> apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)
4366		; Tail \= [_|_] -> add_internal_error('Illegal Tail: ',apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)),fail
4367		; Tail = [(X3,Y3)|T3], % setup equality check with X3, purpose: detect, e.g., when no other element in tail can match we can force EqResX to pred_true
4368		apply_to4_call5(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF, X3,Y3,T3)
4369		).
4370		apply_to4(pred_true,EqResY,Y2, Tail,X,Y,_InitialRel,_,WF) :-
4371	?	(EqResY==not_called -> equal_object_wf(Y2,Y,apply_to4,WF) ; EqResY = pred_true),
4372		optional_functionality_check(Tail,X,WF).
4373		apply_to4(pred_false,_EqResY,_Y2,T,X,Y,InitialRel,Span,WF) :- apply_to2(T,X,Y,InitialRel,Span,WF).
4374
4375		% we delay setting up equality_objects until X3 is at least partially known, see test 1715 Alstom_essai2_boucle1
4376		% TO DO: we could check if X3==X above
4377		:- block apply_to4_call5(-,?,?, ?,?,?,?,?,?, -,?,?).
4378		apply_to4_call5(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF, _X3,_Y3,_T3) :- nonvar(EqResX),!,
4379		apply_to4(EqResX,EqResY,Y2,Tail,X,Y,InitialRel,Span,WF).
4380		apply_to4_call5(EqResX,EqResY,Y2, _Tail,X,Y,InitialRel,Span,WF, X3,Y3,T3) :- % X3 must now be bound
4381		equality_objects_wf(X3,X,EqRes3,WF),
4382		apply_to5(EqResX,EqResY,EqRes3, Y2,X3,Y3,T3, X,Y, InitialRel,Span,WF).
4383
4384		% version which wait suntil first argument known
4385		:- block apply_to4_block(-,?,?, ?,?,?,?,?,?).
4386		apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) :-
4387		apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF).
4388
4389
4390		% apply_to5: implements a watched-literal style treatment of function application
4391		% we watch whether X unifies with two elements of the function, if only one element left we can force equality
4392		% TEST:
4393		% f : 11..23 +-> 1..10 & f = {a|->2, b|->3, c|->4} & card({a,b,c})=3 & f(x)=r & a>b & b>c & x>b
4394		:- block apply_to5(-,?,-, ?,?,?,?, ?,?, ?,?,?),apply_to5(-,?,?, ?,?,?,-, ?,?, ?,?,?).
4395		apply_to5(EqRes,EqResY,EqRes3, Y2,_X3,Y3,T3, X,Y, InitialRel,Span,WF) :-
4396		var(EqRes),!,
4397		% EqRes3 and T3 must be known; TO DO: improve predicate so that we have to wait on T3 only when EqRes3=pred_false
4398		(EqRes3 = pred_false -> % we cannot match next element, move tail one forward
4399		(T3 = [] -> EqRes=pred_true ; true),
4400		apply_to4(EqRes,EqResY,Y2,T3,X,Y,InitialRel,Span,WF)
4401		; /* EqRes3 = pred_true */
4402		% we match the next entry in the list; discard Y2 and jump to (X3,Y3) and return as solution
4403		equal_object_wf(Y3,Y,apply_to6,WF), optional_functionality_check(T3,X,WF),
4404		% TO DO: we could also do equality_objects if necessary between Y and Y3, as in apply_to4 for Y and Y2
4405		opt_force_false(EqRes)
4406		).
4407		apply_to5(pred_true,EqResY,EqRes3, Y2,X3,Y3,T3, X,Y, _InitialRel,_Span,WF) :-
4408		(EqResY==not_called -> equal_object_wf(Y2,Y,apply_to5,WF) ; EqResY = pred_true),
4409		opt_force_false(EqRes3),
4410		optional_functionality_check([(X3,Y3)|T3],X,WF).
4411		apply_to5(pred_false,_EqResY,EqRes3, _Y2,_X3,Y3,T3, X,Y, InitialRel,Span,WF) :-
4412		(var(EqRes3) -> % it can be that EqRes3 is about to be triggered
4413		equality_objects_wf(Y3,Y,EqResY3,WF),
4414		prop_apply_eqxy(EqResY3,EqRes3) % propagate: if Y/=Y3 => X/=X3
4415		; EqResY3=not_called),
4416		apply_to4(EqRes3,EqResY3,Y3, T3,X,Y,InitialRel,Span,WF).
4417
4418		opt_force_false(EqRes) :-
4419		(preference(find_abort_values,false) -> EqRes=pred_false
4420		; true). % TO DO: if EqRes becomes pred_true: raise abort_error as the relation was not a function
4421
4422
4423
4424		/********************************************/
4425		/* surjection_relation(R,Domain,Range) */
4426		/* R : Domain <->> Range */
4427		/********************************************/
4428		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:surjection_relation_wf([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)). % used to be wfdet (see in_domain_wf above)
4429		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:surjection_relation_wf([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(6),int(7)],WF),WF)).
4430
4431		surjection_relation_wf(R,Domain,Range,WF) :-
4432		is_surjective(R,Range,WF),
4433		% TODO: is not optimal since ran(R)<:Range is already implied by is_surjective and
4434		% checked a second time by relation_over_wf/4
4435	?	relation_over_wf(R,Domain,Range,WF).
4436
4437		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_surjection_relation_wf([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(6),int(7)],WF),WF)).
4438
4439		not_surjection_relation_wf(R,Domain,Range,WF) :-
4440		expand_custom_set_to_list_wf(R,ER,Done,not_surjection_relation_wf,WF),
4441		not_tot_surj_rel(ER,Done,[],Domain,Range,Range,WF).
4442
4443		/*********************************************/
4444		/* total_surjection_relation(R,Domain,Range) */
4445		/* R : Domain <<->> Range */
4446		/*********************************************/
4447		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_surjection_relation_wf([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4448		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:total_surjection_relation_wf([(int(1),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4449		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_surjection_relation_wf([(term(floating(1.0)),string(six)),(term(floating(2.0)),string(seven)),(term(floating(1.0)),string(seven))],[term(floating(1.0)),term(floating(2.0))],[string(seven),string(six)],WF),WF)).
4450
4451
4452		:- assert_must_succeed((findall(R,bsets_clp:total_surjection_relation(R,[int(1)],[int(11),int(12)]),L),
4453		lists:maplist(sort,L,SL), sort(SL,SSL), % added May15th due to change in domain_wf (bsets_clp:propagate_result_to_input); TO DO: see if we can go back to just one solution
4454		length(SSL,1))).
4455		%:- assert_must_succeed((findall(R,bsets_clp:total_surjection_relation(R,[int(1),int(2)],[int(11),int(12)]),L), length(L,7))).
4456		% the new domain predicate also instantiates from result; meaning that duplicate solutions are now generated
4457		:- assert_must_succeed((findall(SR,(bsets_clp:total_surjection_relation(R,[int(1),int(2)],[int(11),int(12)]),sort(R,SR)),L), sort(L,SL),length(SL,7))).
4458		:- assert_must_succeed((findall(R,bsets_clp:total_surjection_relation(R,[int(1),int(2)],[int(11)]),L),
4459		length(L,1))).
4460
4461		total_surjection_relation(R,Domain,Range) :- init_wait_flags(WF,[total_surjection_relation]),
4462		total_surjection_relation_wf(R,Domain,Range,WF), ground_wait_flags(WF).
4463
4464		total_surjection_relation_wf(R,Domain,Range,WF) :-
4465	?	relation_over_wf(R,Domain,Range,WF),
4466		check_relation_is_total(R,Domain,WF), % calls domain which now instantiates R if Domain known
4467		check_relation_is_surjective(R,Range,WF).
4468
4469
4470		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_relation_wf([(int(1),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4471		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_relation_wf([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4472		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_total_surjection_relation_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4473		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_relation_wf([(term(floating(1.0)),string(six)),(term(floating(2.0)),string(seven)),(term(floating(1.0)),string(seven))],[term(floating(1.0)),term(floating(2.0001))],[string(seven),string(six)],WF),WF)).
4474
4475		not_total_surjection_relation_wf(R,Domain,Range,WF) :-
4476		expand_custom_set_to_list_wf(R,ER,Done,not_total_surjection_relation_wf,WF),
4477	?	not_tot_surj_rel(ER,Done,Domain,Domain,Range,Range,WF).
4478
4479
4480		/********************************************/
4481		/* partial_surjection(R,DomType,RangeType) */
4482		/* R : DomType +->> RangeType */
4483		/********************************************/
4484
4485		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:partial_surjection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)). % used to be wfdet (see in_domain_wf above)
4486		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:partial_surjection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6),int(2)],WF),WF)).
4487		:- assert_must_succeed((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4488		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4489		:- assert_must_succeed((bsets_clp:partial_surjection(X,[int(1),int(2),int(3)],global_set('Name')),
4490		kernel_objects:equal_object(X,[(int(2),fd(1,'Name')),(int(1),fd(2,'Name')),(int(3),fd(3,'Name'))]))).
4491		:- assert_must_succeed((bsets_clp:partial_surjection_wf(X,[int(1),int(2),int(3)],global_set('Name'),_WF),
4492		kernel_objects:equal_object(X,[(int(2),fd(1,'Name')),(int(1),fd(2,'Name')),(int(3),fd(3,'Name'))]))).
4493		:- assert_must_succeed((bsets_clp:partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]),
4494		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4495		:- assert_must_succeed_multiple((bsets_clp:partial_surjection(X,[int(1),int(2),int(3),int(4)],[int(7),int(6)]),
4496		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6)),(int(3),int(6))]))). /* mult. */
4497		:- assert_must_succeed((X=[(int(2),int(7)),(int(1),int(6)),(int(3),int(6))],
4498		bsets_clp:partial_surjection(X,[int(1),int(2),int(3),int(4)],[int(7),int(6)]))).
4499		:- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4500		X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(7))])).
4501		:- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4502		X = [(int(2),int(7)),(int(1),int(7))])).
4503		:- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]),
4504		X = [(int(2),int(7)),(int(1),int(6)),(int(3),int(8))])).
4505		:- assert_must_succeed_multiple((bsets_clp:partial_surjection(_X,
4506		[int(1),int(2),int(3),int(4),int(5),int(6),int(7)],[int(2),int(3),int(4)]) )).
4507		:- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4508		X = [(int(2),int(7)),(int(2),int(6))])).
4509
4510		partial_surjection(R,Domain,Range) :- init_wait_flags(WF,[partial_surjection]),
4511		partial_surjection_wf(R,Domain,Range,WF),
4512		ground_wait_flags(WF).
4513
4514		:- block partial_surjection_wf(-,-,?,?).
4515		partial_surjection_wf(R,Domain,Range,WF) :-
4516		check_card_greater_equal(Domain,geq,Range,CardDom,CardRange),
4517		(surjection_has_to_be_total_injection(CardDom,CardRange)
4518		% LAW: card(setX) = card(setY) => ff: setX +->> setY <=> ff: setX >-> setY
4519	?	-> total_function_wf(R,Domain,Range,WF),
4520		injective(R,WF)
4521		; is_surjective(R,Range,WF),
4522	?	partial_function_wf(R,Domain,Range,WF)
4523		).
4524
4525
4526		% check_card_greater_equal(A,B) : quick check that card(A) >= card(B); also works with infinite cardinality
4527		% TO DO: replace by a better constraint propagating predicate (also working for partially instantiated lists,...)
4528		% compared with computing card and setting up < constraint: will only compute card if it can be done efficiently + deals with inf
4529		% check_card_greater_equal(SetA,EQ,SetB) ; EQ=eq or geq
4530		:- block check_card_greater_equal(-,?,?,?,?).
4531		check_card_greater_equal([],_,R,0,0) :- !, empty_set(R).
4532		check_card_greater_equal(A,EQ,B,CA,CB) :- check_card_greater_equal2(A,EQ,B,CA,CB).
4533
4534		:- use_module(inf_arith,[block_inf_greater_equal/2]).
4535		:- block check_card_greater_equal2(?,?,-,?,?).
4536		check_card_greater_equal2(A,EQ,B,CardA,CardB) :-
4537		efficient_card_for_set(A,CardA,CodeA),
4538		efficient_card_for_set(B,CardB,CodeB),!,
4539		call(CodeA), call(CodeB),
4540		(EQ=eq -> CardA=CardB ; block_inf_greater_equal(CardA,CardB)).
4541		check_card_greater_equal2(_A,_,_B,'?','?').
4542
4543
4544		:- block is_surjective(-,-,?).
4545		is_surjective(R,Range,WF) :-
4546		(var(R) -> setup_surj_range(Range,R,WF)
4547		; range_wf(R,Range,WF)).
4548
4549		setup_surj_range(Range,R,WF) :-
4550		setup_range(Range,Res,DONE,WF),
4551		equal_when_done(Res,R,DONE).
4552		:- block equal_when_done(?,?,-).
4553	?	equal_when_done(Res,R,_DONE) :- equal_object(Res,R).
4554
4555
4556		:- block setup_range(-,?,?,?).
4557		setup_range(global_set(G),Res,DONE,WF) :-
4558		expand_custom_set_wf(global_set(G),ES,setup_range,WF),
4559		setup_range(ES,Res,DONE,WF).
4560		setup_range(freetype(ID),Res,DONE,WF) :-
4561		expand_custom_set_wf(freetype(ID),ES,setup_range,WF), setup_range(ES,Res,DONE,WF).
4562		setup_range(avl_set(S),Res,DONE,WF) :-
4563		expand_custom_set_wf(avl_set(S),ES,setup_range,WF), setup_range(ES,Res,DONE,WF).
4564		setup_range(closure(P,T,B),Res,DONE,WF) :-
4565		expand_custom_set_wf(closure(P,T,B),ES,setup_range,WF), setup_range(ES,Res,DONE,WF).
4566		setup_range([],_,done,_WF).
4567		setup_range([H|T],[(_,H)|ST],DONE,WF) :- setup_range(T,ST,DONE,WF).
4568
4569
4570
4571		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_partial_surjection_wf([(int(1),int(6)),(int(2),int(7))],
4572		[int(1),int(2)],[int(7),int(6)],WF),WF)).
4573		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_partial_surjection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],
4574		[int(7),int(6),int(2)],WF),WF)).
4575		:- assert_must_fail((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4576		X = [(int(2),int(7)),(int(1),int(6))])).
4577		:- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4578		X = [(int(2),int(7)),(int(2),int(6))])).
4579		:- assert_must_fail((bsets_clp:not_partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]),
4580		X = [(int(2),int(7)),(int(1),int(6))])).
4581		:- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4582		X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(7))])).
4583		:- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4584		X = [(int(2),int(7)),(int(1),int(7))])).
4585		:- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]),
4586		X = [(int(2),int(7)),(int(1),int(6)),(int(3),int(8))])).
4587
4588
4589
4590		/* /: Domain +->> Range */
4591		not_partial_surjection(R,Domain,Range) :- init_wait_flags(WF,[not_partial_surjection]),
4592		not_partial_surjection_wf(R,Domain,Range,WF),
4593		ground_wait_flags(WF).
4594
4595		:- block not_partial_surjection_wf(-,?,?,?).
4596		not_partial_surjection_wf(R,DomType,RangeType,WF) :-
4597	?	partial_surjection_test_wf(R,DomType,RangeType,pred_false,WF).
4598
4599
4600		%not_surjective_relation_wf(R,DomType,RType,WF) :-
4601		% invert_relation_wf(R,IR,WF),
4602		% not_total_relation_wf(IR,RType,DomType,WF).
4603
4604
4605		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:partial_surjection_test_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],pred_true,WF),WF)).
4606		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:partial_surjection_test_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6),int(2)],pred_false,WF),WF)).
4607
4608		partial_surjection_test_wf(R,DomType,RangeType,PredRes,WF) :-
4609		partial_function_test_wf(R,DomType,RangeType,IsPF,WF),
4610		(IsPF==pred_false -> PredRes=pred_false
4611		; range_wf(R,RelRan,WF),
4612	?	conjoin_test(IsPF,IsSurjective,PredRes,WF),
4613		subset_test(RangeType,RelRan,IsSurjective,WF)
4614		).
4615
4616
4617		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_relation_wf([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4618		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:total_relation_wf([(int(1),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4619		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_relation_wf([(term(floating(1.0)),string(six)),(term(floating(2.0)),string(seven)),(term(floating(1.0)),string(seven))],[term(floating(1.0)),term(floating(2.0))],[string(seven),string(six)],WF),WF)).
4620
4621		:- assert_must_succeed((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4622		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4623		:- assert_must_succeed((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4624		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
4625		:- assert_must_succeed((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4626		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6)),(int(1),int(7))]))).
4627		:- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4628		kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
4629		:- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4630		kernel_objects:equal_object(X,[(int(2),int(7))]))).
4631		:- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4632		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6)),(int(1),int(8))]))).
4633		:- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4634		kernel_objects:equal_object(X,[(int(2),int(7)),(int(3),int(6)),(int(1),int(7))]))).
4635		:- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4636		kernel_objects:equal_object(X,[]))).
4637
4638		/****************************************/
4639		/* total_relation_wf(R,Domain,Range,WF) */
4640		/* R : Domain <<-> Range */
4641		/****************************************/
4642
4643	?	total_relation_wf(R,Domain,Range,WF) :- relation_over_wf(R,Domain,Range,WF),
4644		check_relation_is_total(R,Domain,WF).
4645
4646		% this predicates assume that the relation's range and domain have already been checked
4647		check_relation_is_total(Relation,Domain,WF) :- domain_wf(Relation,Domain,WF).
4648		check_relation_is_surjective(Relation,Range,WF) :-
4649		range_wf(Relation,Range,WF). % we could also call is_surjective (which does setup_surj_range) ?
4650
4651		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_total_relation_wf([(int(1),int(6)),(int(2),int(7)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4652		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_relation_wf([(int(1),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4653		:- assert_must_fail((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4654		X = [(int(2),int(7)),(int(1),int(6))])).
4655		:- assert_must_fail((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4656		X = [(int(2),int(7)),(int(1),int(7))])).
4657		:- assert_must_fail((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4658		X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(7))])).
4659		:- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4660		X = [(int(2),int(7)),(int(2),int(6))])).
4661		:- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4662		X = [(int(2),int(7))])).
4663		:- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4664		X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(8))])).
4665		:- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4666		X = [(int(2),int(7)),(int(3),int(6)),(int(1),int(7))])).
4667
4668		:- block not_total_relation_wf(-,?,?,?).
4669		not_total_relation_wf(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
4670		% we do not need the Range; this means we can match more closures (e.g., lambda)
4671		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_),WF),!,
4672		not_equal_object_wf(FFDomain,Domain,WF).
4673		not_total_relation_wf(FF,Domain,Range,WF) :- nonvar(FF),
4674		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_),WF),!,
4675		equality_objects_wf(FFDomain,Domain,Result,WF), % not yet implemented ! % TODO ! -> sub_set,equal,super_set
4676		when(nonvar(Result),(Result=pred_false -> true ; not_subset_of_wf(FFRange,Range,WF))).
4677		not_total_relation_wf(R,Domain,Range,WF) :-
4678		expand_custom_set_to_list_wf(R,ER,Done,not_total_relation_wf,WF),
4679		not_tot_surj_rel(ER,Done,Domain,Domain,[],Range,WF). % empty DelRange means we don't do surjective test
4680
4681		% can be used to check not total, not surj, not total surj relation
4682		:- block not_tot_surj_rel(-,?,?,?,?,?,?).
4683		not_tot_surj_rel([],_,DelDomain,_,DelRange,_,WF) :-
4684	?	at_least_one_set_not_empty(DelDomain,DelRange,WF).
4685		not_tot_surj_rel([_|_],Done,DelDom,Dom,_DelRan,_Ran,_WF) :- nonvar(Done),
4686		Done \= no_check_to_be_done,
4687		nonvar(DelDom),DelDom \= [],
4688		nonvar(Dom),is_infinite_explicit_set(Dom),
4689		!. % a finite expanded list can never be a total relation over an infinite domain
4690		not_tot_surj_rel([(X,Y)|T],_Done,DelDom,Dom,DelRan,Ran,WF) :-
4691		membership_test_wf(Dom,X,MemRes,WF),
4692		not_tr2(MemRes,X,Y,T,DelDom,Dom,DelRan,Ran,WF).
4693
4694		% check if one of the two sets is non-empty
4695		at_least_one_set_not_empty(Set1,Set2,_) :- (Set=Set1 ; Set=Set2),
4696		nonvar(Set),
4697		(Set=avl_set(_) ; Set=[_|_]), % we can avoid leaving choice point
4698		!.
4699		at_least_one_set_not_empty(Set1,_,WF) :- not_empty_set_wf(Set1,WF).
4700		at_least_one_set_not_empty(Set1,Set2,WF) :- empty_set_wf(Set1,WF),not_empty_set_wf(Set2,WF).
4701
4702		:- block not_tr2(-,?,?,?,?,?,?,?,?).
4703		not_tr2(pred_false,_X,_Y,_T,_DelDom,_Dom,_DelRan,_Ran,_WF).
4704		not_tr2(pred_true,X,Y,T,DelDom,Dom,DelRan,Ran,WF) :-
4705		delete_element_wf(X,DelDom,DelDom2,WF), % set DelDom initially to [] to avoid totality check
4706		membership_test_wf(Ran,Y,MemRes,WF),
4707		not_tr3(MemRes,Y,T,DelDom2,Dom,DelRan,Ran,WF).
4708
4709		:- block not_tr3(-,?,?,?,?,?,?,?).
4710		not_tr3(pred_false,_Y,_T,_DelDom2,_Dom,_DelRan,_Ran,_WF).
4711		not_tr3(pred_true,Y,T,DelDom2,Dom,DelRan,Ran,WF) :-
4712		delete_element_wf(Y,DelRan,DelRan2,WF), % set DelRan initially to [] to avoid surjection check
4713		not_tot_surj_rel(T,no_check_to_be_done,DelDom2,Dom,DelRan2,Ran,WF).
4714
4715		/******************************************/
4716		/* total_surjection(R,DomType,RangeType) */
4717		/* R : DomType -->> RangeType */
4718		/******************************************/
4719
4720		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:total_surjection_wf([(int(2),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)). % used to be wfdet (see in_domain_wf above)
4721		:- assert_must_succeed(exhaustive_kernel_succeed_check((bsets_clp:total_surjection_wf([(int(2),int(6)),(int(1),int(7)),(int(3),int(7))],[int(1),int(2),int(3)],[int(7),int(6)],WF),kernel_waitflags:ground_det_wait_flag(WF)))). %% TO DO: get rid of multiple solutions
4722		:- assert_must_succeed((bsets_clp:total_surjection(X,[int(1)],[int(7)]),
4723		kernel_objects:equal_object(X,[(int(1),int(7))]))).
4724		:- assert_must_succeed((bsets_clp:total_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4725		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4726		:- assert_must_succeed((bsets_clp:total_surjection(X,[int(1),int(2)],[int(7)]),
4727		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
4728		:- assert_must_fail((bsets_clp:total_surjection([],[int(1)],[int(7)]))).
4729		:- assert_must_fail((bsets_clp:total_surjection([(int(7),int(7))],[int(1)],[int(7)]))).
4730		:- assert_must_fail((bsets_clp:total_surjection([(int(1),int(7)), (int(2),int(1))],
4731		[int(1),int(2)],[int(7)]))).
4732		:- assert_must_fail((bsets_clp:total_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4733		kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
4734
4735
4736		total_surjection(R,Domain,Range) :- init_wait_flags(WF),
4737		total_surjection_wf(R,Domain,Range,WF),
4738		ground_wait_flags(WF).
4739
4740		:- block total_surjection_wf(-,-,?,?).
4741		total_surjection_wf(R,DomType,RangeType,WF) :-
4742		check_card_greater_equal(DomType,geq,RangeType,CardDom,CardRange),
4743	?	total_function_wf(R,DomType,RangeType,WF),
4744		% setup_surj_range(RangeType,R,WF).
4745		(surjection_has_to_be_total_injection(CardDom,CardRange)
4746		% LAW: card(setX) = card(setY) => ff: setX -->> setY <=> ff: setX >-> setY
4747		-> injective(R,WF) % if domain and range have same cardinality: injection ensures surjectivity, and is more efficient to check/propagate; example when using queens 1..n -->> 1..n for NQueens
4748		; check_relation_is_surjective(R,RangeType,WF)).
4749		% invert_relation_wf(R,IR,WF), total_relation_wf(IR,RangeType,DomType,WF).
4750
4751		surjection_has_to_be_total_injection(CardDom,CardRange) :- number(CardDom), CardDom=CardRange.
4752		% TO DO: determine the difference in size between Dom and Range and count how many times a range element can occur multiple times (would give better incremental checking)
4753
4754		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_wf([(int(2),int(6)),(int(1),int(7))],[int(1),int(2),int(3)],[int(7),int(6)],WF),WF)).
4755		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_wf([(int(2),int(6)),(int(1),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4756		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_wf([(int(2),int(6)),(int(1),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4757		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_wf([(int(2),int(6)),(int(1),int(7)),(int(3),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4758		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_total_surjection_wf([(int(2),int(6)),(int(1),int(7)),(int(3),int(8))],[int(1),int(2),int(3)],[int(7),int(6)],WF),WF)).
4759		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:not_total_surjection_wf([(int(2),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4760
4761		:- block not_total_surjection_wf(-,?,?,?), not_total_surjection_wf(?,-,-,?).
4762		not_total_surjection_wf(R,DomType,RangeType,WF) :-
4763		total_function_test_wf(R,DomType,RangeType,PredRes,WF),
4764		not_total_surjection2(PredRes,R,DomType,RangeType,WF).
4765		:- block not_total_surjection2(-,?,?,?,?).
4766		not_total_surjection2(pred_false,_R,_DomType,_RangeType,_WF).
4767		not_total_surjection2(pred_true,R,_DomType,RangeType,WF) :-
4768		range_wf(R,RelRange,WF),
4769		opt_push_wait_flag_call_stack_info(WF,b_operator_call(not_subset,
4770		[RangeType,b_operator(range,[R])],unknown),WF2),
4771		not_subset_of_wf(RangeType,RelRange,WF2).
4772		%not_surjective_relation_wf(R,DomType,RangeType,WF).
4773
4774		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_function_test_wf([(int(2),int(6)),(int(1),int(7)),(int(3),int(8))],[int(1),int(2),int(3)],[int(7),int(6)],pred_false,WF),WF)).
4775		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:total_function_test_wf([(int(2),int(6)),(int(1),int(7)),(int(3),int(6))],[int(1),int(2),int(3)],[int(7),int(6)],pred_true,WF),WF)). % used to be wfdet (see in_domain_wf above)
4776		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:total_function_test_wf([(int(2),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],pred_false,WF),WF)).
4777
4778		% reified total function check:
4779		total_function_test_wf(R,DomType,RangeType,PredRes,WF) :-
4780		partial_function_test_wf(R,DomType,RangeType,IsPF,WF),
4781		(IsPF==pred_false -> PredRes=pred_false
4782		; domain_wf(R,RelDom,WF),
4783		conjoin_test(IsPF,IsTotal,PredRes,WF),
4784		opt_push_wait_flag_call_stack_info(WF,b_operator_call(subset,
4785		[DomType,b_operator(domain,[R])],unknown),WF2),
4786		subset_test(DomType,RelDom,IsTotal,WF2)
4787		).
4788
4789		/*******************************************/
4790		/* partial_injection(R,DomType,RangeType) */
4791		/* R : DomType >+> RangeType */
4792		/*******************************************/
4793
4794		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_injection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4795		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_injection_wf([(int(1),int(6)),(int(4),int(7)),(int(2),int(8))],[int(1),int(2),int(3),int(4)],[int(7),int(6),int(8),int(9)],WF),WF)).
4796		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_injection_wf([(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4797		:- assert_must_succeed((bsets_clp:partial_injection(X,[int(1)],[int(7)]),
4798		kernel_objects:equal_object(X,[(int(1),int(7))]))).
4799		:- assert_must_succeed((bsets_clp:partial_injection(X,[int(1),int(2)],[int(7),int(6)]),
4800		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4801		:- assert_must_fail((bsets_clp:partial_injection(X,[int(1),int(2)],[int(7)]),
4802		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
4803		:- assert_must_succeed((bsets_clp:partial_injection([],[int(1)],[int(7)]))).
4804		:- assert_must_fail((bsets_clp:partial_injection([(int(7),int(7))],[int(1)],[int(7)]))).
4805		:- assert_must_fail((bsets_clp:partial_injection([(int(1),int(7)), (int(2),int(1))],
4806		[int(1),int(2)],[int(7)]))).
4807		:- assert_must_fail((bsets_clp:partial_injection(X,[int(1),int(2)],[int(7),int(6)]),
4808		kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
4809
4810
4811		partial_injection(R,Domain,Range) :- init_wait_flags(WF),
4812		partial_injection_wf(R,Domain,Range,WF),
4813		ground_wait_flags(WF).
4814
4815		:- block partial_injection_wf(-,-,?,?).
4816		partial_injection_wf(FF,Domain,Range,WF) :- nonvar(FF),
4817		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection),WF),!,
4818		check_domain_subset_for_closure_wf(FF,FFDomain,Domain,WF),
4819		check_range_subset_for_closure_wf(FF,FFRange,Range,WF).
4820		partial_injection_wf(R,DomType,RangeType,WF) :-
4821		try_expand_and_convert_to_avl_unless_large_wf(R,ER,WF), % should we use very_large?
4822	?	partial_function_wf(ER,DomType,RangeType,WF),
4823		injective(ER,WF).
4824		% invert_relation_wf(R,IR,WF),
4825		% partial_function_wf(IR,RangeType,DomType,WF).
4826
4827		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective([(int(1),int(6)),(int(4),int(7)),(int(2),int(8))],WF),WF)).
4828		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:injective([(int(1),int(6)),(int(4),int(7)),(int(2),int(7))],WF),WF)).
4829
4830		:- block injective(-,?).
4831		injective(FF,WF) :-
4832		custom_explicit_sets:dom_range_for_specific_closure(FF,_FFDomain,_FFRange,function(bijection),WF),!.
4833		injective(avl_set(AVL),_WF) :- !,
4834		is_injective_avl_relation(AVL,_Range). % seems slightly faster than injective/3 code below
4835		injective(closure(P,T,B),WF) :- !,
4836		symbolic_injectivity_check(closure(P,T,B),WF).
4837		injective(Rel,WF) :- expand_custom_set_to_list_wf(Rel,ERel,_,injective,WF),
4838		injective(ERel,[],WF).
4839
4840		%:- use_module(library(lists),[maplist/3]).
4841		% for FD-sets we could setup all_different constraint
4842		:- block injective(-,?,?).
4843		injective([],_SoFar,_).
4844		% (maplist(get_fd_val,SoFar,FDL) -> clpfd:all_distinct(FDL) ; true). %clpfd_interface:clpfd_alldifferent(FDL) ; true).
4845		%get_fd_val(int(H),H).
4846		injective([(_From,To)|T],SoFar,WF) :-
4847		not_element_of_wf(To,SoFar,WF), /* check that it is injective */
4848		add_new_element_wf(To,SoFar,SoFar2,WF), %SoFar2=[To|SoFar], could also work and be faster ?
4849		injective(T,SoFar2,WF).
4850		% no case for global_set: it cannot be a relation; two cases below not required because of expand_custom_set_to_list
4851		%injective(avl_set(S),SoFar,WF) :- expand_custom_set_wf(avl_set(S),ES,inj,WF), injective(ES,SoFar,WF).
4852		%injective(closure(P,T,B),SoFar,WF) :- expand_custom_set_wf(closure(P,T,B),ES,inj,WF), injective(ES,SoFar,WF).
4853
4854
4855
4856		/* /: Dom >+> R */
4857
4858		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_injection([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4859		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_injection([(int(1),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4860		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_injection([(int(1),int(6)),(int(2),int(8))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4861		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_partial_injection([(int(1),int(6)),(int(3),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4862
4863		:- block not_partial_injection(-,?,?,?).
4864		not_partial_injection(R,DomType,RangeType,WF) :-
4865		partial_function_test_wf(R,DomType,RangeType,IsPF,WF),
4866		not_partial_injection2(IsPF,R,DomType,RangeType,WF).
4867
4868		:- block not_partial_injection2(-,?,?,?,?).
4869		not_partial_injection2(pred_false,_R,_DomType,_RType,_WF).
4870		not_partial_injection2(pred_true,R,DomType,RType,WF) :-
4871		not_injection_wf(R,DomType,RType,WF).
4872
4873		not_injection_wf(R,DomType,RType,WF) :-
4874		invert_relation_wf(R,IR,WF),
4875		not_partial_function(IR,RType,DomType,WF).
4876
4877		/*****************************************/
4878		/* total_injection(R,DomType,RangeType) */
4879		/* R : DomType >-> RangeType */
4880		/*****************************************/
4881
4882		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_injection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4883		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:total_injection_wf([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4884		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_total_injection([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4885		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_total_injection([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4886		:- assert_must_succeed((bsets_clp:total_injection(X,[int(1)],[int(7)]),
4887		kernel_objects:equal_object(X,[(int(1),int(7))]))).
4888		:- assert_must_succeed((bsets_clp:total_injection(X,[int(1),int(2)],[int(7),int(6)]),
4889		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4890		:- assert_must_fail((bsets_clp:total_injection(X,[int(1),int(2)],[int(7)]),
4891		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
4892		:- assert_must_fail((bsets_clp:total_injection([],[int(1)],[int(7)]))).
4893		:- assert_must_fail((bsets_clp:total_injection([(int(7),int(7))],[int(1)],[int(7)]))).
4894		:- assert_must_fail((bsets_clp:total_injection([(int(1),int(7)), (int(2),int(1))],
4895		[int(1),int(2)],[int(7)]))).
4896		:- assert_must_fail((bsets_clp:total_injection(X,[int(1),int(2)],[int(7),int(6)]),
4897		kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
4898
4899
4900		total_injection(R,Domain,Range) :- init_wait_flags(WF),
4901		total_injection_wf(R,Domain,Range,WF),
4902		ground_wait_flags(WF).
4903
4904		:- block total_injection_wf(-,-,?,?). % with just ?,-,?,? we may wait too long to start injective check
4905		% Note: no need to check: dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection)),
4906		total_injection_wf(R,DomType,RangeType,WF) :-
4907		check_card_greater_equal(RangeType,geq,DomType,_,_), % there must be more Range elements than domain elements; pigeonhole principle
4908	?	total_injection_wf2(R,DomType,RangeType,WF).
4909		total_injection_wf2(R,DomType,RangeType,WF) :-
4910		try_expand_and_convert_to_avl_unless_large_wf(R,ER,WF),
4911	?	total_function_wf(ER,DomType,RangeType,WF),
4912		injective(ER,WF).
4913
4914
4915		:- block not_total_injection(-,?,?,?), not_total_injection(?,-,-,?).
4916		not_total_injection(R,DomType,RangeType,WF) :-
4917		total_function_test_wf(R,DomType,RangeType,PredRes,WF),
4918		not_total_injection2(PredRes,R,DomType,RangeType,WF).
4919
4920		:- block not_total_injection2(-,?,?,?,?).
4921		not_total_injection2(pred_false,_R,_Dom,_Ran,_WF).
4922		not_total_injection2(pred_true,R,DomType,RangeType,WF) :-
4923		% TO DO: replace DomType and RangeType by full Type
4924		not_injection_wf(R,DomType,RangeType,WF).
4925
4926		/***********************************/
4927		/* partial_bijection(R,DomType,RangeType) */
4928		/* R : DomType >+>> RangeType */
4929		/***********************************/
4930
4931		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:partial_bijection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)). % used to be wfdet (see in_domain_wf above)
4932		:- assert_must_succeed(exhaustive_kernel_fail_check_wfdet(bsets_clp:partial_bijection_wf([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4933		:- assert_must_succeed((partial_bijection(X,[int(1),int(2)],[int(7),int(6)]),
4934		kernel_objects:equal_object(X,[(int(1),int(6)),(int(2),int(7))]))).
4935		:- assert_must_succeed((partial_bijection(X,[int(1),int(2),int(3),int(4)],[int(7),int(6)]),
4936		X = [(int(2),int(7)),(int(3),int(6))])).
4937		:- assert_must_fail((partial_bijection(X,[int(1),int(2)],[int(7),int(6),int(5)]),
4938		X = [(int(2),int(7)),(int(1),int(6))])).
4939
4940		partial_bijection(R,Domain,Range) :- init_wait_flags(WF),
4941		partial_bijection_wf(R,Domain,Range,WF),
4942		ground_wait_flags(WF).
4943
4944		partial_bijection_wf(R,DomType,RangeType,WF) :-
4945	?	partial_injection_wf(R,DomType,RangeType,WF),
4946	?	partial_surjection_wf(R,DomType,RangeType,WF).
4947
4948		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_partial_bijection([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4949		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_partial_bijection([(int(1),int(6)),(int(2),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4950
4951		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_partial_bijection([(int(2),int(7)),(int(1),int(6))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4952
4953		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_partial_bijection([(int(2),int(7)),(int(3),int(6))],[int(1),int(2),int(3),int(4)],[int(7),int(6)],WF),WF)).
4954		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_partial_bijection([(int(2),int(7)),(int(1),int(6))],[int(1),int(2)],[int(7),int(6),int(5)],WF),WF)).
4955
4956
4957		:- block not_partial_bijection(-,?,?,?), not_partial_bijection(?,-,-,?).
4958		not_partial_bijection(R,DomType,RangeType,WF) :-
4959		% >+>> = +->> + injective
4960		partial_surjection_test_wf(R,DomType,RangeType,PredRes,WF),
4961		not_partial_bijection2(PredRes,R,DomType,RangeType,WF).
4962
4963		:- block not_partial_bijection2(-,?,?,?,?).
4964		not_partial_bijection2(pred_false,_R,_DomType,_RangeType,_WF).
4965		not_partial_bijection2(pred_true,R,DomType,RangeType,WF) :-
4966		not_injection_wf(R,DomType,RangeType,WF).
4967
4968
4969
4970		/* The transitive (not reflexive) closure of a relation (closure1) */
4971
4972		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:relational_trans_closure([(int(1),int(2)),(int(2),int(6))],[(int(1),int(2)),(int(1),int(6)),(int(2),int(6))]))).
4973		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:relational_trans_closure([(int(1),int(2)),(int(2),int(6)),(int(1),int(3))],[(int(1),int(2)),(int(1),int(3)),(int(1),int(6)),(int(2),int(6))]))).
4974		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:relational_trans_closure([(int(6),int(7)),(int(1),int(2)),(int(2),int(6)),(int(1),int(3))],[(int(1),int(2)),(int(1),int(3)),(int(1),int(6)),(int(2),int(6)),(int(1),int(7)),(int(2),int(7)),(int(6),int(7))]))).
4975		:- assert_must_succeed((bsets_clp:relational_trans_closure([(int(1),int(4))],X),
4976		kernel_objects:equal_object(X,[(int(1),int(4))]))).
4977		:- assert_must_succeed((bsets_clp:relational_trans_closure([(int(1),int(4)),(int(4),int(2))],X),
4978		kernel_objects:equal_object(X,[(int(1),int(4)),(int(4),int(2)),
4979		(int(1),int(2))]))).
4980		:- assert_must_succeed((bsets_clp:relational_trans_closure([(int(1),int(4)),(int(4),int(2)),(int(2),int(3))],X),
4981		kernel_objects:equal_object(X,[(int(1),int(4)),(int(4),int(2)),(int(2),int(3)),
4982		(int(4),int(3)),(int(1),int(2)),(int(1),int(3))]))).
4983		:- assert_must_succeed((bsets_clp:relational_trans_closure([(int(A),int(2)),(int(2),int(6))],
4984		[(int(1),int(2)),(int(1),int(6)),(int(2),int(6))]),A=1)).
4985
4986		relational_trans_closure(Rel,Res) :- relational_trans_closure_wf(Rel,Res,no_wf_available).
4987
4988		% transitive closure for relations (closure1)
4989		:- block relational_trans_closure_wf(-,?,?).
4990		relational_trans_closure_wf(Relation,Result,WF) :-
4991		try_expand_and_convert_to_avl_with_check(Relation,ARelation,relational_trans_closure_wf),
4992	?	relational_trans_closure2(ARelation,Result,WF).
4993		:- block relational_trans_closure2(-,?,?).
4994		relational_trans_closure2(ARelation,Result,WF) :-
4995		(closure1_for_explicit_set(ARelation,Res)
4996		-> kernel_objects:equal_object_wf(Res,Result,relational_trans_closure_wf,WF)
4997		; expand_custom_set_to_list_wf(ARelation,ERelation,_,relational_trans_closure2,WF),
4998		is_full_relation(ERelation,WaitVar), % still required??
4999		% we could do a check_subset_of_wf(ERelation,Resul,WF) if Result is nonvar and ERelation not ground
5000	?	compute_trans_closure(ERelation,Result,WaitVar,WF)
5001		).
5002
5003		:- block compute_trans_closure(?,?,-,?).
5004		compute_trans_closure(Relation,Result,_,WF) :-
5005	?	compute_trans_closure2(Relation,1,Result,WF).
5006
5007		compute_trans_closure2(Relation,Cnt,Result,WF) :-
5008		one_closure_iteration(Relation,Relation,Relation,Result1,Added,Done,WF),
5009	?	compute_trans_closure3(Relation,Cnt,Result1,Added,Done,Result,WF).
5010
5011		:- block compute_trans_closure3(?,?,?,?,-,?,?).
5012		compute_trans_closure3(Relation,Cnt,Result1,Added,_Done,Result,WF) :-
5013		( equal_object_wf(Result1,Relation,relational_trans_closure_wf,WF), % should we do equality_objects here?
5014	?	equal_object_optimized_wf(Result,Result1,compute_trans_closure,WF)
5015		;
5016		Added==possibly_added,
5017		not_equal_object_wf(Result1,Relation,WF), % not a fixpoint; continue
5018		IterCnt is Cnt+1,
5019	?	compute_trans_closure2(Result1,IterCnt,Result,WF)
5020		).
5021
5022		:- block one_closure_iteration(?,?,-,?,?,?,?).
5023		one_closure_iteration([],_,IterRes,OutRel,Added,Done,WF) :-
5024		equal_object_wf(IterRes,OutRel,one_closure_iteration,WF),
5025		(var(Added) -> Added=not_added ; true),
5026		Done=done.
5027		one_closure_iteration([(X,Y)|T],ExpandedPreviousRel,PreviousRel,OutRel,Added,Done,WF) :-
5028		add_tuples(ExpandedPreviousRel,X,Y,PreviousRel,IntRel,Added,DoneTuples,WF),
5029		one_closure_iteration_block(DoneTuples,T,ExpandedPreviousRel,IntRel,OutRel,Added,Done,WF).
5030
5031		:- block one_closure_iteration_block(-,?,?,?,?,?,?,?).
5032		one_closure_iteration_block(_,T,ExpandedPreviousRel,IntRel,OutRel,Added,Done,WF) :-
5033	?	one_closure_iteration(T,ExpandedPreviousRel,IntRel,OutRel,Added,Done,WF).
5034
5035		add_tuples([],_,_,OutRel,OutRel,_Added,done,_).
5036		add_tuples([(X,Y)|T],OX,OY,InRel,OutRel,Added,Done,WF) :-
5037		% add tuple (X,OY) if we have Y=OX
5038		equality_objects_wf(Y,OX,EqRes,WF),
5039		add_tuples_aux(EqRes,X,T,OX,OY,InRel,OutRel,Added,Done,WF).
5040
5041		:- block add_tuples_aux(-,?,?,?,?,?,?,?,?,?).
5042		add_tuples_aux(pred_true,X,T,OX,OY,InRel,OutRel,possibly_added,Done,WF) :-
5043		add_element_wf((X,OY),InRel,IntRel,WF), % add transitive couple X -> OY
5044	?	add_tuples(T,OX,OY,IntRel,OutRel,_,Done,WF).
5045		add_tuples_aux(pred_false,_X,T,OX,OY,InRel,OutRel,Added,Done,WF) :- % no transitive couple needed
5046	?	add_tuples(T,OX,OY,InRel,OutRel,Added,Done,WF).
5047
5048
5049		:- assert_must_succeed((is_full_relation(X,R),var(R),X=[],R==true)).
5050		:- assert_must_succeed((is_full_relation(X,R),var(R),X=[(A,B)|T],var(R),A=int(1),var(R),B=A,var(R),T=[],R==true)).
5051		:- block is_full_relation(-,?).
5052		is_full_relation([],R) :- !,R=true.
5053		is_full_relation([H|T],W) :- !, is_full_relation_aux(H,T,W).
5054		is_full_relation(X,R) :-
5055		add_internal_error('Illegal Set for is_full_relation: ',is_full_relation(X,R)),fail.
5056
5057		:- block is_full_relation_aux(-,?,?).
5058		is_full_relation_aux((X,Y),T,W) :- !, is_full_relation_aux2(X,Y,T,W).
5059		is_full_relation_aux(X,T,W) :-
5060		add_internal_error('Illegal Set for is_full_relation: ',is_full_relation_aux(X,T,W)),fail.
5061		:- block is_full_relation_aux2(-,?,?,?), is_full_relation_aux2(?,-,?,?).
5062	?	is_full_relation_aux2(_X,_Y,T,W) :- is_full_relation(T,W).
5063
5064		/* ------------------ */
5065
5066		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_closure1_wf((int(1),int(3)),[(int(1),int(2)),(int(2),int(1)),(int(2),int(3))],WF),WF)). % used to be wfdet (see in_domain_wf above)
5067
5068		in_closure1_wf(Pair,Relation,WF) :- %Pair = (_A,B),
5069		%in_domain_wf_lazy(A,Relation,WF), % done below
5070		%check_element_of_wf((_,B),Relation,WF), % multiple solutions for _, see test 634, 637
5071		in_closure1_membership_test_wf(Pair,Relation,pred_true,WF).
5072
5073
5074		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_closure1_wf((int(1),int(3)),[(int(1),int(2)),(int(2),int(1)),(int(3),int(3))],WF),WF)).
5075
5076		not_in_closure1_wf(Pair,Relation,WF) :-
5077		in_closure1_membership_test_wf(Pair,Relation,pred_false,WF).
5078
5079		:- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[],Res,_WF),Res==pred_false)).
5080		:- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(2))],Res,_WF),Res==pred_true)).
5081		:- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(3))],Res,_WF),Res==pred_false)).
5082		:- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(3)),(int(3),int(2))],Res,_WF),Res==pred_true)).
5083		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(3)),(int(3),int(2))],pred_true,WF),WF)). % used to be wfdet (see in_domain_wf above)
5084		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_closure1_membership_test_wf((int(11),int(3)),[(int(11),int(3))],pred_true,WF),WF)).
5085		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_closure1_membership_test_wf((int(11),int(3)),[(int(11),int(33))],pred_false,WF),WF)).
5086		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_closure1_membership_test_wf((int(1),int(3)),[(int(11),int(3))],pred_false,WF),WF)).
5087		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:in_closure1_membership_test_wf((int(11),int(22)),[(int(11),int(3)),(int(33),int(2)),(int(3),int(22)),(int(11),int(3))],pred_true,WF),WF)). % used to be wfdet (see in_domain_wf above)
5088		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_closure1_membership_test_wf((int(11),int(11)),[(int(11),int(3))],pred_false,WF),WF)).
5089
5090		:- block force_in_domain(-,?,?,?).
5091		force_in_domain(pred_false,_A,_Relation,_WF).
5092		force_in_domain(pred_true,A,Relation,WF) :- % force A to be in domain, avoid enumeration warnings,...
5093		% maybe only for non-ground A
5094	?	in_domain_wf_lazy(A,Relation,WF). % slowdown Loop.mch (tests 634, 637) if we use in_domain_wf ?
5095
5096		% (x,y) : closure1(Rel)
5097		:- block in_closure1_membership_test_wf(?,-,?,?).
5098		in_closure1_membership_test_wf((A,B),CSRelation,MemRes,WF) :-
5099		is_custom_explicit_set(CSRelation,in_closure1),
5100		!,
5101		image_for_closure1_wf(CSRelation,[A],Image,WF),
5102		force_in_domain(MemRes,A,CSRelation,WF),
5103		membership_test_wf(Image,B,MemRes,WF).
5104		in_closure1_membership_test_wf((X,Y),Relation,MemRes,WF) :-
5105		expand_custom_set_to_list_wf(Relation,ERelation,_,in_closure1_membership_test_wf,WF),
5106		Discarded = [], % pairs discarded in current iteration
5107		force_in_domain(MemRes,X,Relation,WF),
5108		in_closure1_membership_test_wf2(ERelation,X,Y,Discarded,MemRes,WF).
5109
5110		:- block in_closure1_membership_test_wf2(-,?,?,?,?,?).
5111		in_closure1_membership_test_wf2([],_X,_Y,_,MemRes,_WF) :- MemRes=pred_false.
5112		in_closure1_membership_test_wf2([(V,W)|Rest],X,Y,Discarded,MemRes,WF) :- % TO DO: Rest==[] -->
5113		equality_objects_wf(V,X,VXResult,WF),
5114		in_closure1_membership_test_wf3(VXResult,V,W,Rest,X,Y,Discarded,MemRes,WF).
5115
5116		:- block in_closure1_membership_test_wf3(-,?,?,?,?,?,?,?,?).
5117		in_closure1_membership_test_wf3(pred_false,V,W,Rest,X,Y,Discarded,MemRes,WF) :-
5118		in_closure1_membership_test_wf2(Rest,X,Y,[(V,W)|Discarded],MemRes,WF).
5119		in_closure1_membership_test_wf3(pred_true,V,W,Rest,X,Y,Discarded,MemRes,WF) :- % V=X
5120		propagate_false(MemRes,WYResult),
5121		% TODO: Res=[],Discarded=[] -> MemRes=WYResult
5122		equality_objects_wf(W,Y,WYResult,WF), % MemRes = pred_false => WYResult = pred_false
5123		in_closure1_membership_test_wf4(WYResult,V,W,Rest,X,Y,Discarded,MemRes,WF).
5124
5125		:- block in_closure1_membership_test_wf4(-,?,?,?,?,?,?,?,?).
5126		in_closure1_membership_test_wf4(pred_false,_V,W,Rest,X,Y,Discarded,MemRes,WF) :-
5127		append(Discarded,Rest,Restart),
5128		in_closure1_membership_test_wf2(Restart,W,Y,[],MemRes1,WF),
5129		propagate_false(MemRes,MemRes1), % MemRes = pred_false -> MemRes1=pred_false
5130		when(nonvar(MemRes1),
5131		(MemRes1=pred_true -> MemRes=pred_true
5132		; in_closure1_membership_test_wf2(Rest,X,Y,Discarded,MemRes,WF) % (V,W) not in Discarded: was not useful
5133		)).
5134		in_closure1_membership_test_wf4(pred_true,_V,_W,_Rest,_X,_Y,_Discarded,MemRes,_WF) :- % W=Y
5135		MemRes = pred_true.
5136		/* ------------------ */
5137
5138		:- block propagate_false(-,?).
5139		propagate_false(pred_false,pred_false).
5140		propagate_false(pred_true,_).
5141