1		% (c) 2004-2019 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		permutation_sequence_wf/3,
15		not_permutation_sequence/3,
16		size_of_sequence/3,
17		prepend_sequence/4, append_sequence/4, prefix_sequence_wf/4,
18		suffix_sequence/4, concat_sequence/4,
19		disjoint_union_wf/4,
20		concatentation_of_sequences/3,
21		tail_sequence/4, first_sequence/4, front_sequence/4, last_sequence/4,
22		rev_sequence/3,
23
24
25		% maplet/3,
26		% relation/1,
27		relation_over/3, relation_over_wf/4,
28		not_relation_over/4,
29		domain_wf/3,
30
31		range_wf/3,
32		identity_relation_over_wf/3, in_identity/3, not_in_identity/3,
33		invert_relation_wf/3,
34		tuple_of/3,
35		rel_composition/3, rel_composition_wf/4,
36		direct_product_wf/4,
37		parallel_product_wf/4, in_parallel_product_wf/4, not_in_parallel_product_wf/4,
38		rel_iterate_wf/5,
39		event_b_identity_for_type/3,
40
41		not_partial_function/4,
42		partial_function/3, partial_function_wf/4,
43
44		total_function/3, total_function_wf/4,
45
46		% enumerate_total_bijection/3,
47		total_bijection/3, total_bijection_wf/4,
48
49		not_total_function/4,
50		not_total_bijection/4,
51
52
53		range_restriction_wf/4, range_subtraction_wf/4,
54		in_range_restriction_wf/4, not_in_range_restriction_wf/4,
55		in_range_subtraction_wf/4, not_in_range_subtraction_wf/4,
56		domain_restriction_wf/4, domain_subtraction_wf/4,
57		in_domain_restriction_wf/4, not_in_domain_restriction_wf/4,
58		in_domain_subtraction_wf/4, not_in_domain_subtraction_wf/4,
59		override_relation/4,
60		image_wf/4, image_for_closure1_wf/4,
61
62		in_domain_wf/3, not_in_domain_wf/3,
63		apply_to/4, apply_to/5,
64		override/5,
65
66		%sum_over_range/2, mul_over_range/2,
67
68		disjoint_union_generalized_wf/3,
69
70		partial_surjection/3, not_partial_surjection_wf/4,
71		total_relation_wf/4,
72		not_total_relation_wf/4,
73
74		surjection_relation_wf/4, total_surjection_relation_wf/4,
75		not_surjection_relation_wf/4, not_total_surjection_relation_wf/4,
76
77		total_surjection/3, total_surjection_wf/4,
78		not_total_surjection_wf/4,
79
80		partial_injection/3, partial_injection_wf/4,
81		not_partial_injection/4,
82
83		total_injection/3, total_injection_wf/4,
84		not_total_injection/4,
85
86		partial_bijection/3, partial_bijection_wf/4,
87		not_partial_bijection/4,
88
89		relational_trans_closure_wf/3, %relational_reflexive_closure/2,
90		in_closure1_wf/3, not_in_closure1_wf/3
91		]).
92
93
94		%:- print(loading_bsets_clp),nl.
95		%:- use_module(library(clpfd)).
96		%portray_message(informational, _).
97		:- use_module(library(terms)).
98		:- use_module(self_check).
99
100		:- use_module(debug).
101		:- use_module(tools).
102
103		:- use_module(module_information,[module_info/2]).
104		:- module_info(group,kernel).
105		:- module_info(description,'This module provides more advanced operations for the basic datatypes of ProB (mainly for relations, functions, sequences).').
106
107		:- use_module(tools_printing,[print_term_summary/1]).
108
109		:- use_module(delay).
110
111		%:- use_module(labeling).
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
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),
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		:- block is_sequence_domain(-,?).
212		is_sequence_domain(Domain,WF) :-
213		kernel_objects:finite_cardinality_as_int(Domain,int(Max),WF),
214		%print(size(Max)),nl,
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		kernel_objects:finite_cardinality_as_int(Domain,int(Max),WF),
219		%print(size(Max)),nl,
220		construct_interval_closure(1,Max,Interval), not_equal_object_wf(Domain,Interval,WF).
221
222		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_wf([(int(1),pred_true)],
223		[pred_true,pred_false],WF),WF)).
224		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:is_sequence_wf([(int(1),pred_true),(int(2),pred_false),(int(3),pred_true)],
225		[pred_true,pred_false],WF),WF)).
226		:- assert_must_succeed((bsets_clp:is_sequence_wf([(int(X),R)],[pred_true],_WF),X==1, R==pred_true)).
227		:- assert_must_succeed((bsets_clp:is_sequence_wf([(int(X),R),(int(Y),R)],[pred_true],_WF),X=2,
228		(preferences:preference(use_clpfd_solver,true) -> Y==1 ; Y=1), R==pred_true)).
229
230		is_sequence_wf(Seq,Range,WF) :- is_sequence_wf_ex(Seq,Range,WF,_).
231		% is_sequence_wf_ex also returns expansion; if it was done
232		:- block is_sequence_wf_ex(-,?,?,?).
233		is_sequence_wf_ex(FF,Range,WF,FF) :- % print(is_sequence_wf_ex(FF,Range,WF,FF)),nl,
234		nonvar(FF), FF = closure(_,_,_),
235		custom_explicit_sets:is_definitely_maximal_set(Range),
236		% we do not need the Range; this means we can match more closures (e.g., lambda)
237		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!,
238		% print_term_summary(checking_sequence(FFDomain)),nl, %%
239		is_sequence_domain(FFDomain,WF).
240		is_sequence_wf_ex(Seq,Range,WF,Res) :-
241		expand_and_convert_to_avl_set_warn(Seq,AER,is_sequence_wf_ex,'ARG : seq(?)'),!,
242		is_avl_sequence(AER),
243		is_avl_relation_over_range(AER,Range,WF),
244		custom_explicit_sets:construct_avl_set(AER,Res).
245		is_sequence_wf_ex(X,Type,WF,EX) :- %writeq(is_sequence(X,Type)),nl,
246		% try_ensure_seq_numbering(X,1),
247		expand_custom_set_to_list_wf(X,EX,_,is_sequence_wf_ex,WF),
248		is_sequence2(EX,[],Type,0,_MinSize,WF).
249
250		% will make this much faster x:seq(STRING) & card(x)=400 & 401:dom(x) (40 ms rather than > 2 secs)
251		% but this does not work -eval_file /Users/leuschel/git_root/prob_examples/examples/Setlog/prob-ttf/plavis-TransData_SP_21_simplified.prob
252		%:- block try_ensure_seq_numbering(-,?).
253		%try_ensure_seq_numbering([H|T],NextNr) :- var(H),!, print(nr(NextNr)),nl,
254		% H = (int(NextNr),_), N1 is NextNr+1,
255		% try_ensure_seq_numbering(T,N1).
256		%try_ensure_seq_numbering(_,_).
257
258		:- block is_sequence2(-,?,?,?,?,?).
259		is_sequence2([],IndexesSoFar,_Type,Size,MinSize,_WF) :- MinSize = Size,
260		contiguous_set_of_indexes(IndexesSoFar,Size).
261		/* not very good to do the checking at the end; can we move part of the checking earlier ? */
262		is_sequence2([(int(Idx),X)|Tail],IndexesSoFar,Type,Size,MinSize,WF) :-
263		less_than_direct(0,Idx), %is_index_greater_zero(Idx),
264		not_element_of_wf(int(Idx),IndexesSoFar,WF),
265		check_element_of_wf(X,Type,WF), S1 is Size+1,
266		clpfd_interface:clpfd_leq(Idx,MinSize,_Posted),
267		(var(Tail)
268		-> clpfd_interface:clpfd_domain(MinSize,Low,_Up), %print(is_seq_index(MinSize,Low,_Up,Tail,S1,IndexesSoFar)),nl, % TO DO: ensure that final size at least Low
269		(number(Low),Low>S1 -> Tail = [_|_] % TO DO: proper reification; what if MinSize gets constrained later
270		; expand_seq_if_necessary(Idx,S1,Tail)) % the sequence must be longer; force it
271		; true
272		), %print(rec_call(Tail)),nl,
273		is_sequence2(Tail,[int(Idx)|IndexesSoFar],Type,S1,MinSize,WF).
274
275		:- block expand_seq_if_necessary(-,?,-).
276		expand_seq_if_necessary(MinSize,S1,Tail) :- % TO DO: proper reification on MinSize above
277		number(MinSize), MinSize>S1, (var(Tail) ; Tail==[]),
278		%print(expand(MinSize,S1,Tail)),nl,
279		!,
280		Tail = [_|_].
281		expand_seq_if_necessary(_,_,_).
282
283		:- block contiguous_set_of_indexes(-,?).
284		contiguous_set_of_indexes([],_).
285		contiguous_set_of_indexes([H|T],Size) :- contiguous_set_of_indexes1(T,H,Size).
286
287		:- block contiguous_set_of_indexes1(-,?,?).
288		contiguous_set_of_indexes1([],int(1),_).
289		contiguous_set_of_indexes1([int(H2)|T],int(H1),Size) :- less_than_equal_direct(H1,Size),
290		less_than_equal_direct(H2,Size), less_than_equal_indexes(T,[H1,H2],Size).
291		/*
292		Indexes = [H1,H2|T],
293		when(ground(Indexes),(sort(Indexes,Sorted),contiguous_set_of_indexes2(Sorted))).
294		contiguous_set_of_indexes2([]).
295		contiguous_set_of_indexes2([int(1)|T]) :- contiguous_set_of_indexes3(T,1).
296		contiguous_set_of_indexes3([],_).
297		contiguous_set_of_indexes3([int(N)|T],N1) :- N is N1+1, contiguous_set_of_indexes3(T,N).
298		*/
299
300		less_than_equal_indexes([],All,_) :- clpfd_interface:clpfd_alldifferent(All).
301		less_than_equal_indexes([int(H)|T],All,Size) :- less_than_equal_direct(H,Size),less_than_equal_indexes(T,[H|All],Size).
302
303		:- 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)).
304		:- 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)).
305		:- 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)).
306		:- 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)).
307		:- 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)).
308		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:not_is_sequence([(int(1),int(22))],[int(22)]))).
309		:- 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)]))).
310		:- 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)]))).
311		:- 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)]))).
312		:- assert_must_fail((not_is_sequence(R,global_set('Name')),R = [])).
313		:- assert_must_fail((not_is_sequence(R,global_set('Name')),
314		R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
315		:- assert_must_fail((not_is_sequence(R,global_set('Name')),
316		R = [(int(1),fd(2,'Name'))] )).
317		:- assert_must_fail((not_is_sequence(R,global_set('Name')),
318		R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
319		:- assert_must_fail((not_is_sequence(R,global_set('Name')),
320		R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
321		:- assert_must_fail((not_is_sequence([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))],
322		global_set('Name')) )).
323		:- assert_must_fail((not_is_sequence(R,[int(1),int(2)]),
324		R = [(int(2),int(2)),(int(1),int(1))] )).
325		:- assert_must_succeed((not_is_sequence(R,[int(1),int(2)]),
326		R = [(int(2),int(2)),(int(3),int(1))] )).
327		:- assert_must_succeed((not_is_sequence(R,[int(1),int(2)]),
328		R = [(int(2),int(2)),(int(1),int(3))] )).
329
330
331		not_is_sequence(X,Type) :- init_wait_flags(WF),
332		not_is_sequence_wf(X,Type,WF),
333		ground_wait_flags(WF).
334
335		:- block not_is_sequence_wf(-,?,?).
336		not_is_sequence_wf(FF,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
337		% we do not need the Range; this means we can match more closures (e.g., lambda)
338		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!,
339		% print_term_summary(not_checking_sequence(FFDomain)),nl, %
340		not_is_sequence_domain(FFDomain,WF).
341		not_is_sequence_wf(Seq,Range,WF) :-
342		expand_and_convert_to_avl_set_warn(Seq,AER,not_is_sequence_wf,'ARG /: seq(?)'),
343		!, %print_term_summary(not_is_sequence_wf(Seq,Range,WF)),
344		(is_avl_sequence(AER) -> is_not_avl_relation_over_range(AER,Range,WF)
345		; true).
346		not_is_sequence_wf(X,Type,WF) :- expand_custom_set_to_list_wf(X,EX,_Done,not_is_sequence_wf,WF),
347		not_is_sequence2(EX,[],Type,WF).
348
349		:- block not_is_sequence2(-,?,?,?).
350		not_is_sequence2([],IndexesSoFar,_,_WF) :- not_contiguous_set_of_indexes(IndexesSoFar).
351		not_is_sequence2([(int(Idx),X)|Tail],IndexesSoFar,Type,WF) :-
352		membership_test_wf(IndexesSoFar,int(Idx),MemRes,WF),
353		not_is_sequence3(MemRes,Idx,X,Tail,IndexesSoFar,Type,WF).
354
355		:- block not_is_sequence3(-,?,?,?,?,?,?).
356		not_is_sequence3(pred_true,_Idx,_X,_Tail,_IndexesSoFar,_Type,_WF).
357		not_is_sequence3(pred_false,Idx,_X,_Tail,_IndexesSoFar,_Type,_WF) :- nonvar(Idx),Idx<1,!.
358		not_is_sequence3(pred_false,Idx,X,Tail,IndexesSoFar,Type,WF) :-
359		membership_test_wf(Type,X,MemRes,WF),
360		not_is_sequence4(MemRes,Idx,Tail,IndexesSoFar,Type,WF).
361
362		:- block not_is_sequence4(-,?,?,?,?,?).
363		not_is_sequence4(pred_false,_Idx,_Tail,_IndexesSoFar,_Type,_WF).
364		not_is_sequence4(pred_true,Idx,Tail,IndexesSoFar,Type,WF) :-
365		not_is_sequence2(Tail,[int(Idx)|IndexesSoFar],Type,WF).
366
367		not_contiguous_set_of_indexes(Indexes) :-
368		when(ground(Indexes),(sort(Indexes,Sorted),not_contiguous_set_of_indexes2(Sorted,1))).
369		not_contiguous_set_of_indexes2([int(N)|T],N1) :-
370		when(?=(N,N1),
371		((N \= N1) ; (N=N1, N2 is N1+1, not_contiguous_set_of_indexes2(T,N2)))).
372
373
374
375
376
377		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:not_is_non_empty_sequence([(int(1),int(22))],[int(22)]))).
378		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:not_is_non_empty_sequence([(int(1),int(2))],[int(22)]))).
379		:- assert_must_succeed((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),R = [])).
380		:- assert_must_fail((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),
381		R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
382		:- assert_must_succeed((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),
383		R = [(int(2),fd(1,'Name')),(int(4),fd(2,'Name'))] )).
384		:- assert_must_fail((bsets_clp:not_is_non_empty_sequence(R,global_set('Name')),
385		R = [(int(1),fd(1,'Name')),(int(2),fd(1,'Name'))] )).
386		:- assert_must_succeed((bsets_clp:not_is_non_empty_sequence(R,[int(1),int(2)]),
387		R = [(int(1),int(2)),(int(2),int(3))] )).
388
389		% S /: seq1(T)
390		not_is_non_empty_sequence_wf(S,T,_) :- not_is_non_empty_sequence(S,T).
391		:- block not_is_non_empty_sequence(-,?).
392		not_is_non_empty_sequence([],_) :- !.
393		not_is_non_empty_sequence(X,Type) :-
394		empty_sequence(X) ; not_is_sequence(X,Type).
395
396
397
398		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_sequence_wf([(int(1),int(22))],[int(22)],WF),WF)).
399		:- 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)).
400		:- 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)).
401		:- 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)).
402		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_sequence_wf([],global_set('Name'),WF),WF)).
403		:- assert_must_succeed((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF),
404		kernel_waitflags:ground_det_wait_flag(WF), R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
405		:- assert_must_succeed((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF),
406		ground_det_wait_flag(WF), R = [(int(1),fd(2,'Name'))] )).
407		:- assert_must_succeed((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF),
408		ground_det_wait_flag(WF), R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
409		:- assert_must_fail((bsets_clp:injective_sequence_wf(R,global_set('Name'),WF),
410		ground_det_wait_flag(WF), R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
411		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:injective_sequence_wf([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))],
412		global_set('Name'),WF),WF) ).
413		:- assert_must_succeed((bsets_clp:injective_sequence_wf(R,[int(1),int(2)],WF),
414		ground_det_wait_flag(WF),R = [(int(2),int(2)),(int(1),int(1))] )).
415		:- assert_must_fail((bsets_clp:injective_sequence_wf(R,[int(1),int(2)],WF),
416		ground_det_wait_flag(WF),R = [(int(2),int(2)),(int(3),int(1))] )).
417		:- assert_must_fail((bsets_clp:injective_sequence_wf(R,[int(1),int(2)],WF),
418		ground_det_wait_flag(WF), R = [(int(2),int(2)),(int(1),int(3))] )).
419
420
421
422		:- block injective_sequence_wf(-,-,?).
423		injective_sequence_wf(Seq,Type,WF) :- /* corresponds to iseq */
424		nonvar(Seq),
425		%expand_and_convert_to_avl_set_warn(Seq,AER,injective_sequence_wf_aux,'ARG : iseq(?)'),
426		Seq=avl_set(AER),
427		!,
428		is_avl_sequence(AER),
429		is_injective_avl_relation(AER,_ExactRange), % Should we check _ExactRange <: Type ??
430		is_avl_relation_over_range(AER,Type,WF).
431		injective_sequence_wf(Seq,Type,WF) :-
432		cardinality_as_int_for_wf(Type,MaxCard),
433		custom_explicit_sets:blocking_nr_iseq(MaxCard,ISeqSize),
434		block_get_wait_flag(ISeqSize,injective_sequence_wf,WF,LWF),
435		injective_sequence_wf_aux(Seq,Type,MaxCard,WF,LWF).
436
437		:- block injective_sequence_wf_aux(-,?,?,?,-).
438		injective_sequence_wf_aux(Seq,Type,_,WF,_) :- /* corresponds to iseq */
439		nonvar(Seq),
440		expand_and_convert_to_avl_set_warn(Seq,AER,injective_sequence_wf_aux,'ARG : iseq(?)'),!,
441		%Seq=avl_set(AER),
442		!,
443		is_avl_sequence(AER),
444		is_injective_avl_relation(AER,_ExactRange), % Should we check _ExactRange <: Type ??
445		is_avl_relation_over_range(AER,Type,WF).
446		injective_sequence_wf_aux(Seq,Type,MaxCard,WF,LWF) :-
447		expand_custom_set_to_list_wf(Seq,ESeq,_,injective_sequence_wf,WF),
448		is_sequence_wf(ESeq,Type,WF),
449		injective_sequence2(ESeq,0,[],Type,WF,MaxCard,LWF).
450
451		:- block injective_sequence2(-,?,?,?,?,?,-),injective_sequence2(-,?,?,?,?,-,?).
452		injective_sequence2([],_,_,_Type,_WF,_MaxCard,_LWF).
453		injective_sequence2([(int(Index),X)|Tail],CardSoFar,SoFar,Type,WF,MaxCard,LWF) :-
454		(number(MaxCard) -> CardSoFar< MaxCard, %less_than_equal_direct(Index,MaxCard) % does not enumerate index
455		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
456		; true),
457		check_element_of_wf(X,Type,WF),
458		not_element_of_wf(X,SoFar,WF),
459		add_new_element_wf(X,SoFar,SoFar2,WF),
460		C1 is CardSoFar+1,
461		(C1 == MaxCard -> Tail=[] ; true),
462		injective_sequence2(Tail,C1,SoFar2,Type,WF,MaxCard,LWF).
463
464
465		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_injective_sequence([(int(1),int(22))],[int(22)],WF),WF)).
466		:- 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)).
467		:- 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)).
468		:- 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)).
469		:- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),_WF),R = [])).
470		:- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),WF),
471		ground_det_wait_flag(WF),
472		R = [(int(2),fd(1,'Name')),(int(1),fd(2,'Name'))] )).
473		:- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),WF),
474		ground_det_wait_flag(WF),
475		R = [(int(1),fd(2,'Name'))] )).
476		:- assert_must_fail((bsets_clp:not_injective_sequence(R,global_set('Name'),WF),
477		ground_det_wait_flag(WF),
478		R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
479		:- assert_must_fail((bsets_clp:not_injective_sequence(R,[int(1),int(2)],WF),
480		ground_det_wait_flag(WF),
481		R = [(int(2),int(2)),(int(1),int(1))] )).
482		:- assert_must_succeed((bsets_clp:not_injective_sequence(R,global_set('Name'),WF),
483		ground_det_wait_flag(WF),
484		R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
485		:- assert_must_succeed((bsets_clp:not_injective_sequence([(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))],
486		global_set('Name'),WF),
487		ground_det_wait_flag(WF) )).
488		:- assert_must_succeed((bsets_clp:not_injective_sequence(R,[int(1),int(2)],WF),
489		ground_det_wait_flag(WF),
490		R = [(int(2),int(2)),(int(3),int(1))] )).
491		:- assert_must_succeed((bsets_clp:not_injective_sequence(R,[int(1),int(2)],WF),
492		ground_det_wait_flag(WF),
493		R = [(int(2),int(2)),(int(1),int(3))] )).
494		:- block not_injective_sequence(-,?,?), not_injective_sequence(?,-,?).
495		not_injective_sequence(Seq,_,_) :- Seq==[],!,fail.
496		not_injective_sequence(Seq,Type,WF) :- nonvar(Seq),
497		expand_and_convert_to_avl_set_warn(Seq,AER,not_injective_sequence,'ARG /: iseq(?)'),!,
498		%print_term_summary(not_inj_seq(Seq,Type,WF)),
499		(\+ is_avl_sequence(AER) -> true
500		; is_injective_avl_relation(AER,ExactRange) -> not_subset_of_wf(ExactRange,Type,WF)
501		; true).
502		not_injective_sequence(Seq,Type,WF) :- /* corresponds to Iseq */
503		%get_middle_wait_flag(not_injective_sequence,WF,LWF),
504		kernel_tools:ground_value_check(Seq,SV),
505		not_injective_sequence1(Seq,Type,WF,SV).
506		:- block not_injective_sequence1(?,?,?,-).
507		not_injective_sequence1(Seq,Type,WF,_) :-
508		expand_custom_set_to_list_wf(Seq,ESeq,_,not_injective_sequence1,WF),
509		(not_is_sequence_wf(ESeq,Type,WF)
510		; /* CHOICE POINT !! */
511		(is_sequence_wf(ESeq,Type,WF),not_injective_sequence2(ESeq,[],Type,WF))).
512		:- block not_injective_sequence2(-,?,?,?).
513		not_injective_sequence2([(int(_),X)|Tail],SoFar,Type,WF) :-
514		membership_test_wf(SoFar,X,MemRes,WF),
515		not_injective_sequence3(MemRes,X,Tail,SoFar,Type,WF).
516
517		:- block not_injective_sequence3(-,?,?,?,?,?).
518		not_injective_sequence3(pred_true,_X,_Tail,_SoFar,_Type,_WF).
519		not_injective_sequence3(pred_false,X,Tail,SoFar,Type,WF) :-
520		add_new_element_wf(X,SoFar,SoFar2,WF),
521		not_injective_sequence2(Tail,SoFar2,Type,WF).
522
523		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_non_empty_injective_sequence([(int(1),int(22))],[int(22)],WF),WF)).
524		:- 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)).
525		:- 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)).
526		:- 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)).
527		:- assert_must_succeed((bsets_clp:not_non_empty_injective_sequence(R,global_set('Name'),WF),
528		ground_det_wait_flag(WF), R = [])).
529		:- assert_must_fail((bsets_clp:not_non_empty_injective_sequence(R,global_set('Name'),WF),
530		ground_det_wait_flag(WF), R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
531		:- assert_must_succeed((bsets_clp:not_non_empty_injective_sequence(R,[int(1),int(2)],WF),
532		ground_det_wait_flag(WF), R = [(int(2),int(2)),(int(1),int(3))] )).
533
534		:- block not_non_empty_injective_sequence(-,?,?).
535		not_non_empty_injective_sequence([],_Type,_WF) :- !.
536		not_non_empty_injective_sequence(X,Type,WF) :-
537		empty_sequence(X) ; not_injective_sequence(X,Type,WF).
538
539
540		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective_non_empty_sequence([(int(1),int(22))],[int(22)],WF),WF)).
541		:- 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)).
542		:- 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)).
543		:- 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)).
544		:- assert_must_fail((bsets_clp:injective_non_empty_sequence(R,global_set('Name'),WF),
545		ground_det_wait_flag(WF),R = [])).
546		:- assert_must_succeed((bsets_clp:injective_non_empty_sequence(R,global_set('Name'),WF),
547		ground_det_wait_flag(WF),R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
548		:- block injective_non_empty_sequence(-,-,?). /* corresponds to iseq1 */
549		injective_non_empty_sequence(A,Type,WF) :- nonvar(A),A=avl_set(AS), !,
550		injective_sequence_wf(avl_set(AS),Type,WF),is_non_empty_explicit_set_wf(avl_set(AS),WF).
551		injective_non_empty_sequence(Seq,Type,WF) :- % print_term_summary(iseq1(Seq,Type,WF)),nl,
552		((nonvar(Seq),Seq=closure(_,_,_)) -> try_expand_custom_set(Seq,ESeq) ; ESeq=Seq),
553		injective_sequence_wf(ESeq,Type,WF),not_empty_sequence_wf(ESeq,WF).
554
555		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:finite_non_empty_sequence([(int(1),int(22))],[int(22)],WF),WF)).
556		:- 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)).
557		:- 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 = [])).
558		:- assert_must_succeed((bsets_clp:finite_non_empty_sequence(R,global_set('Name'),WF),
559		ground_det_wait_flag(WF),R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
560		:- block finite_non_empty_sequence(-,?,?).
561		finite_non_empty_sequence(Seq,Type,WF) :- /* corresponds to Seq1 */
562		is_sequence_wf_ex(Seq,Type,WF,ESeq),(var(ESeq) -> not_empty_sequence_wf(Seq,WF) ; not_empty_sequence_wf(ESeq,WF)).
563
564
565
566
567		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:permutation_sequence_wf([(int(1),int(22))],[int(22)],WF),WF)).
568		:- 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)).
569		:- 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)).
570		:- 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)).
571		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1)],WF),
572		ground_det_wait_flag(WF),R = [(int(1),int(1))] )).
573		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1),int(2)],WF),
574		ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(2))] )).
575		:- assert_must_succeed((bsets_clp:permutation_sequence_wf(R,[int(1),int(2)],WF),
576		ground_det_wait_flag(WF),R = [(int(1),int(2)),(int(2),int(1))] )).
577		:- 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),
578		R = [(int(1),pred_false /* bool_false */),(int(2),pred_true /* bool_true */)] )).
579		:- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1)],WF),
580		ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(1))] )).
581		:- 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 = [])).
582		:- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF),
583		ground_det_wait_flag(WF),R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
584		:- assert_must_succeed((bsets_clp:permutation_sequence_wf(R,global_set('Name'),WF),
585		ground_det_wait_flag(WF),
586		kernel_objects:equal_object(R,[(int(1),fd(1,'Name')),(int(3),fd(2,'Name')),(int(2),fd(3,'Name'))]) )).
587		:- assert_must_fail((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(1),int(2)],WF),
588		ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(3))] )).
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(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
591		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:permutation_sequence_wf(R,[int(4),int(3),int(2),int(1)],WF),
592		ground_det_wait_flag(WF), R=[(int(1),int(1)),(int(2),int(2)),(int(3),int(3)),(int(4),int(4))])).
593
594		:- block permutation_sequence_wf(-,-,?).
595		permutation_sequence_wf(SeqFF,Type,WF) :- nonvar(SeqFF),
596		custom_explicit_sets:dom_range_for_specific_closure(SeqFF,FFDomain,FFRange,function(bijection)),!,
597		equal_object_wf(FFRange,Type,permutation_sequence_wf_1,WF),
598		is_sequence_domain(FFDomain,WF).
599		permutation_sequence_wf(Seq,Type,WF) :-
600		expand_and_convert_to_avl_set_warn(Seq,AER,permutation_sequence_wf,'ARG : perm(?)'),!,
601		%% print_term_summary(checking_avl_perm_seq(AER,Type)),nl, %%
602		is_avl_sequence(AER),
603		%% print(is_sequence),nl, %%
604		is_injective_avl_relation(AER,Range),
605		%% print_term_summary(is_injective(Range)), %%
606		kernel_objects:equal_object_wf(Range,Type,permutation_sequence_wf_2,WF).
607		permutation_sequence_wf(Seq,Type,WF) :-
608		try_expand_custom_set(Seq,ESeq),
609		cardinality_as_int_wf(Type,int(Card),WF),
610		when(nonvar(Card), (setup_sequence(Card,SkelSeq,1), %print(setup(SkelSeq,ESeq)),nl,
611		CardGround=true,
612		kernel_objects:equal_object_wf(SkelSeq,ESeq,permutation_sequence_wf_3,WF))),
613		%injective_sequence_wf(ESeq,Type,WF,LWF),
614		surjective_iseq_0(SkelSeq,ESeq,Type,WF,Card,CardGround).
615		% quick_all_different_range(ESeq,[],Type,WF).
616
617		:- block surjective_iseq_0(-,-,?,?,?,-).
618		surjective_iseq_0(SkelSeq,_ESeq,Type,WF,_Card,Ground) :- % print(perm(SkelSeq,Type,_Card,Ground)),nl,
619		nonvar(Ground),
620		nonvar(SkelSeq),
621		preference(use_clpfd_solver,true), % try and use an optimized version calling global_cardinality in CLPFD module
622		get_global_cardinality_list(Type,YType,GCL,_),
623		% this dramatically reduces runtime for NQueens40_perm; maybe we should do this only when necessary, i.e., when surjective_iseq blocks on PreviousRemoveDone
624		% check why it slows down SortByPermutation_v2
625		!,
626		global_cardinality_range(SkelSeq,[],YType,GCL,WF).
627		surjective_iseq_0(_,ESeq,Type,WF,Card,_) :-
628		%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);
629		% but this slows down EulerWay.mch ; maybe because it sets up enumerators ? TO DO: investigate
630		surjective_iseq(ESeq,Type,WF,Card).
631
632		%:- use_module(clpfd_interface,[clpfd_alldifferent/1]).
633		% collect range and then call CLPFD global_cardinality using GCL (Global Cardinality List Ki-Vi)
634		:- block global_cardinality_range(-,?,?,?,?).
635		global_cardinality_range([],Acc,_Type,GCL,WF) :-
636		%print(global_cardinality(Acc,_Type,GCL)),nl,
637		clpfd:global_cardinality(Acc,GCL,[consistency(value)]),
638		add_fd_variables_for_labeling(Acc,WF). % this is needed for efficiency for NQueens40_perm !!
639		global_cardinality_range([(_,Y)|T],Acc,Type,GCL,WF) :-
640		get_simple_fd_value(Type,Y,FDYVAL),
641		global_cardinality_range(T,[FDYVAL|Acc],Type,GCL,WF).
642
643
644		:- use_module(b_global_sets,[all_elements_of_type/2,b_integer_set/1]).
645		% try and convert a B set into a list suitable for calling clpfd:global_cardinality
646		% get_global_cardinality_list(avl_set(A) % TO DO: extend to integer_lists
647		get_global_cardinality_list(global_set(G),Type,GCL,list) :- !,
648		all_elements_of_type(G,Values),
649		(b_integer_set(G) -> Type=integer ; Type=global(G)),
650		findall(X-1,(get_simple_fd_value(Type,VV,X),member(VV,Values)),GCL).
651		get_global_cardinality_list(avl_set(A),Type,GCL,list) :- !,
652		A = node(TopValue,_True,_,_,_),
653		get_simple_fd_value(Type,TopValue,_), % we have CLPFD values
654		avl:avl_domain(A,Values),
655		findall(X-1,(get_simple_fd_value(Type,VV,X),member(VV,Values)),GCL).
656		get_global_cardinality_list(Set,integer,GCL,interval(L1,U1)) :- nonvar(Set),
657		is_interval_closure_or_integerset(Set,L1,U1), number(L1),number(U1),
658		global_cardinality_list_interval(L1,U1,GCL).
659
660		global_cardinality_list_interval(From,To,[]) :- From>To, !.
661		global_cardinality_list_interval(From,To,[From-1|T]) :-
662		F1 is From+1, global_cardinality_list_interval(F1,To,T).
663
664		%try_get_simple_fd_value(Type,V,Val) :- nonvar(V),get_simple_fd_value(Type,V,Val).
665		get_simple_fd_value(integer,int(X),X).
666		get_simple_fd_value(global(T),fd(X,T),X).
667		% try_get_simple_fd_value(pred_false,0). try_get_simple_fd_value(pred_true,1). ??
668		% TO DO: maybe also treat pairs ? but we need complete values; see module clpfd_lists !
669
670		setup_sequence(0,R,_) :- !, R=[].
671		setup_sequence(Card,[(int(Nr),_)|T], Nr ) :- Card>0, C1 is Card-1,
672		N1 is Nr+1,
673		setup_sequence(C1,T,N1).
674
675		:- block surjective_iseq(?,?,?,-),surjective_iseq(?,-,?,?), surjective_iseq(-,?,?,?).
676		surjective_iseq(avl_set(S),Type,WF,Done) :- expand_custom_set(avl_set(S),ES),
677		surjective_iseq(ES,Type,WF,Done).
678		surjective_iseq(closure(P,T,B),Type,WF,Done) :- expand_custom_set(closure(P,T,B),ES),
679		surjective_iseq(ES,Type,WF,Done).
680		% no case for global_set: cannot be a relation
681		surjective_iseq([],T,WF,_) :- empty_set_wf(T,WF).
682		surjective_iseq([(int(_Nr),El)|Tail],Type,WF,_PreviousRemoveDone) :-
683		% print(surjective_iseq([(int(_Nr),El)|Tail],Type,WF)),nl,
684		remove_element_wf(El,Type,NType,WF,Done),
685		% when(nonvar(Done), (print(removed(_Nr,El)),nl)),
686		surjective_iseq(Tail,NType,WF,Done).
687		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_permutation_sequence([(int(1),int(22))],[int(22)],WF),WF)).
688		:- 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)).
689		:- 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)).
690		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:not_permutation_sequence([(int(2),int(44)),(int(1),int(44))],[int(44)],WF),WF)).
691		:- assert_must_fail((bsets_clp:not_permutation_sequence(R,[int(1)],WF),
692		ground_det_wait_flag(WF),R = [(int(1),int(1))] )).
693		:- assert_must_fail((bsets_clp:not_permutation_sequence(R,[int(1),int(2)],WF),
694		ground_det_wait_flag(WF),R = [(int(2),int(2)),(int(1),int(1))] )).
695		:- assert_must_fail((bsets_clp:not_permutation_sequence(R,[int(1),int(2)],WF),
696		ground_det_wait_flag(WF),R = [(int(1),int(2)),(int(2),int(1))] )).
697		:- assert_must_fail((bsets_clp:not_permutation_sequence(R,global_set('Name'),WF),
698		ground_det_wait_flag(WF), R = [(int(1),fd(1,'Name')),(int(3),fd(2,'Name')),(int(2),fd(3,'Name'))] )).
699		:- assert_must_succeed((bsets_clp:not_permutation_sequence(R,[int(1)],WF),
700		ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(1))] )).
701		:- assert_must_succeed((bsets_clp:not_permutation_sequence(R,global_set('Name'),_WF),R = [])).
702		:- assert_must_succeed((bsets_clp:not_permutation_sequence(R,global_set('Name'),WF),
703		ground_det_wait_flag(WF),R = [(int(1),fd(1,'Name')),(int(2),fd(2,'Name'))] )).
704		:- assert_must_succeed((bsets_clp:not_permutation_sequence(R,[int(1),int(2)],WF),
705		ground_det_wait_flag(WF),R = [(int(1),int(1)),(int(2),int(3))] )).
706		:- assert_must_succeed((bsets_clp:not_permutation_sequence(R,global_set('Name'),WF),
707		ground_det_wait_flag(WF),R = [(int(2),fd(1,'Name')),(int(1),fd(1,'Name'))] )).
708		:- block not_permutation_sequence(-,?,?).
709		not_permutation_sequence(SeqFF,Type,WF) :- nonvar(SeqFF),
710		custom_explicit_sets:dom_range_for_specific_closure(SeqFF,FFDomain,FFRange,function(bijection)),!,
711		equality_objects_wf(FFRange,Type,Result,WF),
712		when(nonvar(Result),(Result=pred_false -> true ; not_is_sequence_domain(FFDomain,WF))).
713		not_permutation_sequence(Seq,Type,WF) :-
714		kernel_tools:ground_value_check(Seq,SV),
715		not_permutation_sequence1(Seq,Type,SV,WF).
716		:- block not_permutation_sequence1(?,-,?,?), not_permutation_sequence1(?,?,-,?).
717		not_permutation_sequence1(avl_set(A),Type,_,WF) :- is_ground_set(Type), !, Seq=avl_set(A),
718		if(not_injective_sequence(Seq,Type,WF),
719		true, % no backtracking required; we could even use regular if with ->
720		not_surj_avl(Seq,Type,WF)
721		).
722		not_permutation_sequence1(avl_set(A),Type,_,WF) :- !, Seq=avl_set(A),
723		(not_injective_sequence(Seq,Type,WF)
724		; injective_sequence_wf(Seq,Type,WF),
725		not_surj_avl(Seq,Type,WF)).
726		not_permutation_sequence1(Seq,Type,_,WF) :-
727		expand_custom_set_to_list_wf(Seq,ESeq,Done,not_permutation_sequence1,WF),
728		not_permutation_sequence2(ESeq,Type,WF,Done).
729
730		not_surj_avl(Seq,Type,WF) :- range_wf(Seq,Range,WF),
731		not_equal_object_wf(Range,Type,WF). % TO DO: one could even just check cardinality as Seq is inj
732		%expand_custom_set_to_list_wf(Seq,ESeq,_,not_permutation_sequence1,WF),
733		% not_surjective_seq(ESeq,Type,WF).
734		% check if it is a ground set that cannot be instantiated
735		is_ground_set(V) :- var(V),!,fail.
736		is_ground_set(avl_set(_)).
737		is_ground_set(global_set(_)).
738		is_ground_set([]).
739
740		% here we could have a choice point in WF0
741		:- block not_permutation_sequence2(?,?,?,-).
742		not_permutation_sequence2(Seq,Type,WF,_) :- not_injective_sequence(Seq,Type,WF).
743		not_permutation_sequence2(Seq,Type,WF,_) :-
744		injective_sequence_wf(Seq,Type,WF), not_surjective_seq(Seq,Type,WF).
745
746		:- block not_surjective_seq(-,?,?).
747		not_surjective_seq([],T,WF) :- not_empty_set_wf(T,WF).
748		not_surjective_seq([(int(_),El)|Tail],Type,WF) :-
749		delete_element_wf(El,Type,NType,WF),
750		not_surjective_seq(Tail,NType,WF).
751
752		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:size_of_sequence([(int(1),int(22))],int(1),_WF))).
753		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:size_of_sequence([(int(2),int(22)),(int(1),int(22))],int(2),_WF))).
754		:- assert_must_succeed(exhaustive_kernel_fail_check(bsets_clp:size_of_sequence([(int(2),int(22)),(int(1),int(22))],int(3),_WF))).
755		:- 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))).
756		:- assert_must_succeed((bsets_clp:size_of_sequence(X,R,_WF),
757		X = [(int(1),int(2)),(int(2),int(1))],
758		R = int(2))).
759		:- assert_must_succeed((preferences:preference(use_clpfd_solver,false) -> true
760		; preferences:preference(use_smt_mode,false) -> true
761		; bsets_clp:size_of_sequence(X,R,_WF), R=int(RI),
762		clpfd_interface:clpfd_geq2(RI,2,_), nonvar(X), X = [(I1,_),(I2,_)|T],
763		I1==int(1), I2==int(2), T=[], RI==2 )).
764		:- assert_must_succeed((bsets_clp:size_of_sequence(X,R,_WF),X = [(int(1),_),(int(2),_)],R = int(2))).
765		:- assert_must_succeed((bsets_clp:size_of_sequence(X,_R,_WF),X =[(int(1),_),(int(2),_)] )).
766		:- assert_must_succeed_any((bsets_clp:size_of_sequence(X,int(2),_WF),nonvar(X),X=[_|Y],nonvar(Y),Y=[_|Z],Z==[])).
767		:- assert_must_succeed((bsets_clp:size_of_sequence([],int(0),_WF))).
768		:- assert_must_succeed((bsets_clp:size_of_sequence([],int(0),_WF))).
769		:- assert_must_succeed((bsets_clp:size_of_sequence([(int(1),int(4))],int(1),_WF))).
770		:- assert_must_succeed((bsets_clp:size_of_sequence([],_,_WF))).
771		:- assert_must_fail((bsets_clp:size_of_sequence(X,int(1),_WF),
772		X = [(int(1),_),(int(2),_)|_])).
773		:- block size_of_sequence(-,-,?).
774		size_of_sequence(Seq,int(Res),WF) :- size_of_sequence1(Seq,Res,WF),
775		set_up_sequence_skel(Seq,Res,WF).
776
777		% setup sequence skeleton if we have some CLPFD bounds information about the size
778		% currently still quite limited: only sets up if sequence is a variable; + does the setup only once
779		:- use_module(clpfd_interface,[clpfd_domain/3]).
780		set_up_sequence_skel(Seq,Res,WF) :- %print(size(Seq,Res)),nl,
781		var(Seq), % to do: also deal with cases when Seq partially instantiated
782		var(Res),
783		preferences:preference(use_clpfd_solver,true),
784		!,
785		clpfd_interface:clpfd_geq2(Res,0,_), % assert that size must not be negative
786		clpfd_interface:try_post_constraint(clpfd:'#<=>'( (Res#>0) , Trigger)), % generate reified trigger for when we can instantiate Seq
787		set_up_sequence_skel_aux(Seq,Res,Trigger,WF).
788		set_up_sequence_skel(_,_,_). % TO DO: check if Size interval shrinks
789		:- block set_up_sequence_skel_aux(-,?,-,?).
790		set_up_sequence_skel_aux(Seq,_Res,_Trigger,_WF) :-
791		nonvar(Seq),
792		!. % to do: also deal with cases when Seq partially instantiated
793		set_up_sequence_skel_aux(Seq,Res,_Trigger,_WF) :-
794		(number(Res) ; preferences:preference(use_smt_mode,true)),
795		!,
796		gen_seq_for_res(Res,Seq).
797		set_up_sequence_skel_aux(Seq,Res,_Trigger,WF) :-
798		get_large_finite_wait_flag(set_up_sequence_skel,WF,LWF), % delay, avoid costly unification with partially instantaited list skeleton; TO DO: in future we may use the kernel_cardinality attribute instead
799		when((nonvar(LWF) ; nonvar(Seq) ; nonvar(Res)), (nonvar(Seq) -> true ; gen_seq_for_res(Res,Seq))).
800
801		gen_seq_for_res(Res,Seq) :-
802		clpfd_domain(Res,FDLow,FDUp), % FDLow could also be 0
803		gen_sequence_skeleton(1,FDLow,FDUp,S),
804		Seq=S.
805		gen_sequence_skeleton(N,M,FDUp,S) :- N>M,!,(FDUp==M -> S=[] ; true).
806		gen_sequence_skeleton(N,Max,FDUp,[(int(N),_)|T]) :-
807		N1 is N+1,
808		gen_sequence_skeleton(N1,Max,FDUp,T).
809
810		:- block size_of_sequence1(-,-,?).
811		size_of_sequence1(Seq,ResInt,WF) :-
812		nonvar(Seq),is_custom_explicit_set_nonvar(Seq),
813		size_of_custom_explicit_set(Seq,Size,WF),!,
814		equal_object_wf(Size,int(ResInt),size_of_sequence1,WF).
815		/* TO DO: CHECK BELOW: would it not be better to use cardinality ?? */
816		/*
817		size_of_sequence1(Seq,Size,WF) :- !,finite_cardinality_as_int(Seq,int(Size),WF), check_indexes(Seq,Size).
818
819		construct_interval_closure(1,Size,Domain),
820		total_function_wf(FF,Domain,Range,_WF)
821		% we could also call total_function 1..Size --> _RangeType; would setup domain ?
822		:- block check_indexes(-,?).
823		check_indexes([],_) :- !.
824		check_indexes([(int(X),_)|T],Size) :- !,
825		less_than_equal_direct(X,Size), check_indexes(T,Size).
826		check_indexes(_,_).
827		*/
828		size_of_sequence1(Seq,Size,_WF) :- Size==0,!, empty_sequence(Seq).
829		size_of_sequence1(Seq,Size,WF) :- % print_term_summary(size1(Seq,Size)),
830		expand_custom_set_to_list_wf(Seq,ESeq,_,size_of_sequence1,WF), % print_term_summary(size1(Seq,ESeq,Size)),
831		(var(ESeq),nonvar(Size) -> size_of_var_seq(ESeqR,0,Size),
832		ESeqR=ESeq % unify after to do propagation in one go, without triggering coroutines inbetween
833		; size_of_seq2(ESeq,0,Size),
834		(var(Size),var(ESeq) -> less_than_equal_direct(0,Size) % propagate that Size is positive
835		; true)
836		).
837		/* small danger of expanding closure while still var !*/
838		:- block size_of_seq2(-,?,-).
839		size_of_seq2([],Size,Size).
840		size_of_seq2([I|Tail],SizeSoFar,Res) :-
841		S2 is SizeSoFar + 1,
842		check_index(I,Res), % don't instantiate I yet; allow other kernel_predicates to freely instantiate it
843		less_than_equal_direct(S2,Res),
844		%(ground(Res) -> safe_less_than_equal(size_of_seq2,S2,Res) ; true),
845		size_of_seq2(Tail,S2,Res).
846		size_of_var_seq([],Size,Size).
847		size_of_var_seq([(int(S2),_)|Tail],SizeSoFar,Res) :-
848		S2 is SizeSoFar + 1,safe_less_than_equal(size_of_var_seq,S2,Res),
849		(var(Tail) -> size_of_var_seq(Tail,S2,Res) ; size_of_seq2(Tail,S2,Res)).
850
851
852		:- block check_index(-,?).
853		check_index((I,_),Res) :- check_index1(I,Res).
854		:- block check_index1(-,?).
855		check_index1(int(Idx),Res) :- less_than_equal_direct(Idx,Res).
856
857		:- 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)).
858		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:prepend_sequence(int(33),[],[(int(1),int(33))],WF),WF)).
859		:- 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)).
860		:- 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)).
861		:- assert_must_succeed((bsets_clp:prepend_sequence(int(7),[],[(int(1),int(7))],_WF))).
862		:- assert_must_succeed((bsets_clp:prepend_sequence(int(7),X,R,_WF),
863		X = [(int(2),int(4)),(int(1),int(3))],
864		kernel_objects:equal_object(R,[(int(1),int(7)),(int(2),int(3)),(int(3),int(4))]))).
865		:- block prepend_sequence(?,-,-,?).
866		prepend_sequence(El,Seq,Res,_WF) :- Seq==[],!,
867		equal_object_optimized([(int(1),El)],Res,prepend_sequence).
868		prepend_sequence(El,Seq,Res,WF) :- nonvar(Seq),is_custom_explicit_set(Seq,prepend_sequence),
869		prepend_custom_explicit_set(Seq,El,ERes),!, %print(prepend(Seq,El)),nl,
870		equal_object_wf(Res,ERes,prepend_sequence,WF).
871		prepend_sequence(El,Seq,Res,WF) :- %print_message(prepend_sequence(El,Seq,Res)),
872		equal_cons_wf(Res,(int(1),El),ShiftSeq,WF),
873		shift_seq_indexes(Seq,1,ShiftSeq,WF).
874		% print_message(prepend_result(El,Res)).
875
876		:- block shift_seq_indexes(-,-,?,?),shift_seq_indexes(-,?,-,?).
877		shift_seq_indexes(Seq,Offset,ShiftedSeq,WF) :-
878		Offset == 0,!, equal_sequence(Seq,ShiftedSeq,WF).
879		shift_seq_indexes(Seq,Offset,ShiftedSeq,WF) :- nonvar(Seq),!,
880		expand_custom_set_to_list_wf(Seq,ESeq,_,shift_seq_indexes,WF),
881		shift_seq_indexes2(ESeq,Offset,ShiftedSeq,WF,Done),
882		(Done == done
883		-> true
884		; % also propagate in the other way: TO DO: make a more efficient fine-grained two-ways propagation; maybe using CHR
885		NegOffset is -Offset,
886		expand_custom_set_to_list_wf(ShiftedSeq,ESeq1,_,shift_seq_indexes,WF),
887		shift_seq_indexes2(ESeq1,NegOffset,ESeq,WF,_)).
888		shift_seq_indexes(Seq,Offset,ShiftedSeq,WF) :- NegOffset is -Offset,
889		% compute in the other direction; TO DO: make a more efficient fine-grained two-ways propagation; maybe using CHR
890		expand_custom_set_to_list_wf(ShiftedSeq,ESeq,_,shift_seq_indexes,WF),
891		shift_seq_indexes2(ESeq,NegOffset,Seq,WF,Done),
892		(Done == done
893		-> true
894		; % also propagate in the original way:
895		expand_custom_set_to_list_wf(Seq,ESeq1,_,shift_seq_indexes,WF),
896		shift_seq_indexes2(ESeq1,Offset,ESeq,WF,_)).
897
898		:- block shift_seq_indexes2(-,?,?,?,?).
899		shift_seq_indexes2([],_,R,WF,Done) :- !, Done = done, empty_set_wf(R,WF).
900		shift_seq_indexes2([Pair|Tail],Offset,Res,WF,Done) :- !,
901		Pair = (int(N),El),
902		equal_cons_wf(Res,(int(NewN),El),ShiftTail,WF),
903		int_plus(int(N),int(Offset),int(NewN)),
904		shift_seq_indexes2(Tail,Offset,ShiftTail,WF,Done).
905		shift_seq_indexes2(Seq,Offset,Res,WF,Done) :-
906		add_internal_error('Unexpected set argument: ',shift_seq_indexes2(Seq,Offset,Res,WF,Done)), fail.
907
908		:- 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)).
909		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:append_sequence([],int(33),[(int(1),int(33))],WF),WF)).
910		:- 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)).
911		:- 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)).
912		:- assert_must_succeed((bsets_clp:append_sequence([],int(7),[(int(1),int(7))],_WF))).
913		:- assert_must_succeed((bsets_clp:append_sequence(X,int(7),R,_WF),
914		X = [(int(2),int(4)),(int(1),int(3))],
915		kernel_objects:equal_object(R,[(int(1),int(3)),(int(2),int(4)),(int(3),int(7))]))).
916
917		:- block append_sequence(-,?,-,?).
918		append_sequence(Seq,El,Res,_WF) :- Seq==[],!,
919		equal_object_optimized([(int(1),El)],Res,append_sequence).
920		append_sequence(Seq,El,Res,WF) :- %print_term_summary(append_sequence(Seq,El,Res)),
921		nonvar(Seq),is_custom_explicit_set_nonvar(Seq),
922		append_custom_explicit_set(Seq,El,ERes,WF),!,
923		equal_sequence(Res,ERes,WF).
924		append_sequence(Seq,El,Res,WF) :- equal_cons_wf(Res,(int(NewSize),El),ResT,WF),
925		append_sequence2(Seq,ResT,NewSize,WF).
926
927		:- block append_sequence2(-,?,?,?).
928		append_sequence2(Seq,ResT,NewSize,WF) :-
929		try_expand_custom_set(Seq,ESeq), equal_sequence(ESeq,ResT,WF),
930		size_of_sequence(ESeq,Size,WF),
931		int_plus(Size,int(1),int(NewSize)).
932
933		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:prefix_sequence([(int(1),int(22))],int(1),[(int(1),int(22))]))).
934		:- 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))]))).
935		:- 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))]))).
936		:- assert_must_succeed((bsets_clp:prefix_sequence(X,int(1),X),X = [(int(1),int(1))])).
937		:- assert_must_succeed((bsets_clp:prefix_sequence(X,int(0),[]),X = [(int(1),int(1))])).
938		:- assert_must_abort_wf((bsets_clp:prefix_sequence_wf(X,int(-1),_R,WF),X = [(int(1),int(1))]),WF).
939		:- assert_must_succeed((bsets_clp:prefix_sequence(X,int(2),Y),
940		X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
941		kernel_objects:equal_object(Y,[(int(1),int(1)),(int(2),int(3))]) )).
942		:- assert_must_succeed((bsets_clp:prefix_sequence(X,int(1),Y),
943		X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
944		kernel_objects:equal_object(Y,[(int(1),int(1))]) )).
945		:- assert_must_succeed((bsets_clp:prefix_sequence(X,int(3),Y),
946		X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
947		kernel_objects:equal_object(Y,X) )).
948
949		prefix_sequence(Seq,N,R) :- init_wait_flags(WF),
950		prefix_sequence_wf(Seq,N,R,WF),
951		ground_wait_flags(WF).
952
953		% Prefix of a sequence (s /|\ n)
954		prefix_sequence_wf(Seq,int(Num),Res,WF) :-
955		prefix_sequence1(Seq,Num,Res,WF),
956		propagate_size(Res,Num,WF).
957
958		:- block propagate_size(-,-,?).
959		propagate_size(Res,Num,WF) :- %print(prop(Res,Num,WF)),nl,
960		var(Res),!, %print(setup_sequence(Num)),nl,
961		(Num<0 -> preferences:preference(disprover_mode,false) % don't do anything; we may want to generate WD error
962		; size_of_sequence(Res,int(Num),WF)).
963		propagate_size(_,Num,_) :- number(Num), !. % no need to propagate
964		propagate_size(_,_Num,_) :- \+ preferences:preference(find_abort_values,false),
965		!. % do not propagate as we could prevent detection of WD errors below
966		propagate_size([],Num,_WF) :- !,
967		Num=0. % Note: this could prevent a wd-error being detected
968		propagate_size(avl_set(A),Num,WF) :- var(Num),
969		% with partially instantated sets we get slowdowns (SimpleCSGGrammar2_SlowCLPFD)
970		% TO DO: treat list skeletons
971		!,
972		size_of_sequence(avl_set(A),int(Num),WF). % Note: this could prevent a wd-error being detected
973		propagate_size(_,_,_). % should we also propagate the other way around ?
974
975		:- block prefix_sequence1(-,?,?,?), prefix_sequence1(?,-,?,?).
976		prefix_sequence1(_Seq,Num,Res,WF) :- Num==0,!, empty_set_wf(Res,WF).
977		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)
978		add_wd_error('negative index in prefix_sequence (/|\\)! ', Num,WF).
979		prefix_sequence1(Seq,Num,Res,WF) :-
980		is_custom_explicit_set(Seq,prefix),
981		prefix_of_custom_explicit_set(Seq,Num,ERes,WF),!, % TO DO: check Num <= size(Seq)
982		equal_object_wf(Res,ERes,prefix_sequence1,WF).
983		prefix_sequence1(Seq,Num,Res,WF) :-
984		expand_custom_set_to_list_wf(Seq,ESeq,_,prefix_sequence1,WF),
985		unify_same_index_elements(Res,ESeq,WF),
986		unify_same_index_elements(Seq,Res,WF),
987		prefix_seq(ESeq,Num,0,Res,WF). %,print(prefix_seq_exit(ESeq,Num,0,Res)),nl
988		:- block prefix_seq(-,?,?,?,?).
989		prefix_seq([],Max,Sze,Res,WF) :-
990		(less_than_direct(Sze,Max)
991		-> add_wd_error('index larger than size of sequence in prefix_sequence (/|\\)! ', (Max,Sze),WF)
992		; true),
993		empty_set_wf(Res,WF).
994		%(less_than(int(_Sze),int(_Max))
995		% -> (print_message('Index bigger than sequence size in prefix_sequence (/|\\) !'),
996		% print_message(Max))
997		% /* in the AtelierB book this is allowed, in Wordsworth + AMN on web it is not ?? */
998		% ; true).
999		prefix_seq([(int(N),El)|Tail],Max,SizeSoFar,Res,WF) :-
1000		prefix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF).
1001		:- block prefix_seq2(-,?,?,?,?,?,?).
1002		prefix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF) :- % SizeSoFar is always ground
1003		(less_than_equal_direct(N,Max), equal_cons_wf(Res,(int(N),El),PTail,WF)
1004		;
1005		less_than_direct(Max,N), equal_object_wf(Res,PTail,prefix_seq2,WF)
1006		),
1007		( SizeSoFar<N -> NewSizeSoFar=N ; NewSizeSoFar = SizeSoFar ),
1008		prefix_seq(Tail,Max,NewSizeSoFar,PTail,WF).
1009
1010		:- 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))).
1011		:- 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))).
1012		:- 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))).
1013		:- assert_must_succeed((bsets_clp:suffix_sequence(X,int(0),X,_WF),X = [(int(1),int(1))])).
1014		:- assert_must_succeed((bsets_clp:suffix_sequence(X,int(1),[],_WF),X = [(int(1),int(1))])).
1015		:- assert_must_succeed((bsets_clp:suffix_sequence(X,int(2),Y,_WF),
1016		X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
1017		kernel_objects:equal_object(Y,[(int(1),int(4))]) )).
1018		:- assert_must_succeed((bsets_clp:suffix_sequence(X,int(1),Y,_WF),
1019		X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
1020		kernel_objects:equal_object(Y,[(int(1),int(3)),(int(2),int(4))]) )).
1021		:- assert_must_succeed((bsets_clp:suffix_sequence(X,int(2),Y,_WF),
1022		X = [(int(2),int(3)),(int(3),int(4)),(int(1),int(1))],
1023		kernel_objects:equal_object(Y,[(int(1),int(4))]) )).
1024		:- assert_must_abort_wf(bsets_clp:suffix_sequence([(int(1),int(11)),(int(2),int(22))],int(-1),_R,WF),WF).
1025		:- assert_must_abort_wf(bsets_clp:suffix_sequence([(int(1),int(11)),(int(2),int(22))],int(3),_R,WF),WF).
1026
1027		% kernel_waitflags:assert_must_abort2_wf(bsets_clp:suffix_sequence([int(11),int(22)],int(-1),_R,WF),WF)
1028
1029		% suffix of a sequence (s \|/ n); also called restrict at tail (Atelier B) or Drop
1030		:- block suffix_sequence(-,?,?,?).
1031		suffix_sequence(Seq,int(Num),Res,WF) :- % print(suffix_sequence(Seq)),nl,
1032		suffix_sequence1(Seq,Num,Res,WF).
1033		:- block suffix_sequence1(?,-,?,?).
1034		suffix_sequence1(Seq,Num,Res,WF) :- Num==0, !, equal_object_wf(Res,Seq,suffix_sequence1_1,WF).
1035		suffix_sequence1(_Seq,Num,_Res,WF) :- Num<0, !, add_wd_error('negative index in suffix_sequence (\\|/)! ', Num,WF).
1036		suffix_sequence1(Seq,Num,Res,WF) :- is_custom_explicit_set(Seq,suffix),
1037		suffix_of_custom_explicit_set(Seq,Num,ERes,WF),!,
1038		equal_object_wf(Res,ERes,suffix_sequence1_2,WF).
1039		suffix_sequence1(Seq,Num,Res,WF) :-
1040		expand_custom_set_to_list_wf(Seq,ESeq,_,suffix_sequence,WF), suffix_seq(ESeq,Num,0,Res,WF).
1041		:- block suffix_seq(-,?,?,?,?).
1042		suffix_seq([],Max,Sze,Res,WF) :-
1043		(less_than_direct(Sze,Max)
1044		-> add_wd_error('index larger than size of sequence in suffix_sequence (\\|/)! ', '>'(Max,Sze),WF)
1045		; true), empty_set_wf(Res,WF).
1046		suffix_seq([(int(N),El)|Tail],Max,SizeSoFar,Res,WF) :-
1047		suffix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF).
1048		:- block suffix_seq2(-,?,?,?,?,?,?).
1049		suffix_seq2(N,El,Tail,Max,SizeSoFar,Res,WF) :-
1050		(less_than_equal_direct(N,Max), equal_object_wf(Res,PTail,suffix_seq2,WF)
1051		;
1052		less_than_direct(Max,N),int_minus(int(N),int(Max),int(NN)),
1053		equal_cons_wf(Res,(int(NN),El),PTail,WF)
1054		),
1055		(N>SizeSoFar -> (NewSizeSoFar=N)
1056		; (NewSizeSoFar = SizeSoFar)),
1057		suffix_seq(Tail,Max,NewSizeSoFar,PTail,WF).
1058
1059
1060
1061		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:concat_sequence([],[(int(1),int(33))],[(int(1),int(33))],WF),WF)).
1062		:- 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
1063		:- 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)).
1064		:- 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)).
1065		:- assert_must_succeed((bsets_clp:concat_sequence([],X,Y,_WF),
1066		X = [(int(1),int(1))], Y==X)).
1067		:- assert_must_succeed((bsets_clp:concat_sequence(X,[],Y,_WF), X = [(int(1),int(1))], Y==X)).
1068		:- assert_must_succeed((bsets_clp:concat_sequence([(int(1),int(1))],[],Y,_WF), Y==[(int(1),int(1))])).
1069		:- assert_must_succeed((bsets_clp:concat_sequence(X,X,Y,_WF),
1070		X = [(int(1),int(1))], kernel_objects:equal_object(Y,[(int(1),int(1)),(int(2),int(1))]))).
1071		:- assert_must_succeed((bsets_clp:concat_sequence(X,X,Y,_WF),
1072		X = [(int(2),int(88)),(int(1),int(77))],
1073		kernel_objects:equal_object(Y,[(int(1),int(77)),(int(2),int(88)),(int(3),int(77)),(int(4),int(88))]))).
1074
1075		:- block /* concat_sequence(-,-,?,?), */
1076		concat_sequence(?,-,-,?), concat_sequence(-,?,-,?).
1077		concat_sequence(S1,S2,Res,WF) :- Res==[],!, empty_set_wf(S1,WF), empty_set_wf(S2,WF).
1078		concat_sequence(S1,S2,Res,WF) :-
1079		(var(S1),var(S2) -> get_wait_flag(2,concat,WF,LWF) % we have at least two solutions; TODO maybe use cardinality as wait_flag?
1080		; LWF=1),
1081		concat_sequence2(LWF,S1,S2,Res,WF).
1082
1083		:- block concat_sequence2(-,?,-,?,?), concat_sequence2(-,-,?,?,?).
1084		concat_sequence2(_,S1,S2,Res,WF) :- S1==[],!,equal_sequence(S2,Res,WF).
1085		concat_sequence2(_,S1,S2,Res,WF) :- S2==[],!,equal_sequence(S1,Res,WF).
1086		concat_sequence2(LWF,S1,S2,Res,WF) :-
1087		try_expand_and_convert_to_avl_with_check(S1,AS1,concat1),
1088		try_expand_and_convert_to_avl_with_check(S2,AS2,concat2),
1089		concat_sequence3(LWF,AS1,AS2,Res,WF).
1090
1091		concat_sequence3(_,S1,S2,Res,WF) :- nonvar(S1),is_custom_explicit_set(S1,concat_sequence),
1092		concat_custom_explicit_set(S1,S2,ERes,WF),!,
1093		%print_term_summary(concat(S1,S2,ERes)),nl,
1094		equal_sequence(Res,ERes,WF).
1095		concat_sequence3(_LWF,S1,S2,Res,WF) :-
1096		% print_term_summary(ordinary_concat_sequence(_LWF,S1,S2,Res)),
1097		%try_expand_custom_set(S1,ES1),
1098		size_of_sequence(S1,int(Size1),WF),
1099		(number(Size1) -> true
1100		; size_of_sequence(S2,Size2,WF),
1101		size_of_sequence(Res,SizeRes,WF),
1102		int_minus(SizeRes,Size2,int(Size1)),
1103		in_nat_range_wf(int(Size1),int(0),SizeRes,WF)
1104		% is this required: ?? ,in_nat_range_wf(Size2,int(0),SizeRes,WF)
1105		),
1106		%print(call_concat_sequence_aux(Size1,S1,S2,Res,WF)),nl,
1107		concat_sequence_aux(Size1,S1,S2,Res,WF).
1108
1109
1110		:- assert_must_succeed( (bsets_clp:equal_sequence([(int(1),A)|T1],[(int(1),int(22))|T2],_WF),
1111		A==int(22),T2=[],T1==[] )) .
1112		:- 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),
1113		A==string(c), T = [(int(2),B)|T2], B==string(a), T2=[(int(3),C)], C==string(b)) ).
1114		% equal_object optimized for sequences; can infer that pairs with same index have same value
1115		% TO DO: complete and make more efficient
1116		%equal_sequence(X,Y,_WF) :- nonvar(X),nonvar(Y),
1117		% is_custom_explicit_set(X,eval_sequence), is_custom_explicit_set(Y,eval_sequence),!,
1118		% equal_explicit_sets(X,Y).
1119		equal_sequence(X,Y,WF) :- nonvar(X),nonvar(Y),
1120		get_seq_head(X,XI,XEl,XT), get_seq_head(Y,YI,YEl,YT), XI==YI,!,
1121		% THIS CURRENTLY ONLY CHECKS FRONTMOST indexes
1122		%print(eq_seq(XI,XEl,YI,YEl,XT,YT)),nl,
1123		equal_object_wf(XEl,YEl,equal_sequence_1,WF), %print(done(XEl,YEl)),nl,
1124		equal_sequence(XT,YT,WF).
1125		equal_sequence(X,Y,WF) :-
1126		%print(equal_sequence(X,Y)),nl,
1127		/* (is_custom_explicit_set(Y) -> monitor_equal_sequence_againts_custom_set(X,Y,WF)
1128		; is_custom_explicit_set(X) -> monitor_equal_sequence_againts_custom_set(Y,X,WF)
1129		; true), does not seem to buy anything; equal_object already powerful enough */
1130		equal_object_wf(X,Y,equal_sequence_2,WF).
1131
1132		% enforces the constraint that there is only one possible elemenent per index:
1133		%:- block monitor_equal_sequence_againts_custom_set(-,?,?).
1134		%monitor_equal_sequence_againts_custom_set([],_,_) :- !.
1135		%monitor_equal_sequence_againts_custom_set([El|T],CS,WF) :- !,
1136		% element_of_custom_set_wf(El,CS,WF),
1137		% monitor_equal_sequence_againts_custom_set(T,CS,WF).
1138		%monitor_equal_sequence_againts_custom_set(_,_,_).
1139
1140		get_seq_head([(Idx,El)|Tail],Idx,El,Tail).
1141		%get_seq_head(avl_set(AVL),Idx,El,Tail) :- does not seem to buy anything; equal_object already powerful enough
1142		% custom_explicit_sets:avl_min_pair(AVL,Idx,El),
1143		% custom_explicit_sets:direct_remove_element_from_avl(AVL,(Idx,El),Tail). % TO DO: only compute if indexes ==
1144
1145
1146		:- block concat_sequence_aux(-,?,?,?,?).
1147		concat_sequence_aux(Size1,_S1,_S2,Res,WF) :- nonvar(Res),Res=avl_set(_),
1148		size_of_custom_explicit_set(Res,int(RSize),WF), number(RSize),
1149		Size1 > RSize,!, % S1 is longer than Res; no solution (prevent WD error below)
1150		fail.
1151		concat_sequence_aux(Size1,S1,S2,Res,WF) :- nonvar(Res),Res=avl_set(_),
1152		% split Result into prefix and suffix
1153		prefix_of_custom_explicit_set(Res,Size1,Prefix,WF), % we could call versions which do not check WD
1154		suffix_of_custom_explicit_set(Res,Size1,Postfix,WF),
1155		%print(split_avl_set(Size1,S1,S2,Res,Prefix,Postfix,WF)),nl,
1156		!,
1157		equal_sequence(S1,Prefix,WF), equal_sequence(S2,Postfix,WF).
1158		concat_sequence_aux(Size1,S1,S2,Res,WF) :-
1159		% print(concat_size1(S1,Size1)),nl,
1160		shift_seq_indexes(S2,Size1,NewS2,WF), %% print(shifted(S2,Size1,NewS2)),nl,
1161		% We can do something stronger than disjoint union: we know that the indexes are disjoint!
1162		% Hence: if (int(X),Y) : Res & (int(X),Z) : S1 => Y=Z
1163		% Hence: if (int(X),Y) : Res & (int(X),Z) : S2 => Y=Z
1164		unify_same_index_elements(S1,Res,WF),
1165		unify_same_index_elements(Res,S1,WF),
1166		unify_same_index_elements(NewS2,Res,WF),
1167		unify_same_index_elements(Res,NewS2,WF),
1168		disjoint_union_wf(S1,NewS2,Res,WF). % , print(disj_res(S1,NewS2,Res)),nl.
1169
1170		% Check if (int(X),Y) pairs in Seq2 have a matching (int(X),Z) in Seq1 and then unify(Y,Z)
1171		:- block unify_same_index_elements(-,?,?).
1172		unify_same_index_elements(avl_set(A),Seq,WF) :- !, % print(check_seq(Seq,A)),nl,
1173		unify_same_index_elements_aux(Seq,A,WF).
1174		unify_same_index_elements(_,_,_). % TO DO: maybe also support other partially instantiated lists
1175
1176		:- block unify_same_index_elements_aux(-,?,?).
1177		unify_same_index_elements_aux([],_,_) :- !.
1178		unify_same_index_elements_aux([(int(Idx),El)|T],A,WF) :- !,
1179		try_find_index_element(Idx,El,A,WF),
1180		unify_same_index_elements_aux(T,A,WF).
1181		unify_same_index_elements_aux(_,_,_).
1182
1183		:- block try_find_index_element(-,?,?,?).
1184		try_find_index_element(Idx,El,AVL,WF) :-
1185		avl_fetch_pair(int(Idx),AVL,AvlEl),
1186		% print(fetch(Idx,AvlEl)),nl,
1187		!,
1188		% We have found an entry with the same index: El and AvlEl must be identical:
1189		equal_object_wf(El,AvlEl,try_find_index_element,WF).
1190		try_find_index_element(_Idx,_El,_AVL,_WF). % :- print(not_found(_Idx,_AVL)),nl.
1191
1192		% TO DO: add waitflags + use within partition_wf
1193		% 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
1194
1195		:- 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)).
1196		:- assert_must_succeed(exhaustive_kernel_check_wf([commutative],bsets_clp:disjoint_union_wf([],[int(2),int(1)],[int(1),int(2)],WF),WF)).
1197		:- assert_must_succeed(exhaustive_kernel_check_wf([commutative],bsets_clp:disjoint_union_wf([int(1),int(2)],[],[int(2),int(1)],WF),WF)).
1198		:- assert_must_succeed((bsets_clp:disjoint_union_wf([int(1)],[int(2)],Res,_WF),kernel_objects:equal_object(Res,[int(1),int(2)]))).
1199		:- assert_must_succeed((bsets_clp:disjoint_union_wf(A,B,[int(1)],_WF),B=[H],H==int(1),A==[])).
1200
1201		disjoint_union_wf(Set1,Set2,Res,WF) :-
1202		(var(Res)
1203		-> disjoint_union_wf0(Set1,Set2,DRes,DRes,WF), equal_object_optimized(Res,DRes) % try and convert result to AVL
1204		; disjoint_union_wf0(Set1,Set2,Res,Res,WF)).
1205
1206		% disjoint_union_wf0(Set1,Set2,UnionOfSet1Set2, SuperSet, WF)
1207		:- block disjoint_union_wf0(-,-,-,?,?).
1208		disjoint_union_wf0(Set1,Set2,Res,_,WF) :- Set1==[],!,equal_object_wf(Set2,Res,disjoint_union_wf0_1,WF).
1209		disjoint_union_wf0(Set1,Set2,Res,_,WF) :- Set2==[],!,equal_object_wf(Set1,Res,disjoint_union_wf0_2,WF).
1210		disjoint_union_wf0(Set1,Set2,Res,_,WF) :- Res==[],!,empty_set_wf(Set1,WF), empty_set_wf(Set2,WF).
1211		disjoint_union_wf0(Set1,Set2,Res,FullRes,WF) :-
1212	?	((nonvar(Set1);nonvar(Set2)) -> true ; get_cardinality_powset_wait_flag(Res,disjoint_union_wf0,WF,_Card,CWF)),
1213		disjoint_union0(Set1,Set2,Res,FullRes,WF,CWF).
1214
1215		:- block disjoint_union0(-,-,?,?,?,-), disjoint_union0(-,?,-,-,?,?), disjoint_union0(?,-,-,-,?,?).
1216		disjoint_union0(Set1,Set2,Res,_,WF,_) :- Set1==[],!,equal_object_wf(Set2,Res,disjoint_union0_1,WF).
1217		disjoint_union0(Set1,Set2,Res,_,WF,_) :- Set2==[],!,equal_object_wf(Set1,Res,disjoint_union0_2,WF).
1218		disjoint_union0(S1,S2,Res,_F,WF,_CWF) :- % print(disjoint_union0(S1,S2,Res,_F)),nl,
1219		ground_value(Res),
1220		( ground_value(S1) -> !, %print(diff(Res,S1,S2)),nl,
1221		check_subset_of_wf(S1,Res,WF), % TO DO: check if we can merge the check_subset and difference set in one predicate
1222		difference_set_wf(Res,S1,S2,WF)
1223		; ground_value(S2) -> !, %print(diff(Res,S2,S1)),nl,
1224		check_subset_of_wf(S2,Res,WF),
1225		difference_set_wf(Res,S2,S1,WF)
1226		; var(S1),var(S2) -> !, %print(disj_enum(Res,CWF)),nl, % CWF nonvar
1227		% see test 1408; allows to generate subsets of Res and avoid enumeration warnings
1228		check_subset_of_wf(S1,Res,WF),
1229		%check_subset_of(S1,Res), % without waitflag: will generate ground version
1230		difference_set_wf(Res,S1,S2,WF)
1231		).
1232		disjoint_union0(Set1,Set2,Res,_,WF,_) :- nonvar(Set1),
1233		is_custom_explicit_set_nonvar(Set1),
1234		union_of_explicit_set(Set1,Set2,Union), !,
1235		equal_object_wf(Union,Res,disjoint_union0_3,WF).
1236		disjoint_union0(Set1,Set2,Res,Full,WF,_) :- expand_custom_set_to_list_wf(Set1,ESet1,_,disjoint_union0_1,WF),
1237		expand_custom_set_to_list_wf(Set2,ESet2,_,disjoint_union0_2,WF),
1238		%print(disjoint_union0(ESet1,ESet2,Res,WF)),nl,
1239		disj_union1(ESet1,ESet2,Res,Full,WF).
1240
1241		:- block disj_union1(-,-,?,?,?).
1242		disj_union1(X,Y,Res,FullRes,WF) :-
1243		var(X) -> disj_union2(Y,X,Res,FullRes,WF) ; disj_union2(X,Y,Res,FullRes,WF).
1244
1245		disj_union2([],Y,Res,_,_WF) :- equal_object_optimized(Y,Res,disj_union2).
1246		disj_union2([X|TX],Y,Res,FullRes,WF) :-
1247		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
1248		kernel_tools:ground_value_check(X,XV),
1249		(nonvar(XV) -> equal_cons_wf(Res,X,TR,WF)
1250		; 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 = {}
1251		when(nonvar(XV), equal_cons_wf(Res,X,TR,WF))
1252		), % ensure that we instantiate Res if TR known; otherwise we may get pending co-routines, e.g. test 506, SyracuseGrammar
1253		disj_union3(TX,Y,TR,FullRes,WF).
1254
1255		:- block disj_union3(-,-,-,?,?).
1256		disj_union3(X,Y,Res,_,WF) :- Res==[],!,empty_set_wf(X,WF),empty_set_wf(Y,WF).
1257		disj_union3(X,Y,Res,FullRes,WF) :- disj_union1(X,Y,Res,FullRes,WF).
1258
1259
1260		:- block disjoint_union_generalized_wf(-,?,?).
1261		%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
1262		% equal_object(Set1,Res).
1263		disjoint_union_generalized_wf(SetsOfSets,Res,WF) :-
1264		expand_custom_set_to_list_wf(SetsOfSets,ESetsOfSets,_,disjoint_union_generalized_wf,WF),
1265		disjoint_union_generalized2(ESetsOfSets,[],Res,WF). %, print(res(Res)),nl.
1266		:- block disjoint_union_generalized2(-,?,?,?).
1267		disjoint_union_generalized2([],S,Res,WF) :- equal_object_optimized_wf(S,Res,disjoint_union_generalized2,WF).
1268		disjoint_union_generalized2([H|T],UnionSoFar,Res,WF) :-
1269		disjoint_union_wf0(H,UnionSoFar,UnionSoFar2,Res,WF),
1270		%% print_message(called_disjoint_union(H,UnionSoFar,UnionSoFar2)), %%
1271		disjoint_union_generalized2(T,UnionSoFar2,Res,WF).
1272
1273		% TO DO: if there are more than two sets: it may be interesting to set up constraint that
1274		% each set is a subset of the full set;
1275		% (would avoid enumeration warning in, e.g., x \/ y \/ z = 1..10 & x /\ y = {} & x /\ z = {} & y /\ z = {} & card(x)=card(y)+2 )
1276
1277		:- 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))])],
1278		[(int(1),int(11)),(int(2),int(22)),(int(3),int(33))],_WF))).
1279		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:concatentation_of_sequences([(int(1),[]),(int(2),[(int(1),int(33))])],[(int(1),int(33))],_WF))).
1280		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:concatentation_of_sequences([(int(1),[]),(int(2),[(int(1),int(55))])],Res,WF),
1281		kernel_waitflags:ground_wait_flags(WF),
1282		kernel_objects:equal_object(Res,[(int(1),int(55))]) )).
1283		:- 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),
1284		kernel_waitflags:ground_wait_flags(WF),
1285		kernel_objects:equal_object(Res,[(int(1),int(22)),(int(2),int(55))]) )).
1286		:- block concatentation_of_sequences(-,?,?).
1287		concatentation_of_sequences(SeqOfSeq,Res,WF) :- %print_message(conc(SeqOfSeq)),
1288	?	try_expand_and_convert_to_avl_with_check(SeqOfSeq,ES,conc),
1289	?	concs2(ES,Res,WF).
1290
1291		concs2(SeqOfSeq,Res,WF) :- is_custom_explicit_set(SeqOfSeq,conc),
1292		conc_custom_explicit_set(SeqOfSeq,CRes),!,
1293		equal_object_wf(CRes,Res,concs2,WF).
1294		concs2(SeqOfSeq,Res,WF) :- empty_set_wf(SeqOfSeq,WF),empty_set_wf(Res,WF).
1295		concs2(SeqOfSeq,Res,WF) :- not_empty_set_wf(SeqOfSeq,WF),
1296		front_sequence(SeqOfSeq,Front,WF),
1297		concatentation_of_sequences(Front,FrontRes,WF),
1298		last_sequence(SeqOfSeq,Last,WF),
1299		concat_sequence(FrontRes,Last,Res,WF).
1300
1301		:- assert_must_abort_wf(bsets_clp:tail_sequence([],_R,unknown,WF),WF).
1302		:- assert_must_abort_wf(bsets_clp:tail_sequence([],[],unknown,WF),WF).
1303		:- assert_must_succeed(exhaustive_kernel_succeed_check(
1304		bsets_clp:tail_sequence([(int(1),int(4)),(int(2),int(5))],[(int(1),int(5))],unknown,_WF)) ).
1305		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:tail_sequence([(int(1),int(4)),(int(3),int(6)),(int(2),int(5))],
1306		[(int(1),int(5)),(int(2),int(6))],unknown,_WF)) ).
1307		:- assert_must_succeed((bsets_clp:tail_sequence(X,R,unknown,_),
1308		X = [(int(1),int(6)),(int(2),int(5))],
1309		kernel_objects:equal_object(R,[(int(1),int(5))]) )).
1310		:- assert_must_succeed((bsets_clp:tail_sequence(X,[(int(1),int(5))],unknown,_),
1311		X = [(int(1),int(6)),(int(2),int(5))] )).
1312		:- assert_must_succeed((bsets_clp:tail_sequence(X,[(int(1),int(5)),(int(2),int(7))],unknown,_),
1313		X = [(int(1),int(6)),(int(2),int(5)),(int(3),int(7))] )).
1314		:- assert_must_succeed((bsets_clp:tail_sequence(X,[(int(2),int(7)),(int(1),int(5))],unknown,_),
1315		X = [(int(1),int(6)),(int(2),int(5)),(int(3),int(7))] )).
1316		:- block tail_sequence(-,?,?,?).
1317		tail_sequence(S1,Res,Span,WF) :- is_custom_explicit_set(S1,tail_sequence),
1318		tail_sequence_custom_explicit_set(S1,TRes,Span,WF),!,
1319		equal_object_wf(TRes,Res,tail_sequence,WF).
1320		tail_sequence(S1,Res,Span,WF) :- expand_custom_set_to_list_wf(S1,ES1,_,tail_sequence,WF),
1321		tail2(ES1,Res,Span,WF).
1322
1323		tail2([],_,Span,WF) :-
1324		add_wd_error_span('tail applied to empty sequence!',[],Span,WF).
1325		tail2([H|T],Res,_Span,WF) :- domain_subtraction_wf([int(1)],[H|T],IntRes,WF),
1326		shift_seq_indexes(IntRes,-1,Res,WF).
1327
1328
1329		:- assert_must_abort_wf(bsets_clp:first_sequence([],_R,unknown,WF),WF).
1330		:- assert_must_abort_wf(bsets_clp:first_sequence([],int(1),unknown,WF),WF).
1331		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:first_sequence([(int(1),int(4)),(int(2),int(5))],int(4),unknown,_WF)) ).
1332		:- 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)) ).
1333		:- assert_must_succeed((bsets_clp:first_sequence(X,R,unknown,_WF),
1334		X = [(int(1),int(2)),(int(2),int(1))],
1335		R = int(2))).
1336
1337		:- block first_sequence(-,?,?,?).
1338		%first_sequence(Seq,Res,Span,_) :- % print(first_seq(Seq,Res,Span)),nl,fail.
1339		% is_custom_explicit_set(Seq,first_sequence),
1340		% first_sequence_explicit_set(Seq,First), !,
1341		% equal_object(First,Res).
1342		first_sequence([],_,Span,WF) :- !,add_wd_error_span('first applied to empty sequence!',[],Span,WF).
1343		first_sequence(Seq,Res,Span,WF) :- apply_to(Seq,int(1),Res,Span,WF).
1344
1345
1346
1347		:- assert_must_abort_wf(bsets_clp:front_sequence([],_R,WF),WF).
1348		:- assert_must_abort_wf(bsets_clp:front_sequence([],[],WF),WF).
1349		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:front_sequence([(int(1),int(4)),(int(2),int(5))],[(int(1),int(4))],_WF)) ).
1350		:- 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)) ).
1351		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:front_sequence(X,R,WF),
1352		X = [(int(1),int(2)),(int(2),int(55))],kernel_waitflags:ground_wait_flags(WF),
1353		kernel_objects:equal_object(R,[(int(1),int(2))]))).
1354		:- assert_must_succeed((kernel_waitflags:init_wait_flags(WF),bsets_clp:front_sequence(X,R,WF),
1355		X = [(int(3),int(33))|R], kernel_waitflags:ground_wait_flags(WF),
1356		print(R),nl,
1357		kernel_objects:equal_object(R,[(int(1),int(2)),(int(2),int(55))]) )).
1358
1359		front_sequence(Seq,Res,WF) :- front_sequence(Seq,Res,unknown,WF).
1360		:- block front_sequence(-,?,?,?).
1361		front_sequence(S1,Res,_Span,WF) :-
1362		is_custom_explicit_set(S1,front_sequence),
1363		front_sequence_custom_explicit_set(S1,FRes),!,
1364		equal_object_wf(FRes,Res,front_sequence,WF).
1365		front_sequence(Seq,Res,Span,WF) :- expand_custom_set_to_list_wf(Seq,ESeq,_,front_sequence,WF),
1366		front2(ESeq,Res,Span,WF).
1367		front2([],_,Span,WF) :- add_wd_error_span('front applied to empty sequence!',[],Span,WF).
1368		front2([H|T],Res,_Span,WF) :- size_of_sequence([H|T],int(Size),WF),
1369		(number(Size) -> true ; size_of_sequence(Res,SizeRes,WF), int_plus(SizeRes,int(1),int(Size))),
1370		when(ground(Size), domain_subtraction_wf([int(Size)],[H|T],Res,WF)).
1371
1372
1373		:- assert_must_abort_wf(bsets_clp:last_sequence([],_R,WF),WF).
1374		:- assert_must_abort_wf(bsets_clp:last_sequence([],int(1),WF),WF).
1375		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:last_sequence([(int(1),int(4)),(int(2),int(5))],int(5),_WF)) ).
1376		:- 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)) ).
1377		:- assert_must_succeed((bsets_clp:last_sequence(X,R,_WF),
1378		X = [(int(1),int(2)),(int(2),int(55))],R = int(55))).
1379		:- assert_must_succeed((bsets_clp:last_sequence(X,R,_WF), X = [(int(1),int(55))], R = int(55))).
1380		:- 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))])).
1381
1382		last_sequence(Seq,Res,WF) :- last_sequence(Seq,Res,unknown,WF).
1383		:- block last_sequence(-,?,?,?).
1384		last_sequence(Seq,Res,_Span,WF) :- %print(last_sequence(Seq,Res,_)),nl,
1385		is_custom_explicit_set(Seq,last_sequence),
1386		last_sequence_explicit_set(Seq,Last), !, %print(last(Last)),nl,
1387		equal_object_wf(Last,Res,last_sequence,WF).
1388		last_sequence([],_,Span,WF) :- !,add_wd_error_span('last applied to empty sequence!',[],Span,WF).
1389		last_sequence(Seq,Res,Span,WF) :-
1390		size_of_sequence(Seq,int(Size),WF),
1391		last_sequence_aux(Size,Seq,Res,Span,WF).
1392		:- block last_sequence_aux(-,?,?,?,?).
1393		last_sequence_aux(Size,Seq,Res,Span,WF) :-
1394		apply_to(Seq,int(Size),Res,Span,WF).
1395		/*
1396		:- block last_seq(-, ?,?,?,?, ?,?).
1397		last_seq([],LastIdx,LastVal,SizeSoFar,LastResult, Span,WF) :-
1398		(LastIdx=SizeSoFar -> LastResult = LastVal ;
1399		add_wd_error_span('last applied to invalid sequence (biggest index different from size): ',LastIdx/SizeSoFar,Span,WF),
1400		LastResult=LastVal).
1401		last_seq([(ICurIdx,CurVal)|T],LastIdx,LastVal,SizeSoFar,LastResult,Span,WF) :-
1402		last_seq2(ICurIdx,CurVal,T,LastIdx,LastVal,SizeSoFar,LastResult,Span,WF).
1403		:- block last_seq2(-,?,?, ?,?,?,?, ?,?).
1404		last_seq2(int(CurIdx),CurVal,T,LastIdx,LastVal,SizeSoFar,LastResult,Span,WF) :-
1405		last_seq3(CurIdx,CurVal,T,LastIdx,LastVal,SizeSoFar,LastResult,Span,WF).
1406		:- block last_seq3(-,?,?, ?,?,?,?, ?,?).
1407		last_seq3(CurIdx,CurVal,T,LastIdx,LastVal,SizeSoFar,LastResult,Span,WF) :-
1408		S1 is SizeSoFar+1,
1409		(CurIdx>LastIdx -> last_seq(T,CurIdx,CurVal,S1,LastResult,Span,WF)
1410		; last_seq(T,LastIdx,LastVal,S1,LastResult,Span,WF)).
1411		*/
1412
1413
1414		:- 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 )).
1415		:- assert_must_succeed(exhaustive_kernel_check_wfdet( bsets_clp:rev_sequence([(int(1),int(4))],[(int(1),int(4))],WF),WF )).
1416		:- assert_must_succeed(exhaustive_kernel_check_wfdet( bsets_clp:rev_sequence([],[],WF),WF )).
1417		:- 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 )).
1418		:- assert_must_succeed((bsets_clp:rev_sequence([],[],_WF))).
1419		:- assert_must_succeed((bsets_clp:rev_sequence(X,R,_WF),
1420		X = [(int(1),int(2)),(int(2),int(1))],
1421		kernel_objects:equal_object(R,[(int(2),int(2)),(int(1),int(1))]) )).
1422		:- assert_must_succeed((bsets_clp:rev_sequence(X,R,_WF),
1423		X = [(int(1),int(23)),(int(2),int(1)),(int(3),int(55))],
1424		kernel_objects:equal_object(R,[(int(3),int(23)),(int(2),int(1)),(int(1),int(55))]) )).
1425		:- assert_must_succeed((bsets_clp:rev_sequence(R,X,_WF),
1426		X = [(int(1),int(23)),(int(2),int(1)),(int(3),int(55))],
1427		kernel_objects:equal_object(R,[(int(3),int(23)),(int(2),int(1)),(int(1),int(55))]) )).
1428		:- assert_must_succeed((bsets_clp:rev_sequence(X,_R,_WF),
1429		X = [(int(2),int(1)),(int(1),int(23)),(int(3),int(55))] )).
1430		:- assert_must_succeed((bsets_clp:rev_sequence(_R,X,_WF),
1431		X = [(int(3),int(55)),(int(1),int(23)),(int(2),int(1))] )).
1432
1433		/* reverse of sequence */
1434		:- block rev_sequence(-,-,?).
1435		rev_sequence(S1,Res,WF) :-
1436		(nonvar(S1) -> rev_sequence2(S1,Res,WF)
1437		; rev_sequence2(Res,S1,WF)).
1438
1439		rev_sequence2(S1,Res,WF) :- reverse_custom_explicit_set(S1,RS1),!,
1440		equal_object_wf(Res,RS1,WF).
1441		rev_sequence2(S1,Res,WF) :-
1442		expand_custom_set_to_list_wf(S1,ES1,_,rev_sequence2,WF),
1443		% print(rev(ES1)),nl,
1444		size_of_sequence(ES1,int(Size1),WF),
1445		rev_sequence3(ES1,Size1,Res,WF).
1446
1447		:- block rev_sequence3(?,-,?,?).
1448		rev_sequence3(E,S,R,WF) :- rev_sequence4(E,S,R,WF).
1449
1450		:- block rev_sequence4(-,?,?,?).
1451		rev_sequence4([],_,Res,WF) :- empty_set_wf(Res,WF).
1452		rev_sequence4([(int(N),El)|Tail],Size1,Res,WF) :-
1453		equal_cons_wf(Res,(NewN,El),RTail,WF),
1454		% compute NewN = Size - (N-1)
1455		int_minus(int(N),int(1),N1),
1456		int_minus(int(Size1),N1,NewN),
1457		%print(rev(N,Size1,NewN)),nl,
1458		(ground(NewN) -> true ; in_nat_range(NewN,int(0),int(Size1))),
1459		rev_sequence4(Tail,Size1,RTail,WF).
1460
1461
1462		/* --------- */
1463		/* RELATIONS */
1464		/* --------- */
1465
1466		%maplet(X,Y,(X,Y)).
1467
1468		% relation([]).
1469		% relation([(_X,_Y)|T]) :- relation(T).
1470
1471		:- 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)).
1472		:- assert_must_succeed(exhaustive_kernel_check( bsets_clp:relation_over([],[int(1),int(2)],[int(2)]) )).
1473		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([(int(1),int(2))],[int(1),int(2)],[int(2)]) )).
1474		:- assert_must_succeed(exhaustive_kernel_succeed_check( bsets_clp:relation_over([([int(1)],[int(2)])],[[int(1)],[],[int(2)]],[[int(2)]]) )).
1475		:- 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 */]) )).
1476		:- 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')]) )).
1477		:- 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')]) )).
1478		:- 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')]) )).
1479		:- 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')]) )).
1480		:- 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)]) )).
1481		:- 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)]) )).
1482		:- 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)]) )).
1483		:- assert_must_fail(( bsets_clp:relation_over([(int(1),int(1))],[int(1),int(2)],[int(2)]) )).
1484		:- assert_must_succeed(( bsets_clp:relation_over(X,[int(1),int(2)],[int(3)]),
1485		X==[(int(1),int(3))] )).
1486		:- assert_must_succeed(( bsets_clp:relation_over(X,[int(1),int(2)],[int(3)]),
1487		X==[(int(1),int(3)),(int(2),int(3))] )).
1488		:- assert_must_succeed(( bsets_clp:relation_over(X,[int(1),int(2)],[int(4),int(5)]),
1489		X==[(int(2),int(4)),(int(2),int(5))] )).
1490
1491		relation_over(R,Dom,Ran) :- init_wait_flags(WF),
1492		relation_over_wf(R,Dom,Ran,WF),
1493		ground_wait_flags(WF).
1494
1495		:- block relation_over_wf(-,-,-,?).
1496		relation_over_wf(R,Dom,Ran,WF) :-
1497		kernel_equality:get_cardinality_relation_over_wait_flag(Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels),
1498		relation_over1(R,Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels).
1499
1500		:- block relation_over1(-,?,?,?,-,?,?).
1501		relation_over1(FF,Domain,Range,WF,_WFR,_MaxCard,_MaxNrOfRels) :-
1502		nonvar(FF),
1503	?	custom_explicit_sets:is_definitely_maximal_set(Range),
1504		% we do not need the Range; this means we can match more closures (e.g., lambda)
1505		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,_),!,
1506		check_subset_of_wf(FFDomain,Domain,WF).
1507		relation_over1(FF,Domain,Range,WF,_WFR,_MaxCard,_MaxNrOfRels) :- nonvar(FF),
1508		% print_term_summary(relation_over1(FF,Domain,Range,WF)), %
1509		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,_),!,
1510		check_subset_of_wf(FFDomain,Domain,WF),
1511		check_subset_of_wf(FFRange,Range,WF).
1512		relation_over1(R,Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels) :- var(R),!,
1513		expand_custom_set_to_list_wf(R,ER,_,relation_over1,WF),
1514		relation_over2(ER,[],Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels,none).
1515		relation_over1(R,Domain,Range,WF,_WFR,_MaxCard,_) :-
1516		expand_and_convert_to_avl_set_warn(R,AER,relation_over1,'ARG : ? <-> ?'),!,
1517		is_avl_relation_over_domain(AER,Domain,WF), %print(dom_ok),nl,
1518		is_avl_relation_over_range(AER,Range,WF).
1519		relation_over1(R,Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels) :-
1520	?	expand_custom_set_to_list_wf(R,ER,_,relation_over1,WF),
1521	?	relation_over2(ER,[],Dom,Ran,WF,WFR,MaxCard,MaxNrOfRels,none).
1522
1523		expand_and_convert_to_avl_set_warn(R,AS,Origin,Operator) :-
1524		observe_enumeration_warnings(expand_and_convert_to_avl_set(R,AS),
1525		add_message(Origin,'Enumeration warning occured while expanding argument ARG for predicate ',Operator,R)).
1526		%expand_and_convert_to_avl_set(R,AS,_,Operator,Values) :-
1527		% observe_enumeration_warnings(expand_and_convert_to_avl_set(R,AS),
1528		% display_warning_message(Operator,Values)).
1529		%display_warning_message(Operator,Values) :-
1530		% format(user_error,'Enumeration Warning for Operator ~w~n',[Operator]),
1531		% maplist(translate:print_bvalue,Values),nl.
1532
1533		:- block relation_over2(-,?,?,?,?,-,?,?,?).
1534		relation_over2([],_,_,_,_WF,_WFR,_MaxCard,_MaxNrOfRels,_LastPair).
1535		relation_over2(REL,SoFar,Domain,Range,WF,WFR,MaxCard,MaxNrOfRels,LastPair) :-
1536	?	(var(REL) -> NewLastPair=(X,Y) ; NewLastPair=none), %remember whether we freely chose X,Y
1537	?	REL = [(X,Y)|T],
1538		% print(rel_over2(X,Y,T,sofar(SoFar),WFR,MaxCard,LastPair)),nl,
1539	?	(number(MaxCard)
1540		-> MaxCard>0,C1 is MaxCard-1 ,(C1=0 -> T=[] ; true)
1541		; C1=MaxCard),
1542		% TO DO: try to enumerate elements in order
1543	?	ordered_pair(LastPair,X,Y,not_equal),
1544	?	check_element_of_wf(X,Domain,WF),
1545	?	check_element_of_wf(Y,Range,WF),
1546	?	not_element_of_wf((X,Y),SoFar,WF),
1547		%print_bt_message(done_enum_relation_over2(X,Y,T,sofar(SoFar),MaxCard)),nl,
1548	?	update_waitflag(MaxNrOfRels,WFR,NewWFR,WF),
1549	?	relation_over2(T,[(X,Y)|SoFar],Domain,Range,WF,NewWFR,C1,MaxNrOfRels,NewLastPair).
1550
1551		% check that new pair is greater than previous pair, if that pair was freely chosen
1552		ordered_pair(none,_,_,_).
1553		ordered_pair((LastX,LastY),NewX,NewY,Eq) :- ordered_value(LastX,NewX,EqualX),
1554		check_second_component(EqualX,LastY,NewY,Eq).
1555
1556		:- block check_second_component(-,?,?,?).
1557		check_second_component(equal,X,Y,EqRes) :- ordered_value(X,Y,EqRes).
1558		check_second_component(not_equal,_X,_Y,not_equal). % no need to check 2nd component
1559
1560		:- block ordered_value(-,?,?), ordered_value(?,-,?).
1561		ordered_value(pred_true /* bool_true */,B,Eq) :- !, (B=pred_true /* bool_true */ -> Eq=equal ; Eq=not_equal).
1562		ordered_value(pred_false /* bool_false */,B,Eq) :- !, B=pred_false /* bool_false */, Eq=equal.
1563		ordered_value(int(X),int(Y),Eq) :- !,
1564		kernel_objects:less_than_equal_direct(X,Y), equal_atomic_term(X,Y,Eq).
1565		ordered_value(fd(NrX,T),fd(NrY,T),Eq) :- !,
1566		kernel_objects:less_than_equal_direct(NrX,NrY), equal_atomic_term(NrX,NrY,Eq).
1567		ordered_value((X1,X2),(Y1,Y2),Eq) :- !, ordered_pair((X1,X2),Y1,Y2,Eq).
1568		ordered_value(string(X),string(Y),Eq) :- !, less_equal_atomic_term(X,Y,Eq).
1569		ordered_value(rec(FX),rec(FY),Eq) :- !,
1570		ordered_fields(FX,FY,Eq).
1571		ordered_value([],Y,Eq) :- !, (Y==[] -> Eq=equal ; Eq=not_equal).
1572		ordered_value(avl_set(A),Y,Eq) :- !,
1573		(Y==[] -> fail
1574		; Y=avl_set(B) -> (A @< B -> Eq=not_equal ; A@>B -> fail ; Eq=equal)
1575		; print(assuming_strictly_ordered(avl_set(A),Y)),nl,
1576		Eq=not_equal). % TO DO: treat sets better
1577		ordered_value([H|T],Y,Eq) :- !,
1578		(Y==[] -> fail ; (Y==[H|T] -> Eq=equal
1579		; print(assuming_strictly_ordered([H|T],Y)),nl,
1580		Eq=not_equal)).
1581		ordered_value(A,B,not_equal) :- print(assuming_strictly_ordered(A,B)),nl.
1582
1583		:- block ordered_fields(-,?,?).
1584		ordered_fields([],RHS,Eq) :- !,RHS=[], Eq=equal.
1585		ordered_fields([field(Name,ValX)|TX],RHS,Eq) :- !,RHS=[field(Name,ValY)|TY],
1586		ordered_value(ValX,ValY,Equal1), check_next_field(Equal1,TX,TY,Eq).
1587		ordered_fields(FX,FY,Eq) :- add_internal_error('Unknown fields: ',ordered_fields(FX,FY,Eq)), Eq=not_equal.
1588
1589		:- block check_next_field(-,?,?,?).
1590		check_next_field(equal,TX,TY,EqRes) :- ordered_fields(TX,TY,EqRes).
1591		check_next_field(not_equal,_X,_Y,not_equal). % no need to check next field
1592
1593		:- block less_equal_atomic_term(-,?,?), less_equal_atomic_term(?,-,?).
1594		less_equal_atomic_term(A,B,Res) :- (A==B -> Res=equal ; A @<B, Res=not_equal).
1595
1596		:- block equal_atomic_term(-,?,?), equal_atomic_term(?,-,?).
1597		equal_atomic_term(A,B,Res) :- (A==B -> Res=equal ; Res=not_equal).
1598
1599
1600		:- 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) )).
1601		:- assert_must_succeed(exhaustive_kernel_check( bsets_clp:not_relation_over([(int(1),int(2))],[],[int(2)],_WF) )).
1602		:- assert_must_succeed(exhaustive_kernel_fail_check( bsets_clp:not_relation_over([(int(1),pred_true)],[int(1)],[pred_true],_WF) )).
1603		:- assert_must_succeed(exhaustive_kernel_fail_check( bsets_clp:not_relation_over([],[int(1)],[pred_true],_WF) )).
1604		:- assert_must_succeed( bsets_clp:not_relation_over([(int(1),int(2))],[int(3)],[int(1),int(2)],_) ).
1605		:- assert_must_succeed( bsets_clp:not_relation_over([(int(1),int(2))],[int(1)],[int(3)],_) ).
1606		:- assert_must_succeed( bsets_clp:not_relation_over([(int(1),int(3)),(int(1),int(2))],[int(1)],[int(3)],_) ).
1607		:- assert_must_fail( bsets_clp:not_relation_over([(int(1),int(3))],[int(1)],[int(3)],_) ).
1608		:- assert_must_fail( bsets_clp:not_relation_over([],[int(1)],[int(3)],_) ).
1609		:- assert_must_fail( bsets_clp:not_relation_over([],[],[],_) ).
1610		:- block not_relation_over(-,?,?,?).
1611
1612		not_relation_over(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
1613		% we do not need the Range; this means we can match more closures (e.g., lambda)
1614		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,_),!,
1615		% print_term_summary(not_relation_over(FF,FFDomain,Range)),
1616		not_subset_of_wf(FFDomain,Domain,WF).
1617		not_relation_over(FF,Domain,Range,WF) :- nonvar(FF), % print_term_summary(not_relation_over(FF,Domain,Range,WF)), %
1618		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,_),!,
1619		%print_term_summary(check_special_not_pf(FF,FFDomain,FFRange)),nl,
1620		not_both_subset_of(FFDomain,FFRange,Domain,Range,WF).
1621		/* could be slightly more efficient: but not clear if warrants additional complexity in code:
1622		not_relation_over(FF,Domain,Range,WF) :- nonvar(FF),
1623		check_element_can_be_decided(Domain), % ensures that check_element_of_wf will not block below
1624		check_element_can_be_decided(Range), % ensures that check_element_of_wf will not block below
1625		expand_and_convert_to_avl_set(FF,AER),!,
1626		(is_avl_relation_over_domain(AER,Domain,WF)
1627		-> \+ is_avl_relation_over_range(AER,Range,WF)
1628		; true).
1629		check_element_can_be_decided(X) :- var(X),!,fail.
1630		check_element_can_be_decided(avl_set(_)).
1631		check_element_can_be_decided([]).
1632		check_element_can_be_decided(closure(P,T,B)) :-
1633		custom_explicit_sets:is_interval_closure_or_integerset(closure(P,T,B),Low,Up),
1634		ground(Low), ground(Up).
1635		*/
1636		not_relation_over(R,Dom,Ran,WF) :-
1637		expand_custom_set_to_list_wf(R,ER,_,not_relation_over,WF),
1638		%% print(not_rel(ER,Dom,Ran)),nl,
1639		not_relation_over2(ER,Dom,Ran,WF).
1640
1641
1642		%not_relation_over2(R,_,_) :- when(nonvar(R), (R\=[], R\=[_|_])) . % TYPE ERROR !
1643		:- block not_relation_over2(-,?,?,?).
1644		not_relation_over2([(X,Y)|T],Domain,Range,WF) :- %print(not_rel2(X,Y,T)),nl,
1645		membership_test_wf(Domain,X,MemRes,WF),
1646		not_relation_over3(MemRes,Y,T,Domain,Range,WF).
1647
1648		:- block not_relation_over3(-,?,?,?,?,?).
1649		not_relation_over3(pred_false,_Y,_T,_Domain,_Range,_WF).
1650		not_relation_over3(pred_true,Y,T,Domain,Range,WF) :-
1651		membership_test_wf(Range,Y,MemRes,WF),
1652		not_relation_over4(MemRes,T,Domain,Range,WF).
1653
1654		:- block not_relation_over4(-,?,?,?,?).
1655		not_relation_over4(pred_false,_T,_Domain,_Range,_WF).
1656		not_relation_over4(pred_true,T,Domain,Range,WF) :-
1657		not_relation_over2(T,Domain,Range,WF).
1658
1659
1660
1661		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf([],[],WF),WF)).
1662		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf([(int(1),int(3))],[int(1)],WF),WF)).
1663		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf(
1664		[(int(0),int(55)),(int(2),int(3)),(int(1),int(3))],[int(1),int(2),int(0)],WF),WF)).
1665		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:domain_wf(
1666		[(int(99),int(55)),(int(2),int(3)),(int(99),int(4))],[int(2),int(99)],WF),WF)).
1667		:- assert_must_succeed((bsets_clp:domain_wf([],Res,_WF),Res=[])).
1668		:- assert_must_succeed((bsets_clp:domain_wf([(int(1),int(2))],Res,_WF),
1669		kernel_objects:equal_object(Res,[int(1)]))).
1670		:- assert_must_succeed((bsets_clp:domain_wf([(int(1),int(2)),(int(1),int(1))],Res,_WF),
1671		kernel_objects:equal_object(Res,[int(1)]))).
1672		:- assert_must_succeed((bsets_clp:domain_wf([(int(2),int(2)),(int(1),int(2))],Res,_WF),
1673		kernel_objects:equal_object(Res,[int(1),int(2)]))).
1674		:- assert_must_succeed((bsets_clp:domain_wf(X,Res,_WF),kernel_objects:equal_object(Res,[int(1),int(3),int(2)]),
1675		kernel_objects:equal_object(X,[(int(2),int(2)),(int(1),int(1)),(int(3),int(2))]))).
1676		:- assert_must_succeed((bsets_clp:domain_wf(X,Res,_WF),kernel_objects:equal_object(Res,[int(1),int(2)]),
1677		kernel_objects:equal_object(X,[(int(2),int(2)),(int(1),int(1)),(int(1),int(2))]))).
1678		:- assert_must_fail((bsets_clp:domain_wf(X,Res,_WF),kernel_objects:equal_object(Res,[int(1),int(2)]),
1679		kernel_objects:equal_object(X,[(int(2),int(2)),(int(1),int(1)),(int(3),int(2))]))).
1680
1681		:- block domain_wf(-,-,?).
1682		domain_wf(Rel,Res,WF) :- Res == [],!,
1683		% print(empty_domain_res(Rel,Res)),nl,
1684		empty_set_wf(Rel,WF).
1685		domain_wf(Rel,Res,WF) :- var(Rel),!, % hence Res must me nonvar
1686		(is_custom_explicit_set(Res,domain_wf)
1687		-> expand_custom_set_to_list_wf(Res,Res2,_,propagate_result_to_input2,WF) % avoid expanding twice
1688		; Res2 = Res),
1689		propagate_result_to_input(Res2,Rel,domain,WF),
1690		domain_wf1(Rel,Res2,WF).
1691	?	domain_wf(Rel,Res,WF) :- domain_wf1(Rel,Res,WF).
1692
1693
1694		propagate_result_to_input(Result,Rel,DomOrRange,WF) :-
1695		propagate_empty_set(Result,Rel), % this will trigger before LWF ground
1696		(preferences:preference(use_smt_mode,true)
1697		-> propagate_result_to_input1(Result,Rel,1,DomOrRange) % hopefully full CHR implementation will avoid the need for this hack
1698		% ; kernel_objects:is_marked_to_be_computed(Rel) -> true % get_last_wait_flag(propagate_result_to_input,WF,LWF)
1699		; %print(propagating_to_input(Rel)),nl,
1700		get_wait_flag(2000,propagate_result_to_input,WF,LWF), % TO DO: determine right value for Priority ?
1701		propagate_result_to_input1(Result,Rel,LWF,DomOrRange) % this slows down test 289 if not guarded, 1088 if guarded
1702		).
1703
1704		:- block propagate_result_to_input1(-,?,?,?), propagate_result_to_input1(?,-,-,?).
1705		% Note: if arg 2 (Rel) is known we will not propagate
1706		propagate_result_to_input1([],Rel,_,_) :- !, empty_set(Rel).
1707		propagate_result_to_input1(Result,Input,LWF,DomOrRange) :-
1708		(kernel_objects:is_marked_to_be_computed(Input) -> true %print(not_prop(Input,DomOrRange)),nl,nl
1709		; %print(prop(Result,Input,LWF)),nl,
1710		propagate_result_to_input2(Result,Input,LWF,DomOrRange)).
1711
1712		%:- block propagate_result_to_input2(-,?).
1713		:- block propagate_result_to_input2(-,?,?,?), propagate_result_to_input2(?,-,-,?).
1714		% maybe do in CHR in future: x:dom(R) => #z.(x,z) : R
1715		% TO DO: make stronger; also support avl_set ...
1716		propagate_result_to_input2([],_Rel,_,_) :- !. % nothing can be said; we could have repeated entries for previous domain elements
1717		propagate_result_to_input2([D|T],Rel,LWF,DomOrRange) :- %print(propagate_result_to_input2([D|T],Rel,LWF,DomOrRange)),nl,
1718		!,
1719		(Rel == [] -> fail % we would need more relation elements to generate the domain/range
1720		; nonvar(Rel) -> true % no propagation
1721		; (DomOrRange=domain -> Rel = [(D,_)|RT] ; Rel = [(_,D)|RT]),
1722		propagate_result_to_input2(T,RT,LWF,DomOrRange)
1723		).
1724		propagate_result_to_input2(CS,Rel,LWF,DomOrRange) :- var(Rel), is_custom_explicit_set(CS),!,
1725		expand_custom_set_to_list(CS,Res,_,propagate_result_to_input2),
1726		propagate_result_to_input2(Res,Rel,LWF,DomOrRange).
1727		propagate_result_to_input2(_1,_2,_LWF,_DomOrRange). % :- print(unknown_prop(_1,_2,_LWF)),nl.
1728
1729		:- block domain_wf1(-,?,?).
1730	?	domain_wf1(Rel,Res,WF) :- is_custom_explicit_set(Rel,domain_wf),
1731		% print_term_summary(try_dom_explicit(Rel,Res)),
1732	?	domain_of_explicit_set(Rel,Dom), !,
1733		% print_term_summary(dom_res(Rel,Dom)),%%
1734	?	equal_object_wf(Dom,Res,domain_wf1,WF).
1735		domain_wf1(Rel,Res,WF) :- %% print_term_summary(domain_normal(Rel,Res)), %%
1736		expand_custom_set_to_list_wf(Rel,Relation,_,domain_wf,WF),
1737		newdomain1(Relation,[],Res,WF),
1738		quick_propagate_domain(Relation,Res,WF).
1739
1740		:- block quick_propagate_domain(-,?,?).
1741		quick_propagate_domain([],_,_WF).
1742		quick_propagate_domain([(X,_)|T],FullRes,WF) :-
1743		quick_propagation_element_information(FullRes,X,WF,FullRes1), % should we use a stronger check ?
1744		quick_propagate_domain(T,FullRes1,WF).
1745
1746		%:- block newdomain1(-,?,-,?). % why was this commented out ?
1747		:- block newdomain1(-,?,?,?).
1748		/* newdomain1(Rel,SoFar,Res,WF) :- var(Rel), !, % print(prop(Res)),nl,
1749		domain_propagate_result(Res,Rel,SoFar,WF). */
1750		newdomain1(Dom,SoFar,Res,WF) :- newdomain2(Dom,SoFar,Res,WF).
1751
1752		%:- block newdomain2(-,?,?,?).
1753		newdomain2([],_SoFar,Res,WF) :- empty_set_wf(Res,WF).
1754		newdomain2([(X,Y)|T],SoFar,Res,WF) :-
1755		(Res==[]
1756		-> MemRes=pred_true, check_element_of_wf(X,SoFar,WF)
1757		; membership_test_wf(SoFar,X,MemRes,WF),
1758		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
1759		),
1760		%(var(MemRes) -> print(delayed_newdomain2(X,Y,SoFar,T)),nl ; true),
1761		newdomain3(MemRes,X,T,SoFar,Res,WF).
1762
1763		:- block newdomain3(-,?,?,?,?,?).
1764		newdomain3(pred_true,_,T,SoFar,Res,WF) :- newdomain1(T,SoFar,Res,WF).
1765		newdomain3(pred_false,X,T,SoFar,Res,WF) :-
1766		kernel_objects:mark_as_non_free(X), % X is linked to a particular Y -> it is not free
1767		add_element_wf(X,SoFar,SoFar2,WF),
1768		equal_cons_wf(Res,X,Res2,WF), %print(newdomain3_added(X,SoFar,SoFar2,Res,Res2)),nl,
1769		newdomain1(T,SoFar2,Res2,WF).
1770
1771
1772		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_domain_wf(int(2),[(int(2),int(7))],WF),WF)).
1773		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_domain_wf(int(2),[(int(1),int(6)),(int(2),int(7))],WF),WF)).
1774		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_domain_wf(int(22),[(int(1),int(6)),(int(22),int(7)),(int(33),int(7))],WF),WF)).
1775		:- assert_must_succeed((bsets_clp:in_domain_wf(int(1),[(int(1),int(2))],_))).
1776		:- assert_must_succeed((bsets_clp:in_domain_wf(int(3),[(int(1),int(2)),(int(3),int(4))],_))).
1777		:- assert_must_fail((bsets_clp:in_domain_wf(int(3),[],_))).
1778		:- assert_must_fail((bsets_clp:in_domain_wf(int(3),[(int(1),int(2))],_))).
1779		/* a more efficient version than using element_of and computing domain */
1780
1781		% just like not_empty_set_wf but instantiates with (El,_) as first element
1782		in_domain_wf(El,S,WF) :- var(S),!,
1783		(preferences:preference(use_smt_mode,true) -> S=[(El,_)|_]
1784		; get_enumeration_starting_wait_flag(not_empty_domain_wf,WF,LWF), in_domain_lwf(El,S,LWF,WF)).
1785		in_domain_wf(El,Rel,WF) :- in_domain_wf_lazy(El,Rel,WF).
1786		:- block in_domain_lwf(-,-,-,?).
1787		% was :- block in_domain_lwf(-,?,-,?). but this prevents instantiating El in case Rel becomes known ! see e.g. private_examples/ClearSy/ComparePv10Pv11/DebugPv10/
1788		%:- block in_domain_lwf(-,-,?,?),in_domain_lwf(?,-,-,?). % this annotation fails test 1703
1789		in_domain_lwf(El,Rel,_,WF) :-
1790	?	(var(Rel) -> Rel = [(El,_)|_]
1791	?	; not_empty_set_unless_closure_wf(Rel,WF),
1792	?	in_domain_wf_lazy(El,Rel,WF)).
1793
1794		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
1795		not_empty_set_unless_closure_wf(Rel,WF) :- not_empty_set_wf(Rel,WF).
1796
1797		% does not instantiate to [(El,_)|_]
1798		:- block in_domain_wf_lazy(?,-,?).
1799		%in_domain_wf_lazy(DomainElement,ES,WF) :- print(in_domain_wf_lazy(DomainElement,ES,WF)),nl,fail.
1800		in_domain_wf_lazy(_DomainElement,[],_WF) :- !,fail.
1801		in_domain_wf_lazy(DomainElement,avl_set(A),_WF) :-
1802		kernel_tools:ground_value(DomainElement), !, %print(enter_in_dom_avl(DomainElement)),nl,
1803		check_in_domain_of_avlset(DomainElement,A).
1804		% TO DO: check for infinite closures
1805		in_domain_wf_lazy(DomainElement,ES,WF) :-
1806	?	is_custom_explicit_set(ES,in_domain_wf_lazy), %print(enter_in_dom(ES)),nl,
1807	?	domain_of_explicit_set(ES,Dom),!,
1808		% print(in_domain_of_explicit_set(DomainElement,Dom,ES)),nl,
1809	?	check_element_of_wf(DomainElement,Dom,WF).
1810		in_domain_wf_lazy(El,Rel,WF) :- %print(in_dom(El)),nl,
1811		expand_custom_set_to_list_wf(Rel,Relation,Done,in_domain_wf_lazy,WF),
1812		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
1813		% print(in_domain2(El,Relation,WF,LWF,Done)),nl,
1814		% if Done == true -> we can use maybe clpfd_inlist or clpfd:element or quick_propagate
1815		quick_propagation_domain_element_list(Done,Relation,El,WF),
1816		in_domain2(El,Relation,WF,LWF).
1817
1818		% a custom implementation of quick_propagation_element_information for checking domain elements and lists only
1819		:- use_module(clpfd_lists,[try_in_fd_value_list_check/4]).
1820		:- block quick_propagation_domain_element_list(-,?,?,?).
1821		quick_propagation_domain_element_list(_,_,_,_) :- preferences:preference(use_clpfd_solver,false),!.
1822		quick_propagation_domain_element_list(_,_,El,_) :- ground(El),!.
1823		quick_propagation_domain_element_list(_,RelList,El,WF) :-
1824		try_in_fd_value_list_check(RelList,(El,_),couple_left(_),WF). % use couple_left to ignore range values
1825
1826
1827		:- block in_domain2(?,-,?,?).
1828		in_domain2(El,[(X,_Y)|T],WF,LWF) :-
1829		(T==[] -> equal_object_wf(El,X,in_domain2,WF)
1830		; kernel_objects:equality_objects_lwf(El,X,EqRes,LWF),
1831		in_domain3(EqRes,El,T,WF,LWF)
1832		).
1833
1834		:- block in_domain3(-,?,?,?,?).
1835		in_domain3(pred_true,_El,_T,_WF,_LWF).
1836		in_domain3(pred_false,El,T,WF,LWF) :-
1837		get_new_subsidiary_wait_flag(LWF,in_domain2(El,T),WF,NewLWF),
1838		in_domain2(El,T,WF,NewLWF).
1839
1840
1841		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_domain_wf(int(3),[],WF),WF)).
1842		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_domain_wf(int(3),[(int(2),int(7))],WF),WF)).
1843		:- 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)).
1844		:- 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)).
1845		:- assert_must_fail((bsets_clp:not_in_domain_wf(int(1),[(int(1),int(2))],_))).
1846		:- assert_must_fail((bsets_clp:not_in_domain_wf(int(3),[(int(1),int(2)),(int(3),int(4))],_))).
1847		:- assert_must_succeed((bsets_clp:not_in_domain_wf(int(3),[],_))).
1848		:- assert_must_succeed((bsets_clp:not_in_domain_wf(int(3),[(int(1),int(2))],_))).
1849		:- 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)).
1850		/* a more efficient version than using not_element_of and computing domain */
1851
1852
1853		:- block not_in_domain_wf(?,-,?).
1854		not_in_domain_wf(DomainElement,ES,WF) :- is_custom_explicit_set(ES,not_in_domain),
1855		domain_of_explicit_set(ES,Dom),!,
1856		%print_term_summary(not_in_domain2(DomainElement,Dom,ES)),
1857		not_element_of_wf(DomainElement,Dom,WF).
1858		not_in_domain_wf(El,Rel,WF) :- %%print(not_in_dom(El,Rel)),nl,
1859		expand_custom_set_to_list_wf(Rel,Relation,_,not_in_domain,WF),
1860		not_in_domain2(Relation,El,WF).
1861		:- block not_in_domain2(-,?,?).
1862		not_in_domain2([],_,_WF).
1863		not_in_domain2([(X,_Y)|T],E,WF) :- not_equal_object_wf(E,X,WF), not_in_domain2(T,E,WF).
1864
1865
1866
1867
1868		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:range_wf([],[],WF),WF)).
1869		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:range_wf([(int(1),int(3))],[int(3)],WF),WF)).
1870		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:range_wf(
1871		[(int(0),int(55)),(int(2),int(3)),(int(1),int(3))],[int(3),int(55)],WF),WF)).
1872		:- assert_must_succeed((bsets_clp:range_wf([],Res,_WF),Res=[])).
1873		:- assert_must_succeed((bsets_clp:range_wf([(int(1),int(2))],Res,_WF),
1874		kernel_objects:equal_object(Res,[int(2)]))).
1875		:- assert_must_succeed((bsets_clp:range_wf([(int(1),int(1)),(int(2),int(1))],Res,_WF),
1876		kernel_objects:equal_object(Res,[int(1)]))).
1877		:- assert_must_succeed((bsets_clp:range_wf([(int(1),int(2)),(int(1),int(1))],Res,_WF),
1878		kernel_objects:equal_object(Res,[int(1),int(2)]))).
1879		:- assert_must_succeed((bsets_clp:range_wf([(int(1),int(2)),(int(1),int(1)),(int(2),int(3))],Res,_WF),
1880		kernel_objects:equal_object(Res,[int(1),int(3),int(2)]))).
1881		:- assert_must_succeed((bsets_clp:range_wf(X,Res,_WF),
1882		X = [(int(1),int(2)),(int(1),int(1)),(int(2),int(3))],
1883		kernel_objects:equal_object(Res,[int(1),int(3),int(2)]))).
1884		:- assert_must_succeed((bsets_clp:range_wf(X,Res,WF), bsets_clp:domain_wf(X,Res2,WF), kernel_objects:equal_object(Res,Res2),
1885		X = [(int(1),int(2)),(int(1),int(1)),(int(2),int(2))])).
1886		:- assert_must_succeed((bsets_clp:range_wf(X,Res,WF), bsets_clp:domain_wf(X,Res2,WF), kernel_objects:equal_object(Res,Res2),
1887		X = [(int(2),int(1)),(int(1),int(2)),(int(2),int(2))])).
1888		:- assert_must_succeed((bsets_clp:range_wf(X,Res,WF), bsets_clp:domain_wf(X,Res2,WF), kernel_objects:equal_object(Res,Res2),
1889		X = [])).
1890		:- assert_must_succeed((bsets_clp:range_wf([([],[]),([int(0)],[int(0)]),
1891		([int(0),int(1)],[int(0),int(1)]),([int(0),int(2)],[int(0),int(2)]),
1892		([int(0),int(3)],[int(0),int(3)]),([int(0),int(4)],[int(0),int(4)]),([int(1)],[int(1)]),
1893		([int(1),int(2)],[int(1),int(2)]),([int(1),int(3)],[int(1),int(3)]),
1894		([int(1),int(4)],[int(1),int(4)]),([int(2)],[int(2)]),([int(2),int(3)],[int(2),int(3)]),
1895		([int(2),int(4)],[int(2),int(4)]),([int(3)],[int(3)]),([int(3),int(4)],
1896		[int(3),int(4)]),([int(4)],[int(4)])],_Res,_WF))).
1897		:- assert_must_succeed((bsets_clp:range_wf([([],[]),([int(0)],[int(0)]),
1898		([int(0),int(1)],[int(0),int(1)]),
1899		([int(0),int(3)],[int(0),int(3)]),([int(0),int(4)],[int(0),int(4)]),([int(1)],[int(1)]),
1900		([int(1),int(2)],[int(1),int(2)])],_Res,_WF))).
1901
1902		% TO DO: also use propagate_result_to_input
1903		:- block range_wf(-,-,?).
1904		range_wf(Rel,Res,WF) :- Res ==[],!, empty_set_wf(Rel,WF).
1905		range_wf(Rel,Res,WF) :- Rel ==[],!, empty_set_wf(Res,WF).
1906	?	range_wf(Rel,Res,WF) :- range_wf1(Rel,Res,WF),
1907		propagate_result_to_input(Res,Rel,range,WF).
1908
1909		:- block range_wf1(-,?,?).
1910		range_wf1(Rel,Res,WF) :- % print_term_summary(range_wf1(Rel,Res)),
1911	?	is_custom_explicit_set(Rel,range_wf1),
1912	?	range_of_explicit_set(Rel,Range), !,
1913		% print_term_summary(range_of_explicit_set(Rel,Range)),
1914	?	equal_object_wf(Range,Res,range_wf1,WF).
1915		range_wf1(Rel,Res,WF) :- % print_term_summary(range_normal(Rel,Res)),
1916		% TO DO : propagate information that card of Res <= card of Rel; similar thing for domain
1917		expand_custom_set_to_list_wf(Rel,Relation,_,range_wf1,WF), %print(exp(Relation)),nl,
1918		% print(newrange2(Relation,[],Res)),nl,
1919		newrange2(Relation,[],Res,WF),
1920		quick_propagate_range(Relation,Res,WF).
1921
1922
1923		:- block quick_propagate_range(-,?,?).
1924		quick_propagate_range([],_,_WF).
1925		quick_propagate_range([(_,Y)|T],FullRes,WF) :-
1926		quick_propagation_element_information(FullRes,Y,WF,FullRes1), % should we use a stronger check ?
1927		quick_propagate_range(T,FullRes1,WF).
1928
1929		:- block newrange2(-,?,?,?).
1930		newrange2([],_SoFar,Res,WF) :- %print(range2_base(Acc,Res)),nl,
1931		empty_set_wf(Res,WF). % ,print(eq),nl.
1932		newrange2([(X,Y)|T],SoFar,Res,WF) :- %print(range2(Y,T,SoFar,Res)),nl,
1933		(Res==[]
1934		-> MemRes=pred_true, check_element_of_wf(Y,SoFar,WF)
1935		; membership_test_wf(SoFar,Y,MemRes,WF),
1936		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
1937		(var(MemRes) -> prop_empty_pred_true(Res,MemRes) %,print(delay_range(Y,T)),nl
1938		% TO DO: we could look further in T if we can decide membership for other elements in T ?
1939		; true)
1940		),
1941		newrange3(MemRes,Y,T,SoFar,Res,WF).
1942
1943		:- block prop_empty_pred_true(-,?).
1944		prop_empty_pred_true([],R) :- !, R=pred_true.
1945		prop_empty_pred_true(_,_).
1946
1947		% 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
1948		% checking is stopped if EqFlag becomes nonvar
1949		% tested by testcase 1061
1950		:- block card_greater_equal_check(-,?,-), card_greater_equal_check(?,-,-).
1951		card_greater_equal_check(_,_,Flag) :- nonvar(Flag),!. % no longer required; even though we could prune failure !? done later in newrange2/newdomain2 ??!!
1952		card_greater_equal_check([],Set2,Flag) :- !,empty_set(Set2),
1953		Flag=pred_false. % Flag set indicates that both sets have same size
1954		card_greater_equal_check(_,[],_) :- !.
1955		card_greater_equal_check([_|T],[_|R],Flag) :- !, card_greater_equal_check(T,R,Flag).
1956		% To do: deal with AVL args as Result + also use efficient_card_for_set for closures
1957		%card_greater_equal_check([_|T],Set,Flag) :- efficient_card_for_set(B,CardB,CodeB),!,
1958		% f: 1..7 -->> 1..n & n>=7 & n<10 still does not work well
1959		% TO DO: can we merge code with check_card_greater_equal
1960		card_greater_equal_check(_,_,_).
1961
1962
1963		:- block newrange3(-,?,?,?,?,?).
1964		newrange3(pred_true,_Y,T,SoFar,Res,WF) :- newrange2(T,SoFar,Res,WF).
1965		newrange3(pred_false,Y,T,SoFar,Res,WF) :-
1966		kernel_objects:mark_as_non_free(Y), % Y is linked to a particular X -> it is not free
1967		add_element_wf(Y,SoFar,SoFar2,WF),
1968		equal_cons_wf(Res,Y,Res2,WF),
1969		% print_bt_message(added(Y,T,SoFar,sofar2(SoFar2),Res,res2(Res2))),
1970		newrange2(T,SoFar2,Res2,WF).
1971
1972
1973		:- assert_must_succeed((bsets_clp:identity_relation_over_wf([],Res,_WF),Res=[])).
1974		:- assert_must_succeed((bsets_clp:identity_relation_over_wf([int(1),int(2)],Res,_WF),
1975		Res=[(int(1),int(1)),(int(2),int(2))])).
1976		:- 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)).
1977		:- 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)).
1978		:- assert_must_fail((bsets_clp:identity_relation_over_wf([int(1)|_],_,_WF),fail)). /* check: no loop */
1979
1980		:- block identity_relation_over_wf(-,?,?).
1981		identity_relation_over_wf(Set1,IDRel,WF) :-
1982		expand_custom_set_to_list_wf(Set1,ESet1,_,identity_relation_over_wf,WF),
1983		identity_relation_over2(ESet1,IDRel,WF).
1984
1985		:- block identity_relation_over2(-,?,?).
1986		identity_relation_over2([],Res,WF) :- empty_set_wf(Res,WF).
1987		identity_relation_over2([X|T1],Res,WF) :- equal_cons_wf(Res,(X,X),T2,WF), % equal_object([(X,X)|T2],Res),
1988		identity_relation_over2(T1,T2,WF).
1989
1990
1991
1992		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_identity((int(1),int(1)),[int(1),int(2)],WF),WF)).
1993		:- assert_must_fail((bsets_clp:in_identity((int(1),int(2)),[int(1),int(2)],_WF))).
1994		:- assert_must_fail((bsets_clp:in_identity((int(3),int(3)),[int(1),int(2)],_WF))).
1995		:- assert_must_fail((bsets_clp:in_identity((int(1),int(2)),[],_WF))).
1996		in_identity((X,Y),Domain,WF) :- %print(in_identity((X,Y),Domain)),nl,
1997		equal_object_wf(X,Y,in_identity,WF), check_element_of_wf(X,Domain,WF).
1998
1999		:- assert_must_fail((bsets_clp:not_in_identity((int(1),int(1)),[int(1),int(2)],_WF))).
2000		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_identity((int(1),int(2)),[int(1),int(2)],WF),WF)).
2001		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:not_in_identity((int(3),int(3)),[int(1),int(2)],WF),WF)).
2002		:- assert_must_succeed((bsets_clp:not_in_identity((int(1),int(2)),[],_WF))).
2003		not_in_identity((X,Y),Domain,WF) :- %print(not_in_identity((X,Y),Domain)),nl,
2004		equality_objects_wf(X,Y,Eq,WF),
2005		not_in_id2(Eq,X,Domain,WF).
2006
2007		:- block not_in_id2(-,?,?,?).
2008		not_in_id2(pred_true,X,Domain,WF) :- not_element_of_wf(X,Domain,WF).
2009		not_in_id2(pred_false,_,_,_).
2010
2011
2012		:- 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)).
2013		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:invert_relation_wf([(int(1),int(2))], [(int(2),int(1))],WF),WF)).
2014		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:invert_relation_wf([], [],WF),WF)).
2015		:- assert_must_succeed((bsets_clp:invert_relation_wf(X,X,_),X = [])).
2016		:- assert_must_succeed((bsets_clp:invert_relation_wf(X,X,_),X = [(int(2),int(2))])).
2017		:- assert_must_succeed((bsets_clp:invert_relation_wf(X,[(int(1),int(2)),(int(7),int(6))],_WF),
2018		X = [(int(2),int(1)),(int(6),int(7))])).
2019		:- assert_must_succeed((bsets_clp:invert_relation_wf([(int(1),int(2)),(int(7),int(6))],X,_WF),
2020		X = [(int(2),int(1)),(int(6),int(7))])).
2021		:- assert_must_succeed((bsets_clp:invert_relation_wf([(int(1),int(2)),(int(7),int(6))],
2022		[(int(6),int(7)),(int(2),int(1))],_WF))).
2023		:- assert_must_succeed((bsets_clp:invert_relation_wf(closure([a,b],[string,boolean],b(truth,pred,[])),
2024		closure([b,a],[boolean,string],b(truth,pred,[])),_WF))).
2025
2026		:- block invert_relation_wf(-,-,?).
2027		invert_relation_wf(R,IR,WF) :- % print_message(invert_relation(R,IR)),
2028		% (nonvar(R) -> invert_relation2(R,IR) ; invert_relation2(IR,R)).
2029	?	invert_relation2(R,IR,WF). % , print_term_summary(invert_relation(R,IR)).
2030		/* Optimization for some types of closures: Instead of expanding the closures, we just
2031		swap the parameters. This does not work with closures wich have only one parameter
2032		wich is a pair */
2033	?	invert_relation2(CS,R,WF) :- nonvar(CS),is_custom_explicit_set_nonvar(CS),!,
2034	?	invert_explicit_set(CS,ICS), equal_object_wf(R,ICS,invert_relation2_1,WF).
2035		invert_relation2(R,CS,WF) :- nonvar(CS),is_custom_explicit_set_nonvar(CS),!,
2036		invert_explicit_set(CS,ICS), equal_object_wf(R,ICS,invert_relation2_2,WF).
2037		%invert_relation2(closure([P1,P2],[T1,T2],Clo),closure([P2,P1],[T2,T1],Clo)) :- !.
2038		invert_relation2(R,IR,WF) :- %try_expand_custom_set(R,ER),
2039		% (nonvar(R) -> invert_relation3(R,IR)
2040		% ; invert_relation3(IR,R),(ground(IR)-> true ; invert_relation3(R,IR))).
2041		% print(inverting(R,IR,WF)),nl,
2042		invert_relation3(R,IR,WF,1), invert_relation3(IR,R,WF,1).
2043		% ,print(inverted(R,IR)),nl. % propagates both ways; but multiple solutions ?!
2044
2045		:- block invert_relation3(-,?,?,?).
2046		invert_relation3(closure(P,T,B),Res,WF,_) :- invert_explicit_set(closure(P,T,B),ICS),
2047		equal_object_wf(Res,ICS,invert_relation3_1,WF).
2048		invert_relation3(avl_set(S),Res,WF,_) :- invert_explicit_set(avl_set(S),ICS),
2049		equal_object_wf(Res,ICS,invert_relation3_2,WF).
2050		invert_relation3([],Res,WF,_) :- empty_set_wf(Res,WF).
2051		invert_relation3([(X,Y)|T],Res,WF,Depth) :- %prints(invert([(X,Y)|T],Res,Depth)),
2052		D1 is Depth+1, get_wait_flag(D1,invert_relation3,WF,LWF),
2053		equal_cons_lwf(Res,(Y,X),IT,LWF,WF),
2054		invert_relation3(T,IT,WF,D1).
2055
2056
2057
2058
2059		tuple_of(X,Y,R) :- check_element_of((X,Y),R).
2060		%tuple_of_wf(X,Y,R,WF) :- check_element_of_wf((X,Y),R,WF).
2061
2062		:- 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))],
2063		[(int(1),int(1)),(int(5),int(7)),(int(3),int(33))]))).
2064		:- 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))],[]))).
2065		:- 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))],[],[]))).
2066		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_composition([],[],[]))).
2067		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(6))],
2068		[(int(1),int(11))],X),X = [])).
2069		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(6))],[],X),X = [])).
2070		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(6))],
2071		[(int(2),int(11))],X),
2072		kernel_objects:equal_object(X,[(int(1),int(11))]))).
2073		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(2))],[(int(2),int(11))],X),
2074		ground(X), bsets_clp:equal_object(X,[(int(1),int(11)),(int(7),int(11))]))).
2075		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(7),int(5))],
2076		[(int(2),int(11)),(int(2),int(4))],X),
2077		kernel_objects:equal_object(X,[(int(1),int(11)),(int(1),int(4))]))).
2078		:- assert_must_succeed((bsets_clp:rel_composition([(int(1),int(2)),(int(1),int(5))],
2079		[(int(2),int(11)),(int(5),int(11))],X),
2080		kernel_objects:equal_object(X,[(int(1),int(11))]))).
2081
2082		rel_composition(Rel1,Rel2,Comp) :-
2083		init_wait_flags(WF), % TO DO: remove and add WF arg
2084		rel_composition_wf(Rel1,Rel2,Comp,WF),
2085		ground_wait_flags(WF).
2086
2087		:- block rel_composition_wf(-,-,?,?).
2088		rel_composition_wf(Rel1,Rel2,Comp,WF) :- % print(rel_compose(Rel1,Rel2,Comp)),nl,
2089		(Rel1==[] ; Rel2==[]),
2090		!,
2091		empty_set_wf(Comp,WF).
2092		rel_composition_wf(Rel1,Rel2,Comp,WF) :- rel_composition1(Rel1,Rel2,Comp,WF).
2093
2094		:- block rel_composition1(-,?,?,?),rel_composition1(?,-,?,?).
2095		rel_composition1(Rel1,Rel2,Comp,WF) :- % print(rel(Rel1,Rel2,Comp)),nl, trace,
2096	?	(Rel1==[] ; Rel2==[]),!, empty_set_wf(Comp,WF).
2097		rel_composition1(Rel1,Rel2,Comp,WF) :- keep_symbolic(Rel1),
2098		(Rel2 = avl_set(_) -> SYMBOLIC=false ; SYMBOLIC=symbolic),
2099		symbolic_composition(Rel1,Rel2,SYMBOLIC,Rel3),
2100		!,
2101		% format('SYMBOLIC COMPOSITION (~w): ',[SYMBOLIC]), translate:print_bvalue(Rel3),nl,
2102		equal_object_wf(Comp,Rel3,rel_composition1_0,WF).
2103	?	rel_composition1(Rel1,Rel2,Comp,WF) :- rel_composition_for_explicit_set(Rel1,Rel2,Res),!,
2104		% print_term_summary(rel_composition_for_explicit_set(Rel1,Rel2,Res)),
2105	?	equal_object_wf(Res,Comp,rel_composition1_1,WF).
2106		rel_composition1(Rel1,Rel2,Comp,WF) :- Rel2=closure(_,_,_), % nl,print(rel(Rel1,Rel2,Comp)),nl, trace,
2107		keep_symbolic(Rel2),
2108		(dom_for_specific_closure(Rel2,Domain,function(_)) % TO DO: also deal with relations; in SYMBOLIC mode this may be counter productive; see function_composition ast cleanup rule
2109		-> !,
2110		expand_custom_set_to_list_wf(Rel1,Relation1,_,rel_composition1,WF),
2111		rel_compose_with_inf_fun(Relation1,Domain,Rel2,Comp,WF)
2112		; symbolic_composition(Rel1,Rel2,false,Rel3),
2113		!,
2114		% print('SYMBOLIC COMPOSITION2: '),translate:print_bvalue(Rel3),nl,
2115		expand_custom_set(Rel3,CRes), equal_object_optimized(CRes,Comp,rel_composition1_3) % do we need to expand ?
2116		).
2117		rel_composition1(Rel1,Rel2,Comp,WF) :-
2118		expand_custom_set_to_list_wf(Rel1,Relation1,_,rel_composition1_2,WF),
2119		expand_custom_set_to_list_wf(Rel2,Relation2,_,rel_composition1_3,WF),
2120		rel_compose2(Relation1,Relation2,Comp,WF).
2121
2122		:- use_module(btypechecker, [unify_types_strict/2]).
2123		symbolic_composition(Rel1,Rel2,SYMBOLIC,Rel3) :-
2124		get_relation_types(Rel1,TX,TY),
2125		get_relation_types(Rel2,TY2,TZ),
2126		(unify_types_strict(TY,TY2) -> true
2127		; add_internal_error('Could not unify range and domain types: ',unify_types_strict(TY,TY2)),fail),
2128		rel_comp_closure(Rel1,Rel2,TX,TY,TZ,SYMBOLIC,Rel3).
2129		% generate a closure for {xx,zz | #(yy).(xx|->yy : Rel1 & yy|->zz : Rel2)}
2130		% TO DO: maybe detect special cases: Rel1 is a function/cartesian product, e.g., (((0 .. 76) * (0 .. 76)) * {FALSE}) ; {(FALSE|->0),(TRUE|->1)}
2131		rel_comp_closure(Rel1,Rel2,TX,TY,TZ,SYMBOLIC,closure(Args,Types,CBody)) :-
2132		Args = [xx,zz], Types = [TX,TZ],
2133		couple_member_pred(xx,TX,yy,TY,Rel1, Pred1),
2134		couple_member_pred(yy,TY,zz,TZ,Rel2, Pred2),
2135		conjunct_predicates([Pred1,Pred2],P12),
2136		b_interpreter_components:create_unsimplified_exists([b(identifier(yy),TY,[])],P12,Body),
2137		(SYMBOLIC==symbolic -> mark_bexpr_as_symbolic(Body,CBody) ; CBody=Body).
2138
2139		% generate predicate for X|->Y : Rel
2140		couple_member_pred(X,TX,Y,TY,Rel, Pred) :-
2141		Pred = b(member(b(couple(b(identifier(X),TX,[]),
2142		b(identifier(Y),TY,[])),couple(TX,TY),[]),
2143		b(value(Rel),set(couple(TX,TY)),[])),pred,[]).
2144
2145
2146
2147		:- block rel_compose2(-,?,?,?).
2148		rel_compose2([],_,Out,WF) :- empty_set_wf(Out,WF).
2149		rel_compose2([(X,Y)|T],Rel2,Out,WF) :-
2150		rel_extract(Rel2,X,Y,OutXY,[],WF),
2151		% rel_extract(Rel2,X,Y,Out,OutRem),
2152		rel_compose2(T,Rel2,OutRem,WF),
2153		union_wf(OutRem,OutXY,Out,WF). % used to call union wihout wf; makes test 1394 fail
2154
2155		:- block rel_extract(-,?,?,?,?,?).
2156		rel_extract([],_,_,Rem,Rem,_WF). % should we use equal_object here ?????
2157		rel_extract([(Y1,Z)|T],X,Y,Res,Rem,WF) :-
2158		rel_extract(T,X,Y,CT,Rem,WF),
2159		equality_objects_wf(Y1,Y,EqRes,WF),
2160		rel_extract2(EqRes,Z,X,CT,Res).
2161
2162		:- block rel_extract2(-,?,?,?,?).
2163		rel_extract2(pred_true, Z, X,CT,Res) :- add_element((X,Z),CT,Res).
2164		rel_extract2(pred_false,_Z,_X,CT,Res) :- Res = CT.
2165
2166
2167
2168		:- block rel_compose_with_inf_fun(-,?,?,?,?).
2169		rel_compose_with_inf_fun([],_Dom,_Rel2,Comp,WF) :- empty_set_wf(Comp,WF).
2170		rel_compose_with_inf_fun([(X,Y)|T],Dom,Fun,CompRes,WF) :-
2171		membership_test_wf(Dom,Y,MemRes,WF),
2172		rel_compose_with_inf_fun_aux(MemRes,X,Y,T,Dom,Fun,CompRes,WF).
2173
2174		:- block rel_compose_with_inf_fun_aux(-,?,?,?, ?,?,?,?).
2175		rel_compose_with_inf_fun_aux(pred_true,X,Y,T,Dom,Fun,CompRes,WF) :-
2176		% print(rel_compose_with_inf_fun_aux(X,Y)),nl,
2177		apply_to(Fun,Y,FY,WF), % TO DO: generalize to image so that we can apply it also to infinite relations ?
2178		add_element_wf((X,FY),CT,CompRes,WF),
2179		rel_compose_with_inf_fun(T,Dom,Fun,CT,WF).
2180		rel_compose_with_inf_fun_aux(pred_false,_X,_Y,T,Dom,Fun,Comp,WF) :-
2181		% print(rel_compose_not_in_domain(_X,_Y)),nl,
2182		rel_compose_with_inf_fun(T,Dom,Fun,Comp,WF).
2183
2184		:- assert_must_abort_wf(bsets_clp:rel_iterate_wf([],int(-1),_R,set(couple(integer,integer)),WF),WF).
2185		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_iterate_wf([], int(2),[],set(couple(integer,integer)),_WF))).
2186		:- 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))).
2187		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_iterate_wf([(pred_true,pred_true)], int(0),
2188		[(pred_true,pred_true),(pred_false,pred_false)],set(couple(boolean,boolean)),_WF))).
2189		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:rel_iterate_wf([(int(1),int(2)),(int(2),int(4)),(int(4),int(6))], int(2),[(int(1),int(4)),(int(2),int(6))],set(couple(integer,integer)),_WF))).
2190		:- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(1),X,set(couple(integer,integer)),_WF), R=[],
2191		bsets_clp:equal_object(X,R))).
2192		:- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(1),X,set(couple(integer,integer)),_WF),
2193		R=[(int(1),int(2)),(int(2),int(3))],
2194		bsets_clp:equal_object(X,R))).
2195		:- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(2),X,set(couple(integer,integer)),_WF),
2196		R=[(int(1),int(2)),(int(2),int(3))],
2197		bsets_clp:equal_object(X,[(int(1),int(3))]))).
2198		:- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(3),X,set(couple(integer,integer)),_WF),
2199		R=[(int(1),int(2)),(int(2),int(3))],
2200		bsets_clp:equal_object(X,[]))).
2201		:- assert_must_succeed((bsets_clp:rel_iterate_wf(R,int(3),X,set(couple(integer,integer)),_WF),
2202		R=[(int(1),int(2)),(int(2),int(3)),(int(1),int(1))],
2203		bsets_clp:equal_object(X,[(int(1),int(1)),(int(1),int(2)),(int(1),int(3))]))).
2204
2205		rel_iterate_wf(Rel,int(Nr),Res,Type,WF) :- rel_iterate2(Nr,Rel,Res,Type,WF).
2206
2207		:- block rel_iterate2(-,?,?,?,?).
2208		rel_iterate2(X,Rel,Res,Type,WF) :-
2209		( X=1 -> equal_object_wf(Res,Rel,rel_iterate2,WF)
2210		; X>1 -> X1 is X-1,
2211		rel_iterate2(X1,Rel,R1,Type,WF),
2212		rel_composition(Rel,R1,Res) % TO DO: call WF version
2213		; X=0 -> rel_iterate0(Rel,Type,Res,WF)
2214		; otherwise -> add_wd_error('negative index in iterate',X,WF)
2215		).
2216
2217		:- use_module(bsyntaxtree,[get_set_type/2]).
2218		:- block rel_iterate0(?,-,?,?).
2219		rel_iterate0(_Rel,EType,Res,WF) :-
2220		get_set_type(EType,couple(Type,Type)),
2221		event_b_identity_for_type(Type,Res,WF).
2222
2223		:- use_module(typing_tools,[is_infinite_type/1]).
2224		event_b_identity_for_type(Type,Res,WF) :-
2225		create_texpr(identifier('_zzzz_unary'),Type,[],TIdentifier1), % was [generated]
2226		create_texpr(identifier('_zzzz_binary'),Type,[],TIdentifier2), % was [generated]
2227		(is_infinite_type(Type) -> Info = [prob_annotation('SYMBOLIC')] ; Info =[]),
2228		create_texpr(equal(TIdentifier1,TIdentifier2),pred,Info,TPred),
2229		construct_closure(['_zzzz_unary','_zzzz_binary'],[Type,Type],TPred,CRes),
2230		% for small types we could do: all_objects_of_type(Type,All), identity_relation_over_wf(All,CRes,WF)
2231		%, print(constructed_eventb_identity(Res)),nl
2232		equal_object_wf(Res,CRes,WF).
2233
2234
2235		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:direct_product_wf([],[(int(1),int(11))],[],_WF))).
2236		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))],
2237		[(int(1),int(11))],[(int(1),(int(2),int(11)))],_WF))).
2238		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))],
2239		[(int(2),int(11))],[],_WF))).
2240		:- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))],
2241		[(int(2),int(11))],X,_WF),
2242		X = [])).
2243		:- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(7),int(6))],
2244		[(int(1),int(11))],X,_WF),
2245		kernel_objects:equal_object(X,[(int(1),(int(2),int(11)))]))).
2246		:- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(1),int(6))],
2247		[(int(1),int(11))],X,_WF),
2248		kernel_objects:equal_object(X,[(int(1),(int(2),int(11))),(int(1),(int(6),int(11)))]))).
2249		:- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(2),int(6))],
2250		[(int(1),int(11)),(int(1),int(12))],X,_WF),
2251		kernel_objects:equal_object(X,[(int(1),(int(2),int(11))),(int(1),(int(2),int(12)))]))).
2252		:- assert_must_succeed((bsets_clp:direct_product_wf([(int(1),int(2)),(int(2),int(6))],
2253		[(int(1),int(11)),(int(1),int(12))],
2254		[(int(1),(int(2),int(11))),(int(1),(int(2),int(12)))],_WF))).
2255		:- 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))),
2256		avl_set(node((fd(1,'Name'),fd(2,'Name')),true,1,empty,node((fd(2,'Name'),fd(3,'Name')),true,0,empty,empty))),
2257		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)))
2258		,_WF))).
2259
2260		:- block direct_product_wf(-,?,?,?),direct_product_wf(?,-,?,?).
2261		direct_product_wf(Rel1,Rel2,Prod,WF) :-
2262		try_expand_and_convert_to_avl_with_check(Rel1,E1,direct_product), % to do: try_expand_and_convert_to_avl_unless_very_large(Rel1,E1),
2263		try_expand_and_convert_to_avl_with_check(Rel2,E2,direct_product),
2264		direct_product_wf1(E1,E2,Prod,WF).
2265
2266		direct_product_wf1(Rel1,Rel2,Prod,WF) :- % print_term_summary(direct_product(Rel1,Rel2,Prod)), %
2267		direct_product_explicit_set(Rel1,Rel2,Res),!,
2268		% print_term_summary(direct_product_result(Res)),
2269		equal_object_wf(Prod,Res,direct_product_wf1,WF).
2270		direct_product_wf1(Rel1,Rel2,Prod,WF) :- %print_term_summary(direct_product_list(Rel1,Rel2,Prod)),
2271		expand_custom_set_to_list_wf(Rel1,Relation1,_,direct_product_wf1_1,WF),
2272		expand_custom_set_to_list_wf(Rel2,Relation2,_,direct_product_wf1_2,WF),
2273		direct_product2(Relation1,Relation2,Prod,WF),
2274		direct_product_backwards(Relation1,Relation2,Prod,WF).
2275
2276		%direct_product2(R1,R2,Res) :- print_message(direct_product2(R1,R2,Res)),fail.
2277		:- block direct_product2(-,?,?,?).
2278		direct_product2([],_,Out,WF) :- equal_object_wf(Out,[],direct_product2,WF).
2279		direct_product2([(X,Y)|T],Rel2,Out,WF) :-
2280		direct_product_tuple(Rel2,X,Y,Out,OutRem,WF),
2281		direct_product2(T,Rel2,OutRem,WF).
2282
2283		:- block direct_product_tuple(-,?,?,?,?,?).
2284		direct_product_tuple([],_,_,Res,Rem,WF) :- equal_object_optimized_wf(Res,Rem,direct_product_tuple,WF).
2285		direct_product_tuple([(X2,Z)|T],X,Y,Res,Rem,WF) :-
2286		direct_product_tuple(T,X,Y,CT,Rem,WF),
2287		equality_objects_wf(X2,X,EqRes,WF),
2288		direct_product_tuple3(EqRes,X,Y,Z,CT,Res,WF).
2289
2290		:- block direct_product_tuple3(-,?,?,?,?,?,?).
2291		direct_product_tuple3(pred_true,X,Y,Z,CT,Res,WF) :-
2292		equal_cons_wf(Res,(X,(Y,Z)),CT,WF). /* no need for add_element as output uniquely determines X,Y,Z !?*/
2293		direct_product_tuple3(pred_false,_X,_Y,_Z,CT,Res,WF) :- equal_object_optimized_wf(Res,CT,direct_product_tuple3,WF).
2294
2295		:- block direct_product_backwards(?,?,-,?).
2296		% Propagate information backwards from result to arguments
2297		direct_product_backwards(R1,R2,Prod,WF) :-
2298		((kernel_tools:ground_value(R1);kernel_tools:ground_value(R2)) -> true
2299		; expand_custom_set_to_list_wf(Prod,ProdList,_,direct_product_backwards,WF),
2300		direct_product_propagate_back(ProdList,R1,R2,WF)
2301		).
2302
2303		:- block direct_product_propagate_back(-,?,?,?).
2304		direct_product_propagate_back([],_,_,_WF).
2305		direct_product_propagate_back([(X,(Y,Z))|T],R1,R2,WF) :- %% print(prop_back(X,Y,Z,R1,R2)),nl, %
2306		check_element_of_wf((X,Y),R1,WF), check_element_of_wf((X,Z),R2,WF),
2307		direct_product_propagate_back(T,R1,R2,WF).
2308
2309		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:parallel_product([],[(int(3),int(4))],[]))).
2310		:- assert_must_succeed(exhaustive_kernel_check(bsets_clp:parallel_product([(int(1),int(2))],
2311		[(int(3),int(4))],[((int(1),int(3)),(int(2),int(4)))]))).
2312		:- assert_must_succeed((bsets_clp:parallel_product([(int(1),int(2))],
2313		[(int(3),int(4))],X), ground(X),
2314		equal_object(X,[((int(1),int(3)),(int(2),int(4)))]))).
2315		:- assert_must_succeed((bsets_clp:parallel_product([(int(1),int(2))],
2316		[(int(3),int(4))],[((int(1),int(3)),(int(2),int(4)))]))).
2317		:- assert_must_succeed((bsets_clp:parallel_product([(int(1),int(2))], [],X),X == [])).
2318		:- assert_must_succeed((bsets_clp:parallel_product([], [(int(3),int(4))],X),X == [])).
2319
2320		parallel_product(Rel1,Rel2,Prod) :- parallel_product_wf(Rel1,Rel2,Prod,no_wf_available).
2321
2322		:- block parallel_product_wf(-,?,?,?),parallel_product_wf(?,-,?,?).
2323		% NOTE: we now have in_parallel_product; as such parallel products are kept symbolic
2324		%parallel_product_wf(Rel1,Rel2,Prod,WF) :- (keep_symbolic(Rel1) -> true ; keep_symbolic(Rel2)),
2325		% print_term_summary(parallel_product(Rel1,Rel2,Prod)),nl,
2326		%% % TO DO: generate closure
2327		% %{xy,mn|#(x,y,m,n).(xy=(x,y) & mn=(m,n) & (x,m):S & (y,n):R)}
2328		% fail.
2329		parallel_product_wf(Rel1,Rel2,Prod,WF) :-
2330		expand_custom_set_to_list_wf(Rel1,Relation1,_,parallel_product_1,WF),
2331		expand_custom_set_to_list_wf(Rel2,Relation2,_,parallel_product_2,WF),
2332		parallel_product2(Relation1,Relation2,ProdRes,WF),
2333		equal_object_optimized_wf(ProdRes,Prod,parallel_product,WF).
2334
2335		:- use_module(kernel_equality,[conjoin_test/4]).
2336		%(Rel1||Rel2) = {(x,y),(m,n)| (x,m):Rel1 & (y,n):Rel2}
2337
2338		% TO DO: use this in b_interpreter_check:
2339		in_parallel_product_test(((X,Y),(M,N)),Rel1,Rel2,Result,WF) :-
2340		conjoin_test(MemRes1,MemRes2,Result,WF),
2341		% print_term_summary(in_parallel_product_test(Rel1,Rel2,Result,MemRes1,MemRes2)),nl,
2342		membership_test_wf(Rel1,(X,M),MemRes1,WF),
2343		membership_test_wf(Rel2,(Y,N),MemRes2,WF).
2344
2345		:- 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)).
2346
2347		in_parallel_product_wf(El,Rel1,Rel2,WF) :-
2348		in_parallel_product_test(El,Rel1,Rel2,pred_true,WF).
2349
2350
2351		:- 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))).
2352
2353		not_in_parallel_product_wf(El,Rel1,Rel2,WF) :-
2354		in_parallel_product_test(El,Rel1,Rel2,pred_false,WF).
2355
2356
2357		:- block parallel_product2(-,?,?,?).
2358		parallel_product2([],_,Out,WF) :- empty_set_wf(Out,WF).
2359		parallel_product2([(X,Y)|T],Rel2,Out,WF) :-
2360		parallel_product_tuple(Rel2,X,Y,Out,Tail,WF),
2361		parallel_product2(T,Rel2,Tail,WF).
2362
2363		:- block parallel_product_tuple(-,?,?,?,?,?).
2364		parallel_product_tuple([],_,_,Tail1,Tail2,WF) :- equal_object_wf(Tail1,Tail2,parallel_product_tuple,WF).
2365		parallel_product_tuple([(X2,Y2)|T],X,Y,Rel2,Tail,WF) :-
2366		equal_object_wf(Rel2,[((X,X2),(Y,Y2))|RT],parallel_product_tuple,WF),
2367		parallel_product_tuple(T,X,Y,RT,Tail,WF).
2368
2369
2370		% -------------------------------------------------
2371
2372		:- 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
2373		:- 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)).
2374		:- 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)).
2375		:- 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)).
2376		:- 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)).
2377		:- 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)).
2378		:- assert_must_fail((bsets_clp:not_partial_function([],[int(1)],[int(7)],_WF))).
2379		:- assert_must_fail((bsets_clp:not_partial_function(X,[int(1)],[int(7)],_WF),
2380		X = [(int(1),int(7))])).
2381		:- assert_must_fail((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7)],_WF),
2382		X = [(int(2),int(7)),(int(1),int(7))])).
2383		:- assert_must_fail((bsets_clp:not_partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2384		[int(7),int(6)],_WF),
2385		X = [([(int(1),int(2))],int(7)),
2386		([(int(2),int(3)),(int(1),int(3))],int(6))])).
2387		:- assert_must_fail((bsets_clp:not_partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2388		[int(7),int(6)],_WF),
2389		X = [([(int(2),int(3)),(int(1),int(3))],int(6))])).
2390		:- assert_must_fail((bsets_clp:not_partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2391		[int(7),int(6)],_WF),
2392		X = [([(int(1),int(2))],int(7)),
2393		([(int(2),int(3)),(int(1),int(3))],int(6))])).
2394		:- assert_must_fail((bsets_clp:not_partial_function(X,[int(1)],[[int(7),int(6)]],_WF),
2395		X = [(int(1),[int(6),int(7)])])).
2396		:- assert_must_fail((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2397		X = [(int(2),int(7)),(int(1),int(7))])).
2398		:- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2399		X = [(int(2),int(7)),(int(2),int(6))])).
2400		:- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2401		X = [(int(2),int(7)),(int(1),int(2))])).
2402		:- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2403		X = [(int(2),int(7)),(int(3),int(6))])).
2404		:- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2405		X = [(int(2),int(7)),(int(2),int(5))])).
2406		:- assert_must_succeed((bsets_clp:not_partial_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2407		X = [(int(1),int(7)),(int(2),int(6)),(int(2),int(7))])).
2408		:- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF),
2409		X = [(int(1),int(7)),(int(5),int(75))])).
2410		:- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('NATURAL1'),_WF),
2411		X = [(int(1),int(7)),(int(0),int(7))])).
2412		:- assert_must_succeed((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('NATURAL1'),_WF),
2413		X = [(int(1),int(7)),(int(-1),int(7))])).
2414		:- assert_must_succeed((bsets_clp:not_partial_function(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF),
2415		X = [(int(1),int(7)),(int(0),int(7))])).
2416		:- assert_must_fail((bsets_clp:not_partial_function(X,global_set('Name'),global_set('Code'),_WF),
2417		X = [(fd(1,'Name'),fd(1,'Code'))])).
2418		:- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('Code'),_WF),
2419		X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(88),fd(2,'Code'))])).
2420		:- assert_must_fail((bsets_clp:not_partial_function(X,global_set('NATURAL'),global_set('Code'),_WF),
2421		X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(2),fd(2,'Code'))])).
2422		:- assert_must_succeed((bsets_clp:not_partial_function([(fd(1,'Code'),int(1)),(fd(1,'Code'),int(2))],
2423		global_set('Code'),global_set('NAT1'),_WF) )).
2424
2425		:- block not_partial_function(-,?,?,?).
2426		not_partial_function([],_Domain,_Range,_WF) :- !,fail.
2427		not_partial_function(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
2428		% we do not need the Range; this means we can match more closures (e.g., lambda)
2429		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!,
2430		%print_term_summary(not_partial_fun_dom(FF,FFDomain,Range)),
2431		not_subset_of_wf(FFDomain,Domain,WF).
2432		not_partial_function(FF,Domain,Range,WF) :- nonvar(FF),
2433		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_)),!,
2434		%print_term_summary(check_special_not_pf(FF,FFDomain,FFRange)),nl,
2435		not_both_subset_of(FFDomain,FFRange,Domain,Range,WF).
2436		not_partial_function(R,Domain,Range,WF) :-
2437		expand_and_convert_to_avl_set(R,AER),!,
2438		% print_term_summary(check_is_not_avl_partial_function(avl_set(AER),Domain,Range)),
2439		(is_avl_partial_function(AER)
2440		-> % print(is_pf),nl,
2441		is_not_avl_relation_over_domain_range(AER,Domain,Range,WF)
2442		%, print(not_in_domain_range),nl
2443		; true %,print(not_pf),nl
2444		).
2445		not_partial_function(R,Domain,Range,WF) :-
2446		expand_custom_set_to_list_wf(R,ER,_,not_partial_function,WF),
2447		not_pf(ER,[],Domain,Range,WF).
2448
2449		:- block not_pf(-,?,?,?,?).
2450		not_pf([],_,_,_,_) :- fail.
2451		not_pf([(X,Y)|T],SoFar,Dom,Ran,WF) :-
2452		membership_test_wf_with_force(SoFar,X,MemRes,WF),
2453		not_pf2(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
2454
2455		:- block not_pf2(-,?,?,?,?,?,?,?).
2456		not_pf2(pred_true,_X,_Y,_T,_SoFar,_Dom,_Ran,_WF). /* then not a function */
2457		not_pf2(pred_false,X,Y,T,SoFar,Dom,Ran,WF) :-
2458		membership_test_wf_with_force(Dom,X,MemRes,WF),
2459		not_pf2a(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
2460
2461		:- block not_pf2a(-,?,?,?,?,?,?,?).
2462		not_pf2a(pred_false,_X,_Y,_T,_SoFar,_Dom,_Ran,_WF). /* function, but domain wrong */
2463		not_pf2a(pred_true,X,Y,T,SoFar,Dom,Ran,WF) :-
2464		remove_element_wf_if_not_infinite_or_closure(X,Dom,Dom2,WF,_LWF,Done), %% provide _LWF ??
2465		not_pf2b(Done,X,Y,T,SoFar,Dom2,Ran,WF).
2466
2467		:- block not_pf2b(-, ?,?,?, ?,?,?, ?).
2468		not_pf2b(_Done, X,Y,T, SoFar,Dom2,Ran, WF) :- %print_term_summary(not_pf2b(X,Y,T,SoFar,Dom2,Ran,WF)),nl,
2469		add_element_wf(X,SoFar,SoFar2,WF),
2470		(T==[] -> not_element_of_wf(Y,Ran,WF)
2471		; membership_test_wf_with_force(Ran,Y,MemRes,WF),
2472		prop_empty_pred_false(T,MemRes), % if T=[] -> Y must not be in Ran
2473		not_pf3(MemRes,T,SoFar2,Dom2,Ran,WF)).
2474
2475		:- block prop_empty_pred_false(-,?).
2476		prop_empty_pred_false([],R) :- !, R=pred_false.
2477		prop_empty_pred_false(_,_).
2478
2479		:- block not_pf3(-,?,?,?,?,?).
2480		not_pf3(pred_false,_T,_SoFar,_Dom2,_Ran,_WF). /* illegal range */
2481		not_pf3(pred_true,T,SoFar,Dom2,Ran,WF) :-
2482		not_pf(T,SoFar,Dom2,Ran,WF).
2483
2484		:- 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)).
2485		:- 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)).
2486		:- 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)).
2487		:- 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)).
2488		:- assert_must_succeed((bsets_clp:partial_function([],[int(1)],[int(7)]))).
2489		:- assert_must_succeed((bsets_clp:partial_function(X,[int(1)],[int(7)]),
2490		X = [(int(1),int(7))])).
2491		:- assert_must_succeed((bsets_clp:partial_function(X,[int(1),int(2)],[int(7)]),
2492		equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
2493		:- assert_must_succeed((findall(X,bsets_clp:partial_function(X,[int(1),int(2)],[int(7)]),L),
2494		length(L,Len), Len >= 4,
2495		(preferences:get_preference(convert_comprehension_sets_into_closures,true) -> true ; Len=4) )).
2496		:- assert_must_succeed((bsets_clp:partial_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2497		[int(7),int(6)]),
2498		equal_object(X,[([(int(1),int(2))],int(7)),
2499		([(int(2),int(3)),(int(1),int(3))],int(6))]))).
2500		:- assert_must_succeed((bsets_clp:partial_function_wf(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2501		[int(7),int(6)],_WF),
2502		X = [([(int(2),int(3)),(int(1),int(3))],int(6))])).
2503		:- assert_must_succeed((bsets_clp:partial_function_wf(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2504		[int(7),int(6)],_WF),
2505		X = [([(int(1),int(2))],int(7)),
2506		([(int(2),int(3)),(int(1),int(3))],int(6))])).
2507		:- assert_must_succeed((bsets_clp:partial_function_wf(X,[int(1)],[[int(7),int(6)]],_WF),
2508		X = [(int(1),[int(6),int(7)])])).
2509		:- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF),
2510		X = [(int(1),int(7)),(int(5),int(75))])).
2511		:- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('NATURAL1'),_WF),
2512		X = [(int(1),int(7)),(int(0),int(7))])).
2513		:- assert_must_fail((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('NATURAL1'),_WF),
2514		X = [(int(1),int(7)),(int(-1),int(7))])).
2515		:- assert_must_fail((bsets_clp:partial_function_wf(X,global_set('NATURAL1'),global_set('NATURAL1'),_WF),
2516		X = [(int(1),int(7)),(int(0),int(7))])).
2517		:- assert_must_fail((bsets_clp:partial_function_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
2518		X = [(int(2),int(7)),(int(2),int(6))])).
2519		:- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('Name'),global_set('Code'),_WF),
2520		X = [(fd(1,'Name'),fd(1,'Code'))])).
2521		:- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('Code'),_WF),
2522		X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(88),fd(2,'Code'))])).
2523		:- assert_must_succeed((bsets_clp:partial_function_wf(X,global_set('NATURAL'),global_set('Code'),_WF),
2524		X = [(int(1),fd(1,'Code')),(int(0),fd(1,'Code')),(int(2),fd(2,'Code'))])).
2525
2526		partial_function(R,Domain,Range) :- init_wait_flags(WF),
2527		partial_function_wf(R,Domain,Range,WF),
2528		% print(grounding_pf_wait_flags(WF)),nl,
2529		ground_wait_flags(WF).
2530
2531		:- use_module(kernel_equality,[get_cardinality_powset_wait_flag/5]).
2532		:- block partial_function_wf(-,-,?,?).
2533		partial_function_wf(R,_Domain,_Range,_WF) :- R==[], !.
2534		partial_function_wf(R,Domain,Range,WF) :- (Domain==[] ; Range==[]), !, empty_set_wf(R,WF).
2535	?	partial_function_wf(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
2536		% we do not need the Range; this means we can match more closures (e.g., lambda)
2537		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!,
2538		% print_term_summary(partial_fun_dom(FF,FFDomain,Range)),
2539		check_subset_of_wf(FFDomain,Domain,WF).
2540		partial_function_wf(FF,Domain,Range,WF) :- nonvar(FF),
2541		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_)),!,
2542		% same as for total_function_wf check
2543		%print(check_special(FF,FFDomain,FFRange)),nl,
2544		check_subset_of_wf(FFDomain,Domain,WF),
2545		check_subset_of_wf(FFRange,Range,WF). %, print(special_partial_fun(FF)),nl.
2546		partial_function_wf(R,Domain,Range,WF) :- %print(pf(R)),nl,
2547		expand_and_convert_to_avl_set_warn(R,AER,partial_function_wf,'ARG : ? +-> ?'),!,
2548		% print_term_summary(check_is_avl_partial_function(avl_set(AER),Domain,Range)),
2549		is_avl_partial_function(AER),
2550		is_avl_relation_over_domain(AER,Domain,WF), %print(dom_ok),nl,
2551		is_avl_relation_over_range(AER,Range,WF).
2552		partial_function_wf(R,Domain,Range,WF) :- %% print(pf(R,Domain,Range,WF)),nl, %%
2553		%we used to call:
2554		get_cardinality_powset_wait_flag(Domain,partial_function_wf,WF,Card,CWF),
2555		% probably we should compute real cardinality of set of partial functions over Domain +-> Range ?
2556		% the powset waitflag uses 2^Card as priority; is the number of partial functions when Range contains just a single element
2557		% slows down test 1088: TO DO investigate
2558		% get_cardinality_partial_function_wait_flag(Domain,Range,partial_function_wf,WF,Card,_,CWF),
2559		%% Maybe we should only enumerate partial functions for domain variables ; e.g., not f <+ {x |-> y} : T +-> S
2560		%% print_bt_message(pf_dom_card(Card)),nl, %%%
2561		% probably we should use a special version when R is var
2562		propagate_empty_set(Domain,R),
2563		propagate_empty_set(Range,R),
2564		(var(R) -> pf_var_r(R,var,Domain,Range,Card,WF,CWF) ; pf_var_r(R,nonvar,Domain,Range,Card,WF,CWF)).
2565
2566		% if first argument is empty, second argument must also be empty
2567		:- block propagate_empty_set(-,?).
2568		propagate_empty_set([],A) :- !,
2569		% (A==[] -> true ; print(prop_empty(A)),nl), %%
2570		kernel_objects:empty_set(A). % TO DO: add WF
2571		propagate_empty_set(_,_).
2572
2573		:- block pf_var_r(-,?,?,?,?,?,-).
2574		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
2575		expand_and_convert_to_avl_set_warn(R,AER,pf_var_r,'ARG : ? +-> ?'),!,
2576		% print_term_summary(check_is_avl_partial_function(avl_set(AER),Domain,Range)),
2577		is_avl_partial_function(AER),
2578		is_avl_relation_over_domain(AER,Domain,WF), %print(dom_ok),nl,
2579		is_avl_relation_over_range(AER,Range,WF).
2580		pf_var_r(R,_,Domain,Range,Card,WF,CWF) :-
2581		expand_custom_set_to_list_wf(R,ER,_,partial_function_wf,WF),
2582		% print(expanded(R,ER,CWF)),nl,
2583		%get_last_wait_flag(partial_fun(Domain),WF,LWF),
2584		pf_w(ER,[],Domain,Range,Card,_Large,WF,CWF).
2585
2586		pf_w(T,SoFar,Dom,Ran,Card,Large,WF,LWF) :-
2587		(Card==0 -> T=[]
2588		; pf(T,SoFar,Dom,Ran,Card,Large,WF,LWF)).
2589
2590		:- block pf(-,?,?,?,?,?,?,-).
2591		pf(LIST,_,_,_,_,_WF,_,_LWF) :- LIST==[],!. % avoid leaving choicepoint
2592		pf(AVL,SoFar,Dom,Ran,Card,Large,WF,LWF) :- nonvar(AVL),AVL=avl_set(_A),
2593		add_internal_error('AVL arg: ',pf(AVL,SoFar,Dom,Ran,Card,Large,WF,LWF)),fail.
2594		pf([],_,_,_,_,_WF,_,_LWF).
2595		pf(LIST,SoFar,Dom,Ran,Card,Large,WF,LWF) :-
2596		(var(LIST) -> ListWasVar = true ; ListWasVar = false), % is ListWasVar = true we are doing the enumeration driven by LWF being ground
2597		LIST = [(X,Y)|T],
2598		dec_card(Card,NC),/* Card ensures we do not build too big lists */
2599		Dom \== [],
2600		remove_domain_element(ListWasVar,X,Y,Dom,Dom2,Large,WF,LWF,Done),
2601		%% prints(rem_dom(X,Dom,Dom2,Card,Done)),nl, %%
2602		check_element_of_wf(Y,Ran,WF),
2603		pf1(Done, X,Y,T,SoFar,Dom2,Ran,NC,Large,WF,LWF).
2604
2605		:- block dec_card(-,?).
2606		dec_card(inf,NewC) :- !, NewC=inf.
2607		dec_card(C,NewC) :- C>0, NewC is C-1.
2608
2609		:- block pf1(-, ?,?,?,?,?,?,?,?,?,?).
2610		pf1(_Done, X,_Y,T,SoFar,Dom2,Ran,Card,Large,WF,LWF) :-
2611		not_element_of_wf(X,SoFar,WF), /* check that it is a function */
2612		%% check_element_of_wf(Y,Ran,WF), % this check is now done above in pf
2613		% prints(check(Y,Ran)), %%
2614		add_new_element_wf(X,SoFar,SoFar2,WF), %print(added(SoFar2)),nl,
2615		pf_w(T,SoFar2,Dom2,Ran,Card,Large,WF,LWF).
2616
2617		remove_domain_element(ListWasVar,X,Y,Dom,Dom2,Large,WF,LWF,Done) :- compute_large(Dom,Large),
2618		((ListWasVar==true,var(X),var(Y),Large==false,
2619		preference(convert_comprehension_sets_into_closures,false), % not in symbolic mode
2620		kernel_tools:ground_value(Dom))
2621		-> %% (X, Y are free and we drive the enumeration: we can influence which element is taken from Dom
2622		% print_term_summary(removing_minimal_element(X,Y,Dom)),
2623		remove_a_minimal_element(X,Dom,Dom2,WF,Done) %%%%%%%%%% added Jul 15 2008
2624		%,print_term_summary(done(X,Dom2,Done)) )
2625		; remove_element_wf_if_not_infinite_or_closure(X,Dom,Dom2,WF,LWF,Done)
2626		).
2627		compute_large(Dom,Large) :- % check if the domain is large; ensure that we compute this only once
2628		(nonvar(Large) -> true
2629		; var(Dom) -> true
2630		; dont_expand_this_explicit_set(Dom) -> Large=large
2631		; Large=false).
2632
2633		:- assert_must_succeed(( bsets_clp:remove_a_minimal_element(X,[int(1)],R,_WF,Done),
2634		X==int(1), Done==true, R=[] )).
2635		:- 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),
2636		X==int(2), Done==true, R=[int(3)] )).
2637		:- 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),
2638		X==int(1), R=[int(2),int(3)], Done==true )).
2639		:- 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),
2640		X==int(3), R=[], Done==true )).
2641		:- assert_must_succeed(( init_wait_flags(WF), CL=closure(['_zzzz_binary'],[integer],b(member( b(identifier('_zzzz_binary'),integer,[]),
2642		b(interval(b(value(int(1)),integer,[]),b(value(int(10)),integer,[])),set(integer),[])),pred,[])),
2643		bsets_clp:remove_a_minimal_element(X,CL,R,WF,Done), ground_wait_flags(WF),
2644		X=int(9), Done==true, kernel_objects:equal_object(R,[int(10)]) )).
2645
2646		/* usage: restrict number of possible choices if element to remove is free */
2647		/* select one element; and disallow all elements appearing before it in the list */
2648		remove_a_minimal_element(X,Set,Res,WF,Done) :-
2649		expand_custom_set_to_list_wf(Set,ESet,EDone,remove_a_minimal_element,WF),
2650		remove_a_minimal_element2(X,ESet,EDone,Res,WF,Done).
2651
2652		:- use_module(kernel_equality,[get_cardinality_wait_flag/4]).
2653		:- block remove_a_minimal_element2(?,?,-,?,?,?).
2654		remove_a_minimal_element2(X,ESet,EDone,Res,WF,Done) :- var(ESet),
2655		% should not happen as we wait for EDone
2656		add_internal_error('Illegal call: ',remove_a_minimal_element2(X,ESet,EDone,Res,WF,Done)),
2657		fail.
2658		remove_a_minimal_element2(X,ESet,_EDone,Res,WF,Done) :-
2659		% print(removing_minimal_element2(X,ESet,Res,WF)),nl,%
2660		ESet \= [],
2661		(ESet = [El]
2662		-> X=El, empty_set_wf(Res,WF), Done=true % only one choice
2663		; get_cardinality_wait_flag(ESet,remove_a_minimal_element2,WF,CWF),
2664		remove_a_minimal_element3(X,ESet,Res,WF,Done,CWF)
2665		).
2666
2667		:- block remove_a_minimal_element3(?,?,?,?,?,-).
2668		remove_a_minimal_element3(X,ESet,Res,WF,Done,_) :- var(Res), !,
2669		append(_,[X|TRes],ESet), % WHAT IF Res has been instantiated in the meantime ???
2670		equal_object_wf(Res,TRes,remove_a_minimal_element2_2,WF),Done=true.
2671		remove_a_minimal_element3(X,ESet,Res,WF,Done,_) :- print(remove_min_nonvar_res(Res)),nl,
2672		equal_cons_wf(ESet,X,Res,WF), Done=true.
2673
2674
2675
2676
2677
2678		:- 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)).
2679		:- assert_must_succeed((bsets_clp:total_function(X,[int(1)],[int(7)]),
2680		X = [(int(1),int(7))])).
2681		:- assert_must_succeed((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]),
2682		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
2683		:- assert_must_succeed((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3))]],[int(7),int(6)]),
2684		kernel_objects:equal_object(X,[([(int(1),int(3))],int(7)),([(int(1),int(2))],int(7))]))).
2685		:- assert_must_succeed((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2686		[int(7),int(6)]),
2687		kernel_objects:equal_object(X,[([(int(1),int(2))],int(7)),
2688		([(int(2),int(3)),(int(1),int(3))],int(6))]))).
2689		:- assert_must_succeed((bsets_clp:total_function(X,[int(1)],[[int(7),int(6)]]),
2690		kernel_objects:equal_object(X,[(int(1),[int(6),int(7)])]))).
2691		:- assert_must_succeed((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2692		[[int(7),int(6)]]),
2693		kernel_objects:equal_object(X,[([(int(1),int(2))],[int(6),int(7)]),
2694		([(int(2),int(3)),(int(1),int(3))],[int(6),int(7)])]))).
2695		:- assert_must_succeed((bsets_clp:total_function(X,[ [(int(1),int(3)),(int(2),int(3))]],
2696		[int(6)]),
2697		kernel_objects:equal_object(X,[ ([(int(2),int(3)),(int(1),int(3))], int(6)) ]))).
2698		:- assert_must_succeed((bsets_clp:total_function(X,global_set('Name'),
2699		[[],[fd(1,'Code'),fd(2,'Code')],[fd(1,'Code')],[fd(2,'Code')]]),
2700		kernel_objects:enumerate_basic_type(X,set(couple(global('Name'),set(global('Code'))))),
2701		kernel_objects:equal_object(X,[(fd(3,'Name'),[fd(2,'Code')]),(fd(1,'Name'),[fd(2,'Code')]),(fd(2,'Name'),[])]))).
2702
2703		%:- assert_must_succeed(( kernel_waitflags:init_wait_flags(WF),bsets_clp:total_function_wf(TF,global_set('Code'),
2704		% closure([zzzz],[set(set(couple(integer,boolean)))],
2705		% member(identifier(zzzz),
2706		% pow_subset(value(closure([zzzz],[set(couple(integer,boolean))],
2707		% member('ListExpression'(['Identifier'(zzzz)]),
2708		% 'Seq'(value([pred_true /* bool_true */,pred_false /* bool_false */])))))))),WF),
2709		% % print(tf(TF)),nl,
2710		% 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 */)]]),
2711		% (fd(2,'Code'), [[],[(int(1),pred_true /* bool_true */)],[(int(1),pred_true /* bool_true */),(int(2),pred_true /* bool_true */)]]) ]),
2712		% print(gr(WF)),nl,
2713		% kernel_waitflags:ground_wait_flags(WF) )).
2714
2715		:- assert_must_succeed((bsets_clp:total_function([],[],[int(7)]))).
2716
2717		:- assert_must_fail((bsets_clp:total_function([],[int(1)],[int(7)]))).
2718		:- assert_must_fail((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]),
2719		kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
2720		:- assert_must_fail((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]),
2721		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(5))]))).
2722		:- assert_must_fail((bsets_clp:total_function(X,[int(1),int(2)],[int(7),int(6)]),
2723		kernel_objects:equal_object(X,[(int(2),int(7))]))).
2724		:- assert_must_fail((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2725		[int(7),int(6)]),
2726		kernel_objects:equal_object(X,[([(int(1),int(2))],int(7)),
2727		([(int(1),int(3)),(int(1),int(3))],int(6))]))).
2728		:- assert_must_fail((bsets_clp:total_function(X,[[(int(1),int(2))],[(int(1),int(3)),(int(2),int(3))]],
2729		[int(7),int(6)]),
2730		kernel_objects:equal_object(X,[([(int(1),int(3)),(int(1),int(3))],int(6))]))).
2731
2732		total_function(R,Domain,Range) :- init_wait_flags(WF),
2733		total_function_wf(R,Domain,Range,WF),
2734		ground_wait_flags(WF).
2735
2736
2737		:- assert_must_succeed((bsets_clp:total_function_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
2738		nonvar(X),X=[(A,B),(C,D)],A==int(1),C==int(2),\+ ground(B),\+ ground(D), B=int(7),D=int(7) )).
2739
2740		:- block total_function_wf(-,-,-,?).
2741		total_function_wf(FF,Domain,_Range,WF) :- FF == [],!,
2742		empty_set_wf(Domain,WF).
2743		total_function_wf(FF,Domain,Range,WF) :-
2744		Range == [],!,
2745		empty_set_wf(FF,WF), empty_set_wf(Domain,WF).
2746		total_function_wf(FF,Domain,Range,WF) :-
2747		% TO DO: if FF or Domain nonvar but \= [] -> check if other variable becomes []
2748		total_function_wf1(FF,Domain,Range,WF).
2749
2750		:- block total_function_wf1(?,-,?,?).
2751		total_function_wf1(FF,Domain,_Range,WF) :-
2752		FF==[],!,
2753		empty_set_wf(Domain,WF).
2754		total_function_wf1(FF,Domain,Range,WF) :-
2755	?	nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
2756		% we do not need the Range; this means we can match more closures (e.g., lambda)
2757		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!,
2758		% print_term_summary(total_fun_dom(FF,FFDomain,Range)),
2759		equal_object_wf(FFDomain,Domain,total_function_wf1_1,WF).
2760		total_function_wf1(FF,Domain,Range,WF) :- nonvar(FF),
2761		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_)),!,
2762		equal_object_wf(FFDomain,Domain,total_function_wf1_2,WF), check_subset_of_wf(FFRange,Range,WF)
2763		.%, print(special_total_fun(FF)),nl.
2764		total_function_wf1(R,Domain,Range,WF) :- nonvar(R), R=avl_set(AEF), !,
2765		total_function_avl_set(AEF,Domain,Range,WF).
2766		total_function_wf1(FF,Domain,Range,WF) :-
2767		% want to replace FF by closure: needs to be a variable!
2768		var(FF),
2769		% if the total function can not be build up explicitely (i.e. infinite domain)
2770		% TODO: can / should this be relaxed?
2771		custom_explicit_sets:get_card_for_specific_custom_set(Domain,Card),
2772		Card == inf,
2773		kernel_objects:infer_value_type(Domain,set(DomT)),
2774		kernel_objects:infer_value_type(Range,set(RanT)),
2775		!,
2776		% IDEA : TF = %x.(x:Domain|DEFAULT) <+ SFF, where SFF is partial function and DEFAULT is some default value
2777		% build up a partial function instead (fulfilling all constraints)
2778		partial_function_wf(SFF,Domain,Range,WF),
2779		% next, build up a total function mapping everything to a default value
2780		% this function will be overriden by the partial function to fulfilling
2781		% given constraints
2782		% 1. identifiers for closure
2783		create_texpr(identifier('__domid__'),DomT,[],TDomId),
2784		create_texpr(identifier('__ranid__'),RanT,[],TRanId),
2785		% 2. domain identifier might take all values of the domain
2786		create_texpr(member(TDomId,b(value(Domain),set(DomT),[])),pred,[],DomMember),
2787		% 3. pick a single value for the range identifier
2788		check_element_of_wf(RangeElement,Range,WF),
2789		%% external_functions:observe_value(RangeElement,"range"),external_functions:observe_value(SFF,"pf"),
2790		create_texpr(equal(TRanId,b(value(RangeElement),RanT,[])),pred,[],RanMember),
2791		% 4. conjunct and form closure (should be treated symbolically)
2792		conjunct_predicates([RanMember,DomMember],Pred),
2793		Default = closure(['__domid__','__ranid__'],[DomT,RanT],Pred),
2794		% 5. override default values where needed
2795		override_relation(Default,SFF,FF,WF).
2796		total_function_wf1(R,Domain,Range,WF) :- % print(total_function(R,Domain,Range,WF)),nl,
2797		try_expand_and_convert_to_avl_with_check(Domain,EDomain,total_function), % avoid multiple expansions, but useless when dom_for_lambda_closure case triggers below ! TO DO: fix
2798		% print(EDomain),nl,
2799		% TO DO: maybe avoid converting intervals which are not fully instantiated ?
2800		% 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
2801		try_expand_and_convert_to_avl_unless_large(R,ER),
2802		total_function_wf2(ER,EDomain,Range,WF).
2803
2804		:- block total_function_wf2(?,-,?,?).
2805		total_function_wf2(R,Domain,Range,WF) :- nonvar(R), R=avl_set(AEF), !,
2806		total_function_avl_set(AEF,Domain,Range,WF).
2807		total_function_wf2(R,Domain,Range,WF) :- %print_term_summary(total_function_wf2(R,Domain,Range,WF)),
2808		cardinality_as_int_wf(Domain,int(Card),WF),
2809		total_function_wf3(R,Card,Domain,Range,WF).
2810
2811		total_function_wf3(FF,Card,Domain,Range,WF) :- nonvar(FF),
2812		(number(Card) -> Card > 10000 ; true),
2813		custom_explicit_sets:dom_for_lambda_closure(FF,FFDomain),
2814		% we have a lambda closure where we cannot determine the range, otherwise dom_range_for_specific_closure would have succeeded
2815		% example: f = %x.(x:NATURAL1|x+1) & f: NATURAL1 --> NATURAL
2816		FF = closure(P,T,Pred),
2817		get_range_id_expression(P,T,TRangeID),
2818		!,
2819		equal_object_wf(FFDomain,Domain,total_function1_closure,WF),
2820		% CHECK not(#P.(Pred & P /: Range))
2821		% print(try_symbolic_range_check(P)), translate:print_bexpr(TRangeID),nl, %trace,
2822		ExpectedRange = b(value(Range),set(RanT),[]), get_texpr_type(TRangeID,RanT),
2823		safe_create_texpr(not_member(TRangeID,ExpectedRange),pred,NotMemCheck),
2824		conjunct_predicates([Pred,NotMemCheck],Pred2),
2825		is_empty_closure_wf(P,T,Pred2,WF).
2826		% custom_explicit_sets:ran_symbolic(closure(P,T,Pred),RanSymbolic), check_subset_of_wf(RanSymbolic,Range,WF).
2827		total_function_wf3(R,Card,Domain,Range,WF) :-
2828		%print('TF '),translate:print_bvalue(R),nl,
2829		card_convert_int_to_peano(Card,PeanoCard),
2830		% print(tf_card(R,Domain,Card)),nl, trace,
2831		((nonvar(R);ground(PeanoCard))-> true
2832		; get_last_wait_flag(total_fun(Domain),WF,WF1)),
2833		when((nonvar(R);ground(PeanoCard);
2834		(nonvar(PeanoCard),nonvar(WF1))), /* mal 12/5/04: changed , into ; 17/3/2008: added WF1 */
2835		/* reason for delaying nonvar(Card): Card grounded bit by bit by cardinality; avoid
2836		triggering too early and missing tf_var */
2837		total_function1(R,PeanoCard,Domain,Range,WF
2838		)).
2839
2840		:- use_module(bsyntaxtree,[safe_create_texpr/3]).
2841		:- use_module(library(lists),[last/2]).
2842		% for a closure get the identifier or proj expression that represents range values
2843		get_range_id_expression([PairID],[Type],Res) :- !,
2844		Type = couple(_,TX),
2845		TP = b(identifier(PairID),Type,[]),
2846		safe_create_texpr(second_of_pair(TP),TX,Res). % prj2(PairID) ,
2847		%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
2848		% but currently lambda closure detection in dom_for_lambda_closure cannot handle such closures anyway
2849		get_range_id_expression(P,T,b(identifier(ID),Type,[])) :- last(P,ID), last(T,Type).
2850
2851		total_function_avl_set(AEF,Domain,Range,WF) :-
2852		%print(total_function_avl(avl_set(AEF),Dom,Range)),nl,
2853		(Domain = avl_set(Dom) -> is_avl_total_function_over_domain(AEF,Dom)
2854		; is_avl_partial_function(AEF),
2855		domain_of_explicit_set(avl_set(AEF),AEF_Domain),
2856		equal_object_wf(AEF_Domain,Domain,total_function_avl_set,WF)
2857		),
2858		is_avl_relation_over_range(AEF,Range,WF).
2859		%total_function1(FF,Card,Domain,Range,WF) :- nonvar(FF),
2860		% custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_)),
2861		% print(dom_range_for_specific_closure(FF,FFDomain,Domain,FFRange,Range)),nl,fail.
2862
2863
2864		total_function1(FF,_,Domain,Range,WF) :-
2865		expand_and_convert_to_avl_set_warn(FF,AEF,total_function1,'ARG : ? --> ?'),!,
2866		total_function_avl_set(AEF,Domain,Range,WF).
2867		total_function1(R,Card,Domain,Range,WF) :-
2868		try_expand_custom_set(R,ER),
2869		total_function2(ER,Card,Domain,Range,WF).
2870
2871		total_function2(ER,Card,Domain,Range,WF) :-
2872		var(ER),ground(Card),!, % print(tf_var(Card)),nl,
2873		tf_var(TotalFunction,[],Card,Domain,Range,WF), %print(TotalFunction),nl,
2874		ER=TotalFunction.
2875		total_function2(ER,Card,Domain,Range,WF) :-
2876		(ground(Card) -> get_wait_flag(0,tot_fun,WF,LWF) % we seem to know the domain exactly now; see e.g. test 1316
2877		; 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 ?
2878		%print(tf(ER,Card,Domain,LWF)),nl,
2879		tf(ER,[],Card,Domain,Range,WF,LWF).
2880
2881		:- block tf(-,?,-,?,?,?,?),tf(-,?,?,?,?,?,-).
2882		% tf(X,SoFar,C,Dom,Ran,WF,LWF) :- print_message(tf(X,SoFar,C,Dom,Ran,WF,LWF)),nl,fail.
2883		tf([],_,0,Dom,_,WF,_) :- empty_set_wf(Dom,WF).
2884		tf(FUN,SoFar,s(Card),Dom,Ran,WF,LWF) :- var(FUN),nonvar(Dom), % try setting up skeleton for total fun
2885		remove_exact_first_element(X,Dom,Dom2),not_element_of_wf(X,SoFar,WF),var(FUN),!,
2886		FUN = [(X,Y)|T], tf1(X,Y,T,SoFar,Card,Dom2,Ran,WF,LWF).
2887		tf([(X,Y)|T],SoFar,s(Card),Dom,Ran,WF,LWF) :-
2888		not_element_of_wf(X,SoFar,WF), %print(not_el(X)),nl,
2889		remove_element_wf(X,Dom,Dom2,WF), %mal: 17/3/08 changed to _wf version
2890		tf1(X,Y,T,SoFar,Card,Dom2,Ran,WF,LWF).
2891		tf1(X,Y,T,SoFar,Card,Dom2,Ran,WF,LWF) :-
2892		check_element_of_wf(Y,Ran,WF), % print_message(chk(Y,Ran)),
2893		%when((nonvar(T);nonvar(Card)), /* mal 12/5/04: changed , into ; */
2894		add_new_element_wf(X,SoFar,SoFar2,WF), %%% try_expand_and_convert_to_avl
2895		tf(T,SoFar2,Card,Dom2,Ran,WF,LWF).
2896
2897		:- block tf_var(-,?,-,?,?,?).
2898		tf_var(F,_,Card,Dom,_,WF) :- Card==0,!,F=[],empty_set_wf(Dom,WF). % avoid choice point
2899		tf_var([],_,0,Dom,_,WF) :- empty_set_wf(Dom,WF). %, print_bt_message(finished_tf_var).
2900		tf_var([(X,Y)|T],SoFar,s(Card),Dom,Ran,WF) :- %print_bt_message(tf_var(X,Y,SoFar,Card)),
2901		/* supposes that X + Y are unbound */
2902		/* TO DO: rewrite like enumerate <-------------------------- */
2903		((var(X),var(Y)) -> true ; (print_message(warning,'Nonvar in tf_var: '),
2904		print_message(warning,((X,Y))))),
2905		remove_exact_first_element(X,Dom,Dom2),
2906		not_element_of_wf(X,SoFar,WF),
2907		% print_message(check_element_of_wf(Y,Ran,WF)),
2908		check_element_of_wf(Y,Ran,WF),
2909		% print_message(checked(Y,Ran)),
2910		add_new_element_wf(X,SoFar,SoFar2,WF),
2911		tf_var(T,SoFar2,Card,Dom2,Ran,WF).
2912
2913
2914
2915		:- assert_must_succeed((bsets_clp:total_bijection(X,[int(1)],[int(7)]),
2916		X = [(int(1),int(7))])).
2917		:- assert_must_succeed((bsets_clp:total_bijection(X,[int(1),int(2)],[int(7),int(8)]),
2918		kernel_objects:equal_object(X,[(int(2),int(8)),(int(1),int(7))]))).
2919		:- assert_must_fail((bsets_clp:total_bijection(X,[int(1)],[int(7),int(3)]),
2920		X = [(int(1),int(7))])).
2921		:- assert_must_fail((bsets_clp:total_bijection(X,[int(1),int(2)],[int(3)]),
2922		X = [(int(1),int(3)),(int(2),int(3))])).
2923		:- assert_must_fail((bsets_clp:total_bijection(X,[int(1),int(2)],[int(7),int(8)]),
2924		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
2925		:- assert_must_fail((bsets_clp:total_bijection(X,[int(1),int(2)],[int(7),int(8)]),
2926		X = [(int(1),int(7)),(int(1),int(8))])).
2927
2928
2929
2930		total_bijection(R,Domain,Range) :- init_wait_flags(WF),
2931		total_bijection_wf(R,Domain,Range,WF),
2932		ground_wait_flags(WF).
2933
2934		:- block total_bijection_wf(?,-,?,?).
2935		total_bijection_wf(FF,Domain,Range,WF) :- nonvar(FF),
2936		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection)),!,
2937		equal_object_wf(FFDomain,Domain,total_bijection_wf_1,WF),
2938		equal_object_wf(FFRange,Range,total_bijection_wf_2,WF).
2939		%(R,Domain,Range,WF) :- Domain==Range,!, print(eq_domain_range),nl, total_injection_wf(R,Domain,Range,WF).
2940		total_bijection_wf(R,Domain,Range,WF) :- % print_term_summary(total_bijection_wf(R,Domain,Range)),
2941		cardinality_peano_wf(Domain,Card,WF), % TO DO: deal with infinite and large card
2942		%print(card_domain(Domain,Card)),nl,
2943		cardinality_peano_wf(Range,Card,WF), % Domain and Range must have same cardinality
2944		%print(card_range(Range,Card)),nl,
2945		%when(ground(Range),(print(ground_range(Range,Card,Domain)),nl)),
2946		%when(nonvar(Card), (print(nonvar_card(Card,Domain,Range)),nl)),
2947		%when(ground(Card), (print(ground_card(Card,Domain,Range)),nl)),
2948		total_injection_wf2(R,Domain,Range,WF). % TO DO: use cardinality_as_int_wf ? makes test 1194 fail
2949
2950		%Note: we used to call custom code: total_bijection_wf2(R,Domain,Card,Range,WF).
2951		% total_injection_wf2 gives a considerable performance boost, e.g., for test 1222 ClearSy/alloc_large.mch or NQueens with >->>
2952
2953		:- 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)).
2954		:- 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)).
2955		:- 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)).
2956		:- 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)).
2957		:- assert_must_fail((bsets_clp:not_total_function(X,[int(1)],[int(7)],_WF),
2958		X = [(int(1),int(7))])).
2959		:- assert_must_fail((bsets_clp:not_total_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2960		X = [(int(2),int(7)),(int(1),int(7))])).
2961		:- assert_must_succeed((bsets_clp:not_total_function([],[int(1)],[int(7)],_WF))).
2962		:- assert_must_succeed((bsets_clp:not_total_function([],[global_set('NAT1')],[global_set('Name')],_WF))).
2963		:- assert_must_succeed((bsets_clp:not_total_function([(int(7),int(7))],[int(1)],[int(7)],_WF))).
2964		:- assert_must_succeed((bsets_clp:not_total_function([(int(1),int(7)), (int(2),int(1))],
2965		[int(1),int(2)],[int(7)],_WF))).
2966		:- assert_must_succeed((bsets_clp:not_total_function(X,[int(1),int(2)],[int(7),int(6)],_WF),
2967		X = [(int(2),int(7)),(int(2),int(6))])).
2968
2969		:- block not_total_function(-,?,?,?), not_total_function(?,-,?,?).
2970	?	not_total_function(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
2971		% we do not need the Range; this means we can match more closures (e.g., lambda)
2972		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!,
2973		not_equal_object_wf(FFDomain,Domain,WF).
2974		not_total_function(FF,Domain,Range,WF) :- nonvar(FF),
2975		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_)),!,
2976		%print_term_summary(check_special_not_tf(FF,FFDomain,FFRange)),nl,
2977		equality_objects_wf(FFDomain,Domain,Result,WF), % not yet implemented ! % TODO ! -> sub_set,equal,super_set
2978		when(nonvar(Result),(Result=pred_false -> true ; not_subset_of_wf(FFRange,Range,WF))).
2979		% this clause is unsound: it prevents finite partial functions as solutions to not_total_function over an infinite domain
2980		%not_total_function(FF,Domain,Range,WF) :-
2981		% custom_explicit_sets:get_card_for_specific_custom_set(Domain,Card),
2982		% Card == inf, !, % cardinality is too large for avl expansion to be viable
2983		% not_partial_function(FF,Domain,Range,WF). % so search for something that is not even a partial function
2984		not_total_function(R,Domain,Range,WF) :-
2985		% print_term_summary(not_total_function(R,Domain,Range,WF)),
2986		try_expand_and_convert_to_avl_with_check(R,ER,not_total_function_range),
2987		try_expand_and_convert_to_avl_with_check(Domain,EDomain,not_total_function_domain), /* avoid multiple expansions */
2988		% print_term_summary(exp_domain(EDomain)),
2989		try_expand_and_convert_to_avl_unless_large(Range,ERange),
2990		% print_term_summary(exp_range(ERange)),
2991		not_total_function2(ER,EDomain,ERange,WF).
2992
2993		% repeat block, in case Domain or R is a closure
2994		:- block not_total_function2(-,?,?,?), not_total_function2(?,-,?,?).
2995		not_total_function2(R,Domain,Range,WF) :- %print_term_summary(not_tot2(R,Domain,Range)),
2996		expand_and_convert_to_avl_set_warn(R,AER,not_total_function2,'ARG /: ? --> ?'),
2997		!,
2998		not_total_function_avl(AER,Domain,Range,WF).
2999		not_total_function2(R,EDomain,ERange,WF) :-
3000		expand_custom_set_to_list_wf(R,ER,_,not_total_function2,WF),
3001		%print_term_summary(not_tf(R,ER)),nl,
3002		not_tf(ER,[],EDomain,ERange,WF).
3003
3004		not_total_function_avl(_AER,Domain,_Range,_WF) :- is_infinite_explicit_set(Domain),!,
3005		true. % a finite AVL set cannot be a total function over an infinite domain
3006		not_total_function_avl(AER,Domain,Range,WF) :-
3007		expand_and_convert_to_avl_set_warn(Domain,ADom,not_total_function2,'? /: ARG --> ?'),
3008		!,
3009		% print_term_summary(check_is_not_avl_total_function(avl_set(AER),Domain,Range)),
3010		(is_avl_total_function_over_domain(AER,ADom)
3011		-> % print(is_tf),nl,
3012		is_not_avl_relation_over_range(AER,Range,WF) % TO DO: check only Range !
3013		; true %,print(not_pf),nl
3014		).
3015		not_total_function_avl(AER,EDomain,ERange,WF) :-
3016		expand_custom_set_to_list_wf(avl_set(AER),ER,_,not_total_function_avl,WF),
3017		not_tf(ER,[],EDomain,ERange,WF).
3018
3019
3020		:- use_module(kernel_equality,[membership_test_wf_with_force/4]).
3021
3022		:- block not_tf(-,?,?,?,?).
3023		not_tf([],_,Domain,_,WF) :- not_empty_set_wf(Domain,WF).
3024		not_tf([(X,Y)|T],SoFar,Dom,Ran,WF) :- membership_test_wf_with_force(SoFar,X,MemRes,WF),
3025		not_tf2(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
3026
3027		:- block not_tf2(-,?,?,?, ?,?,?,?). %, not_tf2(?,?,?,?, -,?,?), not_tf2(?,?,?,?, ?,-,?).
3028		not_tf2(pred_true,_X,_,_T,_SoFar,_Dom,_Ran,_WF).% :- check_element_of_lazy(X,SoFar,WF).
3029		not_tf2(pred_false,X,Y,T,SoFar,Dom,Ran,WF) :-
3030		%not_element_of_wf(X,SoFar,WF),
3031		membership_test_wf_with_force(Dom,X,MemRes,WF),
3032		not_tf3(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
3033
3034		:- block not_tf3(-, ?,?,?,?, ?,?,?).
3035		not_tf3(pred_false,_X,_Y,_T,_SoFar,_Dom,_Ran,_WF).
3036		not_tf3(pred_true,X,Y,T,SoFar,Dom,Ran,WF) :-
3037		remove_element_wf(X,Dom,Dom2,WF),
3038		membership_test_wf_with_force(Ran,Y,MemRes,WF),
3039		not_tf4(MemRes,X,Y,T,SoFar,Dom2,Ran,WF).
3040
3041		:- block not_tf4(-, ?,?,?,?, ?,?,?).
3042		not_tf4(pred_false,_X,_Y,_T,_SoFar,_Dom2,_Ran,_WF).
3043		not_tf4(pred_true,X,_Y,T,SoFar,Dom2,Ran,WF) :-
3044		%check_element_of_wf(Y,Ran,WF), %DO WE NEED THIS ????
3045		add_new_element_wf(X,SoFar,SoFar2,WF),
3046		not_tf(T,SoFar2,Dom2,Ran,WF).
3047
3048
3049
3050		:- 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)).
3051		:- 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)).
3052		:- 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)).
3053		:- assert_must_fail((bsets_clp:not_total_bijection(X,[int(1)],[int(7)],_WF),
3054		X = [(int(1),int(7))])).
3055		:- assert_must_fail((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF),
3056		X = [(int(2),int(7)),(int(1),int(6))])).
3057		:- assert_must_fail((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF),
3058		X = [(int(1),int(7)),(int(2),int(6))])).
3059		:- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(3)],_WF),
3060		X = [(int(1),int(3)),(int(2),int(3))])).
3061		:- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF),
3062		X = [(int(2),int(7)),(int(1),int(7))])).
3063		:- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1)],[int(7),int(8)],_WF),
3064		X = [(int(1),int(7))])).
3065		:- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7)],_WF),
3066		X = [(int(2),int(7))])).
3067		:- assert_must_succeed((bsets_clp:not_total_bijection([],[int(1)],[int(7)],_WF))).
3068		:- assert_must_succeed((bsets_clp:not_total_bijection([(int(7),int(7))],[int(1)],[int(7)],_WF))).
3069		:- assert_must_succeed((bsets_clp:not_total_bijection([(int(1),int(7)), (int(2),int(1))],
3070		[int(1),int(2)],[int(7)],_WF))).
3071		:- assert_must_succeed((bsets_clp:not_total_bijection(X,[int(1),int(2)],[int(7),int(6)],_WF),
3072		X = [(int(2),int(7)),(int(2),int(6))])).
3073
3074		:- block not_total_bijection(-,?,?,?).
3075		not_total_bijection(FF,Domain,Range,WF) :-
3076		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection)),!,
3077		%% print(not_total_bijection_wf_closure(FFDomain,FFRange)),nl, %%
3078		not_equal_object_wf((FFDomain,FFRange),(Domain,Range),WF).
3079		not_total_bijection(R,Domain,Range,WF) :-
3080		try_expand_custom_set(R,ER),not_tot_bij(ER,[],Domain,Range,WF).
3081
3082		:- block not_tot_bij(-,?,?,?,?).
3083		not_tot_bij([],_,Domain,Range,_WF) :- empty_not_tot_bij(Domain,Range).
3084		not_tot_bij([(X,Y)|T],SoFar,Dom,Ran,WF) :- membership_test_wf(SoFar,X,MemRes,WF),
3085		not_tot_bij2(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
3086
3087		:- use_module(kernel_equality,[empty_set_test/2]).
3088		:- block empty_not_tot_bij(-,?).
3089		empty_not_tot_bij(Domain,Range) :-
3090		empty_set_test(Domain,EqRes), empty_not_tot_bij2(EqRes,Range).
3091		:- block empty_not_tot_bij2(-,?).
3092		empty_not_tot_bij2(pred_false,_).
3093		empty_not_tot_bij2(pred_true,Range) :- not_empty_set(Range).
3094
3095		:- block not_tot_bij2(-,?,?,?,?,?,?,?).
3096		not_tot_bij2(pred_true,_X,_,_T,_SoFar,_Dom,_Ran,_WF).
3097		not_tot_bij2(pred_false,X,Y,T,SoFar,Dom,Ran,WF) :-
3098		membership_test_wf(Dom,X,MemRes,WF),
3099		not_tot_bij3(MemRes,X,Y,T,SoFar,Dom,Ran,WF).
3100
3101		:- block not_tot_bij3(-,?,?,?,?,?,?,?).
3102		not_tot_bij3(pred_false,_X,_,_T,_SoFar,_Dom,_Ran,_WF). % X not a member of domain
3103		not_tot_bij3(pred_true,X,Y,T,SoFar,Dom,Ran,WF) :-
3104		remove_element_wf(X,Dom,Dom2,WF),
3105		membership_test_wf(Ran,Y,MemRes,WF),
3106		not_tot_bij4(MemRes,X,Y,T,SoFar,Dom2,Ran,WF).
3107
3108		:- block not_tot_bij4(-,?,?,?,?,?,?,?).
3109		not_tot_bij4(pred_false,_X,_,_T,_SoFar,_Dom2,_Ran,_WF). % Y not a member of range
3110		not_tot_bij4(pred_true,X,Y,T,SoFar,Dom2,Ran,WF) :-
3111		remove_element_wf(Y,Ran,Ran2,WF),
3112		add_element_wf(X,SoFar,SoFar2,WF),
3113		not_tot_bij(T,SoFar2,Dom2,Ran2,WF).
3114
3115
3116
3117		:- 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)).
3118		:- 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)).
3119		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_restriction_wf([],[int(2),int(3)],[],WF),WF)).
3120		:- assert_must_succeed((bsets_clp:range_restriction_wf([],[int(1)],[],_WF))).
3121		:- assert_must_succeed((bsets_clp:range_restriction_wf([],[],[],_WF))).
3122		:- assert_must_succeed((bsets_clp:range_restriction_wf([(int(1),int(2))],[int(1)],[],_WF))).
3123		:- assert_must_succeed((bsets_clp:range_restriction_wf([(int(1),int(2))],[int(2)],[(int(1),int(2))],_WF))).
3124		:- assert_must_succeed((bsets_clp:range_restriction_wf(X,[fd(3,'Name')],R,_WF),
3125		X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],
3126		kernel_objects:equal_object(X,R))).
3127		:- assert_must_succeed((bsets_clp:range_restriction_wf(X,Y,R,_WF),
3128		X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],Y=global_set('Name'),
3129		kernel_objects:equal_object(X,R))).
3130		:- assert_must_fail((bsets_clp:range_restriction_wf(X,[fd(3,'Name')],R,_WF),
3131		X = [(int(1),fd(3,'Name')),(int(2),fd(1,'Name'))],
3132		kernel_objects:equal_object(X,R))).
3133
3134		:- block range_restriction_wf(-,?,?,?),range_restriction_wf(?,-,-,?).
3135
3136		range_restriction_wf(R,S,Res,WF) :- /* R |> S */
3137	?	ok_to_try_restriction_explicit_set(S,R,Res),
3138	?	range_restriction_explicit_set_wf(R,S,SR,WF),!,
3139	?	equal_object_wf(SR,Res,range_restriction,WF).
3140		range_restriction_wf(R,S,Res,WF) :- /* R |> S */
3141		expand_custom_set_to_list_wf(R,ER,_,range_restriction,WF),
3142		relation_restriction_wf(ER,S,Res,pred_true,range,WF).
3143
3144		% heuristic: should we try restriction_explicit_set or
3145		% is relation_restriction with its stronger constraint propagation better
3146		ok_to_try_restriction_explicit_set(S,R,Res) :-
3147		nonvar(S),
3148		(var(Res) -> true
3149		; S=avl_set(_),
3150		nonvar(R), R=avl_set(_) % otherwise constraint propagation from normal relation_restriction better
3151		).
3152
3153		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:range_subtraction_wf([],[int(2)],[],WF),WF)).
3154		:- 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)).
3155		:- 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)).
3156		:- 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)).
3157
3158		:- block range_subtraction_wf(-,?,?,?),range_subtraction_wf(?,-,-,?).
3159		range_subtraction_wf(R,S,Res,WF) :- /* R |>> S */
3160		S==[],!,
3161		equal_object_wf(R,Res,range_subtraction1,WF).
3162		range_subtraction_wf(R,S,Res,WF) :- /* R |>> S */
3163		% print(range_subtraction(R,S,Res)),nl,debug:trace_in_debug_mode,
3164	?	ok_to_try_restriction_explicit_set(S,R,Res),
3165	?	range_subtraction_explicit_set_wf(R,S,SR,WF),!,
3166	?	equal_object_wf(SR,Res,range_subtraction2,WF).
3167		range_subtraction_wf(R,S,Res,WF) :- /* R |>> S */
3168		expand_custom_set_to_list_wf(R,ER,_,range_subtraction,WF),
3169		relation_restriction_wf(ER,S,Res,pred_false,range,WF).
3170
3171		:- 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)).
3172		:- 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)).
3173
3174		:- block in_range_restriction_wf(-,-,-,?).
3175		in_range_restriction_wf(Pair,Rel,Set,WF) :-
3176		(treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel)
3177		; preference(convert_comprehension_sets_into_closures,true)),
3178		% print_term_summary(symbolic_treatment_in_range_restriction_wf(Pair,Set,Rel,WF)),
3179		!,
3180		Rel \== [], % avoid setting up check_element_of for X then
3181		% x |-> y : Rel |>> Set <=> x|->y : Rel & y: Set
3182		check_element_of_wf(Pair,Rel,WF),
3183		Pair = (_,P2),
3184		check_element_of_wf(P2,Set,WF).
3185		in_range_restriction_wf(Pair,Rel,Set,WF) :-
3186		range_restriction_wf(Rel,Set,Res,WF),
3187		check_element_of_wf(Pair,Res,WF).
3188
3189		:- 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)).
3190		:- 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)).
3191
3192		:- block not_in_range_restriction_wf(-,-,-,?).
3193		not_in_range_restriction_wf(Pair,Rel,Set,WF) :-
3194		range_restriction_wf(Rel,Set,Res,WF),
3195		not_element_of_wf(Pair,Res,WF).
3196
3197		:- 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)).
3198		:- 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)).
3199
3200		:- block in_range_subtraction_wf(-,-,-,?).
3201		in_range_subtraction_wf(Pair,Rel,Set,WF) :-
3202		(treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel)
3203		; preference(convert_comprehension_sets_into_closures,true)),
3204		% print_term_summary(symbolic_treatment_in_range_subtraction_wf(Pair,Set,Rel,WF)),
3205		!,
3206		Rel \== [], % avoid setting up check_element_of for X then
3207		% x |-> y : Rel |>> Set <=> x|->y : Rel & y/: Set
3208		check_element_of_wf(Pair,Rel,WF),
3209		Pair = (_,P2),
3210		not_element_of_wf(P2,Set,WF).
3211		in_range_subtraction_wf(Pair,Rel,Set,WF) :-
3212		range_subtraction_wf(Rel,Set,Res,WF),
3213		check_element_of_wf(Pair,Res,WF).
3214
3215		:- 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)).
3216		:- 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)).
3217
3218		:- block not_in_range_subtraction_wf(-,-,-,?).
3219		not_in_range_subtraction_wf(Pair,Rel,Set,WF) :-
3220		range_subtraction_wf(Rel,Set,Res,WF),
3221		not_element_of_wf(Pair,Res,WF).
3222
3223
3224
3225		:- 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)).
3226		:- 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)).
3227
3228		:- block in_domain_restriction_wf(-,-,-,?).
3229		in_domain_restriction_wf(Pair,Set,Rel,WF) :-
3230		(treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel)
3231		; preference(convert_comprehension_sets_into_closures,true)),
3232		% print_term_summary(symbolic_treatment_in_domain_restriction_wf(Pair,Set,Rel,WF)),
3233		!,
3234		Rel \== [], % avoid setting up check_element_of for X then
3235		% x |-> y : Set <| Rel <=> x|->y : Rel & x: Set
3236		check_element_of_wf(Pair,Rel,WF),
3237		Pair = (P1,_),
3238		check_element_of_wf(P1,Set,WF).
3239		in_domain_restriction_wf(Pair,Set,Rel,WF) :-
3240		domain_restriction_wf(Set,Rel,Res,WF),
3241		check_element_of_wf(Pair,Res,WF).
3242
3243		:- 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)).
3244		:- 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)).
3245
3246		:- block not_in_domain_restriction_wf(-,-,-,?).
3247		not_in_domain_restriction_wf(Pair,Set,Rel,WF) :-
3248		domain_restriction_wf(Set,Rel,Res,WF),
3249		not_element_of_wf(Pair,Res,WF).
3250
3251		:- 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)).
3252		:- 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)).
3253		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_restriction_wf([int(2),int(3)],[],[],WF),WF)).
3254		:- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[],[],_WF))).
3255		:- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[],R,_WF), R==[])).
3256		:- assert_must_fail((bsets_clp:domain_restriction_wf(_,[],R,_WF), R=[int(_)|_])).
3257		:- assert_must_succeed((bsets_clp:domain_restriction_wf([int(2)],[(int(1),int(2))],[],_WF))).
3258		:- assert_must_succeed((bsets_clp:domain_restriction_wf([],[(int(1),int(2))],[],_WF))).
3259		:- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[(int(1),int(2))],[(int(1),int(2))],_WF))).
3260		:- assert_must_succeed((bsets_clp:domain_restriction_wf([int(1)],[(int(1),int(2)),(int(2),_)],_,_WF))).
3261		:- assert_must_succeed((bsets_clp:domain_restriction_wf([int(2),int(1)],X,R,_WF),
3262		X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],
3263		kernel_objects:equal_object(X,R))).
3264
3265
3266		:- block domain_restriction_wf(?,-,?,?),domain_restriction_wf(-,?,-,?).
3267		domain_restriction_wf(S,R,Res,WF) :- /* S <| R */
3268		%print_term_summary(domain_restriction(S,R,Res)),
3269		ok_to_try_restriction_explicit_set(S,R,Res),
3270		domain_restriction_explicit_set_wf(S,R,SR,WF),!,
3271		% print_term_summary(domain_restriction_explicit_set(S,R,SR)), %%
3272		equal_object_wf(SR,Res,domain_restriction,WF).
3273		domain_restriction_wf(S,R,Res,WF) :- /* S <| R */
3274		% print_term_summary(call_domain_restriction(S,R,Res)), translate:print_bvalue(S),nl,
3275		expand_custom_set_to_list_wf(R,ER,_,domain_restriction,WF),
3276		relation_restriction_wf(ER,S,Res,pred_true,domain,WF).
3277
3278		% a predicate to compute domain/range restriction/subtraction
3279		:- block relation_restriction_wf(?,-,- ,?,?,?),
3280		relation_restriction_wf(-,?,? ,?,?,?).
3281		relation_restriction_wf([],_S,Res,_AddWhen,_DomOrRange,WF) :-
3282		%print_term_summary(domain_restriction_finished([],_S,Res)),
3283		empty_set_wf(Res,WF).
3284		relation_restriction_wf([(X,Y)|T],S,Res,AddWhen,DomOrRange,WF) :-
3285	?	(DomOrRange=domain
3286		-> membership_test_wf(S,X,MemRes,WF) % TO DO: pass WF !
3287		; membership_test_wf(S,Y,MemRes,WF)),
3288	?	(nonvar(MemRes)
3289		%MemRes==AddWhen % MemRes already set; we will ensure that (X,Y) in Res below; this slows down Alstom Compilation Regle !
3290		% 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 ?
3291		-> true %,(MemRes==AddWhen -> true ; print_term_summary(relation_restriction([(X,Y)|T],S,Res,AddWhen,DomOrRange)),nl)
3292		; (AddWhen=pred_true -> InResult=MemRes
3293		; negate(InResult,MemRes)), % from bool_pred
3294		membership_test_wf(Res,(X,Y),InResult,WF)
3295		% TO DO: same for explicit version; gets called e.g. if S = 1..n (1..n <| [1,2,3] = [1,2])
3296		% can now solve e.g. {x|x <| [1,2,3] = [1,2] & card(x)=2} = {{1,2}}
3297		% or x <| s = [1,2,3] \/ {29|->29} & x <: 1..100 & s = %i.(i:1..50|i)
3298		),
3299		% print(restrict(X,Y,MemRes)),nl,
3300	?	relation_restriction_aux(MemRes,X,Y,T,S,Res,AddWhen,DomOrRange,WF).
3301		:- block relation_restriction_aux(-,?,?,?,?,?, ?,?,?).
3302		relation_restriction_aux(MemRes,X,Y,T,S,Res,AddWhen,DomOrRange,WF) :-
3303	?	MemRes==AddWhen,!, % (X,Y) should be added to result %print(add(X,Y)),nl,
3304		% TO DO: collect result until we delay ? and then do equal_object ?
3305		%print(eq_cons1(Res)),nl,print((X,Y)),nl,print(RT),nl,
3306	?	equal_cons(Res,(X,Y),RT), % was : equal_object([(X,Y)|RT],Res),
3307		%equal_cons_wf(Res,(X,Y),RT,WF), % makes tests 982, 1302, 1303 fail; TO DO: investigate
3308		%print(eq_cons2(Res)),nl,print((X,Y)),nl,print(RT),nl,
3309		%when(nonvar(RT), % causes problem for test 982
3310	?	relation_restriction_wf(T,S,RT,AddWhen,DomOrRange,WF).
3311		relation_restriction_aux(_MemRes,_X,_,T,S,RT,AddWhen,DomOrRange,WF) :-
3312		% the couple is filtered out %print(filter(_X)),nl,
3313	?	relation_restriction_wf(T,S,RT,AddWhen,DomOrRange,WF).
3314
3315
3316		:- 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)).
3317		:- 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)).
3318		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_subtraction_wf([int(1)],[],[],WF),WF)).
3319		:- assert_must_succeed(exhaustive_kernel_check_wf(bsets_clp:domain_subtraction_wf([],[(int(11),int(21))],[(int(11),int(21))],WF),WF)).
3320		:- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(1)],[(int(1),int(2))],[],_WF))).
3321		:- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(3)],[(int(1),int(2))],[(int(1),int(2))],_WF))).
3322		:- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(1)],[(int(1),int(2)),(int(2),int(X))],R,_WF),
3323		R=[(int(2),int(YY))], YY==X)).
3324		:- assert_must_succeed((bsets_clp:domain_subtraction_wf([int(5),int(3)],X,R,_WF),
3325		X = [(int(1),fd(3,'Name')),(int(2),fd(3,'Name'))],
3326		kernel_objects:equal_object(X,R))).
3327		:- block domain_subtraction_wf(?,-,?,?),domain_subtraction_wf(-,?,-,?).
3328		%domain_subtraction(S,R,Res) :- /* S <<| R */
3329		% is_custom_explicit_set(R), nonvar(S),
3330		% fail.
3331		domain_subtraction_wf(S,R,Res,WF) :- S==[],!,
3332		equal_object_wf(R,Res,domain_subtraction1,WF).
3333		domain_subtraction_wf(S,R,Res,WF) :- /* S <<| R */
3334		ok_to_try_restriction_explicit_set(S,R,Res),
3335		domain_subtraction_explicit_set_wf(S,R,SR,WF),!,
3336		equal_object_wf(SR,Res,domain_subtraction2,WF).
3337		domain_subtraction_wf(S,R,Res,WF) :- /* S <<| R */
3338		%print_message(dom_sub(S,R,Res)),
3339		expand_custom_set_to_list_wf(R,ER,_,domain_subtraction,WF),
3340		try_expand_and_convert_to_avl_with_check(S,AS,domain_subtraction),
3341		% print_term_summary(dom_sub2(ER,AS,Res)),
3342		% (ground(ER) -> domain_subtraction_acc(ER,AS,[],Res) ;
3343		relation_restriction_wf(ER,AS,Res,pred_false,domain,WF)
3344		% )
3345		.
3346
3347
3348
3349		:- 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)).
3350		:- 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)).
3351
3352		:- block in_domain_subtraction_wf(-,-,-,?).
3353
3354		in_domain_subtraction_wf(Pair,Set,Rel,WF) :-
3355		(treat_arg_symbolically(Set) ; treat_arg_symbolically(Rel)
3356		; preference(convert_comprehension_sets_into_closures,true)),
3357		% print_term_summary(symbolic_treatment_in_domain_subtraction_wf(Pair,Set,Rel,WF)),
3358		!,
3359		Rel \== [], % avoid setting up check_element_of for X then
3360		% x |-> y : Set <<| Rel <=> x|->y : Rel & x/: Set
3361		check_element_of_wf(Pair,Rel,WF),
3362		Pair = (P1,_),
3363		not_element_of_wf(P1,Set,WF).
3364		in_domain_subtraction_wf(Pair,Set,Rel,WF) :-
3365		domain_subtraction_wf(Set,Rel,Res,WF),
3366		check_element_of_wf(Pair,Res,WF).
3367
3368
3369		:- 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)).
3370		:- 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)).
3371
3372		:- block not_in_domain_subtraction_wf(-,-,-,?).
3373		not_in_domain_subtraction_wf(Pair,Set,Rel,WF) :-
3374		domain_subtraction_wf(Set,Rel,Res,WF),
3375		not_element_of_wf(Pair,Res,WF).
3376
3377		% similar to kernel_objects, but adds case for [_|_]
3378		treat_arg_symbolically(X) :- var(X),!.
3379		treat_arg_symbolically([H|T]) :- \+ ground(H) ; treat_arg_symbolically(T).
3380		treat_arg_symbolically(global_set(_)).
3381		treat_arg_symbolically(freetype(_)).
3382		treat_arg_symbolically(closure(P,T,B)) :- \+ kernel_objects:small_interval(P,T,B).
3383
3384		:- 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)).
3385		:- 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)).
3386		:- assert_must_succeed((bsets_clp:override_relation([(int(1),int(2)),(int(2),int(4))],[(int(1),int(3))],X,_WF),
3387		kernel_objects:equal_object(X,[(int(2),int(4)),(int(1),int(3))]))).
3388		:- assert_must_succeed((bsets_clp:override_relation([(int(1),int(2)),(int(2),int(4))],[(int(3),int(6))],X,_WF),
3389		kernel_objects:equal_object(X,[(int(2),int(4)),(int(1),int(2)),(int(3),int(6))]))).
3390
3391		:- block override_relation(-,-,?,?).
3392		override_relation(R,S,Res,WF) :- R==[],!, equal_object_wf(S,Res,override_relation1,WF).
3393		override_relation(R,S,Res,WF) :- S==[],!, equal_object_wf(R,Res,override_relation2,WF).
3394		override_relation(R,S,Res,WF) :- Res==[],!, empty_set_wf(S,WF), empty_set_wf(R,WF).
3395		override_relation(R,S,Res,WF) :- /* R <+ S */
3396		% print_term_summary(override_relation(R,S,Res,_WF)),nl,
3397		override_custom_explicit_set_wf(R,S,ORes,WF),!,
3398		% print_term_summary(override_custom_explicit_set_wf(R,S,ORes,WF)),
3399		equal_object_wf(ORes,Res,override_relation3,WF).
3400		override_relation(R,S,Res,WF) :- /* R <+ S */
3401		% print('override_relation: '), translate:print_bvalue(S),nl,
3402		/* TO DO: first check if S is empty */
3403		% print(override__enter_domain(S,DS)),nl,
3404		domain_wf(S,DS,WF),
3405		% when(ground(DS), (print(override_domain(DS)),nl)),
3406		% print_term_summary(override__exit__domain(S,DS)),nl,
3407		% print_term_summary(override__enter_domain_subtraction(DS,R,DSR)),
3408		domain_subtraction_wf(DS,R,DSR,WF),
3409		% print(override__exit_domain_subtraction(DS,R,DSR)),nl,
3410		% when(ground(DSR), (print(override_domain_subtraction(DSR)),nl)),
3411		% print(calling_union(DSR,S,Res)),nl,
3412		union_wf(DSR,S,Res,WF). % ,print(done_union(DSR,S,Res)),nl,trace.
3413		% , print_term_summary(override__exit_union(DSR,S,Res)),nl.
3414		% when(ground(Res), (print(override_UNION_RESULT(R,S,Res)),nl)).
3415
3416		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:override([],int(1),int(3),[(int(1),int(3))],WF),WF)).
3417		:- 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)).
3418		:- 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)).
3419		:- block override(-,?,?,?,?), override(?,-,?,?,?),
3420		override(?,?,-,?,?). % also wait on Y; try to generate avl if possible; can only be used in substitution anyway
3421		/* R <+ {X |-> Y} as used by substitution R(X) := Y */
3422		override(R,X,Y,Res,WF) :- % print_term_summary(override(R,X,Y,Res)),
3423		override_pair_explicit_set(R,X,Y,ORes),!,
3424		%% print_term_summary(override_pair_explicit_set(R,X,Y,ORes)), %%
3425		equal_object_wf(ORes,Res,override1,WF).
3426		override(R,X,Y,Res,WF) :-
3427		if(try_expand_custom_set_to_list(R,ER,_,override),
3428		( %print_term_summary(override2(ER,X,Y)),
3429		override2(ER,X,Y,[(X,Y)],ORes,WF),
3430		equal_object_wf(ORes,Res,override2,WF)),
3431		( %print_term_summary(exception(R)), % Virtual Timeout exception occured
3432		override_relation(R,[(X,Y)],Res,WF)
3433		)).
3434
3435		:- block override2(-,?,?,?,?,?).
3436		override2([],_X,_Y,Remainder,Res,WF) :- equal_object_optimized_wf(Remainder,Res,override2,WF). %equal_object(Remainder,Res).
3437		override2([(V,W)|T],X,Y,Remainder,Res,WF) :-
3438		equality_objects_wf(V,X,EqRes,WF),
3439		override2c(EqRes,V,W,T,X,Y,Remainder,Res,WF).
3440
3441		:- block override2c(-, ?,?,?, ?,?,?,?,?).
3442		override2c(pred_true,_V,_W,T,X,Y,_Remainder,Res,WF) :-
3443		equal_cons_wf(Res,(X,Y),T2,WF),
3444		override2(T,X,Y,[],T2,WF). /* set remainder to [], we have already added (X,Y) */
3445		override2c(pred_false,V,W,T,X,Y,Remainder,Res,WF) :-
3446		equal_cons_wf(Res,(V,W),T2,WF),
3447		override2(T,X,Y,Remainder,T2,WF).
3448
3449
3450
3451		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[int(2)],WF),WF)).
3452		:- 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)).
3453		:- 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)).
3454		:- 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)).
3455		:- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[int(2)],_WF)).
3456		:- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2))],[int(2)],[],_WF)).
3457		:- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2))],[int(3)],[],_WF)).
3458		:- assert_must_succeed((bsets_clp:image_wf([(int(1),int(2)),(int(1),int(3))],
3459		[int(X)],R,_WF), X=1, kernel_objects:equal_object(R,[int(2),int(3)]))).
3460		:- assert_must_succeed((bsets_clp:image_wf([([int(1),int(2)],int(6)),
3461		([int(1),int(2),int(3)],int(7)),
3462		([int(2),int(1)],int(8))],
3463		[[int(X),int(1)]],R,_WF), X=2,
3464		kernel_objects:equal_object(R,[int(6),int(8)]))).
3465		:- assert_must_succeed(bsets_clp:image_wf([(int(1),int(2)),(int(2),int(2))],[int(1),int(2)],[int(2)],_WF)).
3466		:- assert_must_fail(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[int(1)],_WF)).
3467		:- assert_must_fail(bsets_clp:image_wf([(int(1),int(2))],[int(1)],[],_WF)).
3468
3469
3470		:- block image_wf(-,?,?,?).
3471		image_wf(Rel,_,Res,WF) :- Rel==[],!,empty_set_wf(Res,WF).
3472		image_wf(Rel,S,Res,WF) :- image_for_id_closure(Rel,S,Img),!, % we don't require S to be known here
3473		% print(image_for_id(Rel,S,Img)),nl,
3474		equal_object_wf(Img,Res,image_wf_id_closure,WF). %, print_term_summary(image_for_id(Rel,S,Res)).
3475		image_wf(Rel,S,Res,WF) :- %print_term_summary(image_wf(Rel,S,Res)),
3476		image_wf0(Rel,S,Res,WF).
3477
3478		:- block image_wf0(?,-,?,?).
3479		image_wf0(Rel,S,Res,WF) :- /* Res = Rel[S] */
3480		% nl,print_term_summary(image_wf0(Rel,S,Res)),nl,
3481		% print(image(Rel,S,Res,WF)),nl,
3482	?	(S==[] -> empty_set_wf(Res,WF)
3483	?	; image1(Rel,S,Res,WF) ) . %,print(done_image(Rel,S,Res)),nl. %,watch(Rel,arg1_of_image,0).
3484
3485		keep_symbolic(R) :- var(R),!,fail.
3486		keep_symbolic(closure(_,_,_)) :- preferences:get_preference(convert_comprehension_sets_into_closures,true),!.
3487		keep_symbolic(R) :- dont_expand_this_explicit_set(R).
3488
3489		:- block image1(-,?,?,?).
3490		image1(Rel,S,Res,WF) :- %print_term_summary(image1(Rel,S,Res)),
3491	?	image_for_explicit_set(Rel,S,Img,WF),!, % print(image_explicit(Img)),nl,
3492	?	equal_object_wf(Img,Res,image1_1,WF),
3493		quick_propagate_subset_range(Res,Rel,WF).
3494		%image1(Rel,S,Res,WF) :- expand_custom_set_to_list(S,ES),!, image_of_set(ES,Rel,Res,WF).
3495		image1(Rel,Set,Res,WF) :- %print(rel(Rel,Set)),nl,
3496		keep_symbolic(Rel), %print(don_expand_this),nl,
3497		(preferences:get_preference(convert_comprehension_sets_into_closures,true), % in this case keep_symbolic is always true
3498		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
3499		-> debug_println(9,infinite_for_image1(Set)),
3500		fail
3501		; true),
3502		( dom_for_specific_closure(Rel,Domain,function(_))
3503		% print(image_for_inf_fun(Rel,Set)),nl,
3504		-> !, expand_custom_set_to_list_wf(Set,ESet,_,image1,WF), % TO DO: what if keep_symbolic(Set)
3505		image_for_inf_fun(ESet,Domain,Rel,[],Res,WF)
3506		; get_relation_types(Rel,DomType,RangeType),!,
3507		%% print_term_summary(image_for_large_relation(DomType,RangeType,Set,Rel)),translate:print_bvalue(Set),nl,
3508		expand_custom_set_to_list_wf(Set,ESet,_,image1_2,WF),
3509		kernel_tools:ground_value_check(Rel,GRel),
3510		when(nonvar(GRel), image_for_large_relation(ESet,Rel,DomType,RangeType,[],Res,WF))
3511		/* ; get_relation_types(Rel,DomType,RangeType),!,
3512		% Rel should not be expanded, compute closure by calculating {yy|#(xx).(xx:Set & xx|->yy:Rel)}
3513		print_term_summary(image_for_large_relation(DomType,RangeType,Set,Rel)),nl,
3514		image_closure(Set,Rel,DomType,RangeType,Closure ),
3515		translate:print_bvalue(Closure),nl,
3516		expand_custom_set(Closure,CRes), print(expanded),nl,
3517		equal_object(CRes,Res,image1_2) */
3518		).
3519		image1(Rel,S,Res,WF) :-
3520		%((custom_explicit_sets:quick_custom_explicit_set_approximate_size(Rel,S), S>1000) -> print(image_for_large_relation(S)),nl ; true),
3521		expand_custom_set_to_list_wf(Rel,Relation,_,image1_2,WF), % bad if Rel is a big closure !
3522		% print(image2(Rel,Relation,S,Res)),nl,
3523		% image_for_list_relation(Relation,S,Res).
3524		propagate_singleton_image(Relation,S,Res,WF),
3525		image_for_list_relation(Relation,S,[],Res,WF). %,print_term_summary(image2_res(Relation,S,Res)).
3526
3527		% propagate that f[{x}] = {r1,...,rk} => x|->ri : f (or {x}*{r1,...,rk} <: f); see test 1532
3528		propagate_singleton_image(R,S,Res,_) :-
3529	?	(var(S) ; var(Res) ; nonvar(R), is_custom_explicit_set(R,psi)), !.
3530		propagate_singleton_image(Relation,S,avl_set(Res),WF) :-
3531		custom_explicit_sets:singleton_set(S,El), % we have the image by a singleton set {El}
3532		expand_custom_set_to_list_wf(avl_set(Res),LR,_,prop_singleton,WF),
3533		!,
3534		%print_term_summary(prop(LR,El,Relation)),nl,
3535		l_check_element_of(LR, El, Relation, WF). % propagate x|->ri : f (will force membership)
3536		propagate_singleton_image(_,_,_,_).
3537
3538		l_check_element_of([],_,_,_).
3539		l_check_element_of([H|T],El,Relation,WF) :-
3540		check_element_of_wf((El,H),Relation,WF),
3541		l_check_element_of(T,El,Relation,WF).
3542
3543		% quick_propagate_in_range(Set, Relation,WF) : propagate that Set <: ran(Relation)
3544		:- block quick_propagate_subset_range(-,?,?).
3545		quick_propagate_subset_range(avl_set(_),_,_) :- !.
3546		quick_propagate_subset_range([],_,_) :- !.
3547		quick_propagate_subset_range([H|T],Relation,WF) :- is_custom_explicit_set(Relation,range_wf1),
3548		range_of_explicit_set(Relation,Range), !,
3549		quick_propagation_element_information(Range,H,WF,NewRange),
3550		quick_propagate_subset_range2(T,NewRange,WF).
3551		quick_propagate_subset_range(_,_,_).
3552
3553		:- block quick_propagate_subset_range2(-,?,?).
3554		quick_propagate_subset_range2([H|T],NewRange,WF) :- !,
3555		quick_propagation_element_information(NewRange,H,WF,NewRange1),
3556		quick_propagate_subset_range2(T,NewRange1,WF).
3557		quick_propagate_subset_range2(_,_,_).
3558
3559		:- use_module(btypechecker, [unify_types_strict/2]).
3560		get_relation_types(Value,Domain,Range) :-
3561		kernel_objects:infer_value_type(Value,VT),
3562		unify_types_strict(VT,set(couple(Domain,Range))). % deal also with seq types
3563		% VT=set(couple(Domain,Range)).
3564
3565		:- block image_for_large_relation(-,?,?,?,?,?,?), image_for_large_relation(?,?,?,?,-,?,?).
3566		image_for_large_relation([],_,_,_,Acc,Res,WF) :- equal_object_wf(Acc,Res,WF).
3567		image_for_large_relation([XX|T],Rel,DomType,RangeType,Acc,Res,WF) :-
3568		%print_term_summary(computing_image(XX,Acc)),nl,
3569		Body = b(member(b(couple(b(value(XX),DomType,[]),
3570		b(identifier(yy),RangeType,[])),couple(DomType,RangeType),[]),
3571		b(value(Rel),set(couple(DomType,RangeType)),[])),pred,[]),
3572		% TO DO: simplify above if we have Rel = closure(P,T,B); which we usually will
3573		custom_explicit_sets:expand_normal_closure_direct([yy],[RangeType],Body,HRes,_Done,WF), % do not memoize this (many different values)
3574		union_wf(Acc,HRes,NewAcc,WF),
3575		(T == [] -> equal_object_wf(NewAcc,Res,WF)
3576		; image_for_large_relation(T,Rel,DomType,RangeType,NewAcc,Res,WF)).
3577
3578		/* no longer used
3579		% construct a closure for {yy|#(xx).(xx:Set & xx|->yy:Rel)}
3580		image_closure(Set,Rel,DomType,RangeType,Closure ) :- custom_explicit_sets:singleton_set(Set,XX),!,
3581		% do not set up existential quantifier if Set is singleton set
3582		Closure = closure([yy],[RangeType],Body),
3583		Body = b(member(b(couple(b(value(XX),DomType,[]),
3584		b(identifier(yy),RangeType,[])),couple(DomType,RangeType),[]),
3585		b(value(Rel),set(couple(DomType,RangeType)),[])),pred,[]).
3586		image_closure(Set,Rel,DomType,RangeType,Closure ) :-
3587		Closure = closure([yy],[RangeType],Body),
3588		couple_member_pred(xx,DomType,yy,RangeType,Rel, Predxxyy),
3589		Body = b(exists([b(identifier(xx),DomType,[])],
3590		b(conjunct(
3591		b(member(b(identifier(xx),DomType,[]),b(value(Set),set(DomType),[])),pred,[]), % TO DO : force evaluation !
3592		Predxxyy),
3593		pred,[])),pred,[used_ids([yy])]).
3594		*/
3595
3596		% very similar to rel_compose_with_inf_fun, indeed f[S] = ran((id(S);f))
3597		:- block image_for_inf_fun(-,?,?,?,?,?).
3598	?	image_for_inf_fun([],_Dom,_Rel2,Acc,Comp,WF) :- equal_object_wf(Acc,Comp,WF).
3599		image_for_inf_fun([X|T],Dom,Fun,Acc,CompRes,WF) :-
3600		membership_test_wf(Dom,X,MemRes,WF),
3601		image_for_inf_fun_aux(MemRes,X,T,Dom,Fun,Acc,CompRes,WF).
3602
3603		:- block image_for_inf_fun_aux(-,?,?, ?,?,?,?,?).
3604		image_for_inf_fun_aux(pred_true,X,T,Dom,Fun,Acc,CompRes,WF) :-
3605		% print_term_summary(image_for_inf_fun_aux(pred_true,X,T,Dom,Fun,CompRes,WF)),
3606	?	apply_to(Fun,X,FX,WF), % TO DO: generalize to image so that we can apply it also to infinite relations ?
3607		%hashing:my_term_hash(FX,Hash), (Hash=353256514437402551 -> trace ; Hash=340015815059493514 -> trace ; true),
3608	?	add_element_wf(FX,Acc,NewAcc,WF), % will block until Acc Known !!
3609		% (Acc==NewAcc -> true ; translate:print_bvalue(NewAcc),nl), %, print(add(Hash,FX)),nl,nl),
3610		% TO DO USE: equal_cons_wf(CompRes,FX,CT,WF) + accumulator !,
3611	?	image_for_inf_fun(T,Dom,Fun,NewAcc,CompRes,WF).
3612		image_for_inf_fun_aux(pred_false,_X,T,Dom,Fun,Acc,Comp,WF) :-
3613		% print(image_for_inf_fun_aux_not_in_domain(_X)),nl,
3614		image_for_inf_fun(T,Dom,Fun,Acc,Comp,WF).
3615
3616
3617		/*
3618		:- block image_of_set(-,?,?,?,?), image_of_set(?,?,-,?,?).
3619		image_of_set([],Rel,ImageSoFar,Res,WF) :- equal_object(ImageSoFar,Res).
3620		image_of_set([H|T],Rel,ImageSoFar,Res,WF) :-
3621		image_of_element(Rel,H,ImageSoFar,SF2,WF),
3622		image_of_set(T,Rel,SF2,Res,WF).
3623
3624		image_of_element([],_,Acc,Res,WF) :- equal_object(Acc,Res).
3625		image_of_element([(A,B)|T],H,Acc,Res,WF) :- equality....
3626		image_of_element(avl_set(),H,Acc,Res,WF) :- ....
3627		image_of_element(closure(),....
3628		*/
3629
3630		% Computing the image of a relation which is stored as a list: traverse the relation
3631		:- block image_for_list_relation(-,?,?,?,?).
3632		image_for_list_relation([],_,_,Res,WF) :- empty_set_wf(Res,WF).
3633		image_for_list_relation([(X,Y)|T],S,ImageSoFar,Res,WF) :- % prints(image(X,Y,T,ImageSoFar)),trace,
3634		%print_term_summary(image_for_list_relation(X,Y,T,S,ImageSoFar,Res,WF)),nl,
3635		((T==[], definitely_not_empty(Res))
3636		-> MemRes=pred_true, % we need at least one more element for Res
3637		check_element_of_wf(X,S,WF)
3638		; (Res==[],ImageSoFar==[]) -> MemRes=pred_false, not_element_of_wf(X,S,WF) % Result empty: X cannot be in S
3639		; membership_test_wf(S,X,MemRes,WF)
3640		),
3641		image4(MemRes,Y,T,S,ImageSoFar,Res,WF).
3642
3643		definitely_not_empty(Set) :- nonvar(Set), Set \== [], \+ functor(Set,closure,3). % Set \= closure(_,_,_).
3644
3645		:- block image4(-, ?,?,?, ?,?,?).
3646		image4(pred_true, Y,T,S, ImageSoFar,Res,WF) :-
3647		(Res==[]
3648		-> MemRes=pred_true, check_element_of_wf(Y,ImageSoFar,WF)
3649		; membership_test_wf(ImageSoFar,Y,MemRes,WF)
3650		),
3651		image5(MemRes,Y,T,S,ImageSoFar,Res,WF).
3652		image4(pred_false, _Y,T,S, ImageSoFar,Res,WF) :-
3653		image_for_list_relation(T,S,ImageSoFar,Res,WF).
3654
3655		:- block image5(-, ?,?,? ,?,?,?).
3656		image5(pred_true,_Y,T,S,ImageSoFar,Res,WF) :- /* we have already added Y to the image */
3657		image_for_list_relation(T,S,ImageSoFar,Res,WF).
3658		image5(pred_false,Y,T,S,ImageSoFar,Res,WF) :- %print(add_to_image_sofar(Y,ImageSoFar)),nl,
3659		add_element_wf(Y,ImageSoFar,ImageSoFar2,WF), %print(adding_y_to_image_result(Y,Res)),nl,
3660		kernel_objects:mark_as_non_free(Y), % has been added to image, no longer freely choosable
3661		equal_cons_wf(Res,Y,Res2,WF), %print(added(Y,Res)),nl,
3662		image_for_list_relation(T,S,ImageSoFar2,Res2,WF).
3663
3664
3665
3666		:- 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)).
3667		:- 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)).
3668		:- 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)).
3669		% first experimental version for computing closure1(Rel)[S]
3670		:- block image_for_closure1_wf(-,?,?,?),image_for_closure1_wf(?,-,?,?).
3671	?	image_for_closure1_wf(Rel,S,Res,WF) :- (Rel==[] ; S==[]),!,empty_set_wf(Res,WF).
3672	?	image_for_closure1_wf(Rel,Set,Res,WF) :- try_expand_and_convert_to_avl_unless_large(Set,ESet),
3673	?	image_for_closure1_wf_aux(Rel,ESet,Res,WF).
3674
3675		:- use_module(library(avl),[avl_height/2]).
3676		image_for_closure1_wf_aux(Rel,S,Res,WF) :- % print_term_summary(image_for_closure1_wf_aux(Rel,S,Res,WF)),nl,
3677		((nonvar(S),S=avl_set(_))
3678		-> closure1_for_explicit_set_from(Rel,S,Closure1Rel),!, % if S is known: start from S (currently only deals with Rel=avl_set(_)
3679		% print_term_summary(closure1_from(Rel,S,Closure1Rel,Res)),nl,
3680		range_wf(Closure1Rel,Res,WF)
3681		; Rel=avl_set(AR), avl_height(AR,AR_Height),
3682		((set_smaller_than(S,4),AR_Height>4)
3683		-> !, % TO DO: we could do the same for small S if Rel is large
3684		% print_term_summary(clo1(Rel)),nl,
3685		when(ground(S), (expand_and_convert_to_avl_set(S,ES) ->
3686		closure1_for_explicit_set_from(Rel,avl_set(ES),Closure1Rel),
3687		range_wf(Closure1Rel,Res,WF)
3688		; image_for_closure1_iterate(Rel,S,[],Res,WF,first_iteration(S))
3689		))
3690		; % print_term_summary(clo1(Rel)),nl,
3691		% Don't do this if avl_height too large; then it is probably better to compute the image for S only
3692		AR_Height < 13, % how big should we make this magic constant; or should we time-out ? 2^14=16384
3693		closure1_for_explicit_set(Rel,Closure1Rel),!, % we can compute it effiently; don't use code below
3694		%print_term_summary(clo1_res(Closure1Rel,S,Res)),nl,
3695		image_wf(Closure1Rel,S,Res,WF)
3696		)
3697		).
3698		image_for_closure1_wf_aux(Rel,S,Res,WF) :-
3699		%when(nonvar(Res),(print(inst(Res,for(S))),nl,trace)),
3700		% print_term_summary(image_for_closure1_iterate(Rel,S,[],Res,WF)),debug:nl_time,
3701	?	propagate_result_in_range(Rel,S,Res,WF),
3702	?	image_for_closure1_iterate(Rel,S,[],Res,WF,first_iteration(S)). % , print_term_summary(done(Res)),debug:nl_time.
3703
3704		% no need to treat avl_sets; already covered as special case above
3705		set_smaller_than([],_).
3706		set_smaller_than([_|T],N) :- N>1, nonvar(T), N1 is N-1, set_smaller_than(T,N1).
3707
3708		image_for_closure1_iterate(Rel,S,Acc,Res,WF,FIRST) :-
3709		% print_term_summary(image_wf0(Rel,S,Acc,Res,WF)),debug:nl_time,
3710	?	image_wf0(Rel,S,Res1,WF),
3711		% print_term_summary(done_image_wf0(Res1)),debug:nl_time,nl,
3712	?	ground_value_check(Res1,RV),
3713	?	image_for_closure1_check_fix(RV,Rel,Acc,Res1,Res,WF,FIRST).
3714
3715		:- block image_for_closure1_check_fix(-,?,?,?,?,?,?).
3716		image_for_closure1_check_fix(_,Rel,Acc,Res1,Res,WF,FIRST) :-
3717		%try_expand_and_convert_to_avl_unless_large(Res1,ERes1),
3718	?	difference_set(Res1,Acc,New),
3719	?	try_expand_and_convert_to_avl(New,ENew), % we compute difference_set below; we most definitely will need an explicit finite representation
3720		% print_term_summary(new(ENew)),debug:nl_time,
3721	?	(not_empty_set_wf(ENew,WF),
3722	?	union(ENew,Acc,Acc1), % Note: we do not call union_wf - should we do this
3723		% upon first iteration remove also S from New -> New2 and pass New2 to image_for_closure1_iterate
3724		% TO DO: investigate whether this also makes sense for further iterations; always remove S
3725	?	(FIRST=first_iteration(S) -> difference_set(ENew,S,New2) ; New2=ENew),
3726	?	image_for_closure1_iterate(Rel,New2,Acc1,Res,WF,not_first)
3727		;
3728	?	empty_set_wf(ENew,WF),equal_object_optimized_wf(Acc,Res,image_for_closure1_check_fix,WF)).
3729
3730		% propagate information that if closure1(Rel)[.] = Res => Res <: range(Rel)
3731		% x: 1..n --> 1..n & closure1(x)[{1}] = {} & n=100
3732		:- block propagate_result_in_range(?,?,-,?).
3733		propagate_result_in_range(Rel,_S,_Res,_WF) :- %print(propagate_result_in_range(Rel,_S,_Res,_WF)),nl,
3734		ground_value(Rel),!. % no propagation required
3735		propagate_result_in_range(Rel,S,[],WF) :- !,
3736		domain_wf(Rel,Domain,WF), %print(not_in_domain(S,Domain)),nl,trace,
3737		not_subset_of_wf(S,Domain,WF).
3738		propagate_result_in_range(Rel,_,Res,WF) :-
3739		range_wf(Rel,Range,WF),
3740		check_subset_of_wf(Res,Range,WF).
3741
3742		% -----------------------------------
3743
3744		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:apply_to([(int(2),int(22))],int(2),int(22),WF),WF)).
3745		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:apply_to([(int(1),int(22)),(int(3),int(33)),(int(4),int(44))],int(3),int(33),WF),WF)).
3746		:- assert_must_succeed(exhaustive_kernel_check_wfdet(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)).
3747		:- assert_must_succeed(bsets_clp:apply_to([(int(1),int(2))],int(1),int(2),_WF)).
3748		:- assert_must_succeed((bsets_clp:apply_to(F,int(3),int(2),_WF),F=[(int(3),int(2)),(int(2),int(1))])).
3749		:- assert_must_succeed((bsets_clp:apply_to(F,X,int(1),_WF),F=[(int(3),int(2)),(int(2),int(1))],X=int(2))).
3750		:- assert_must_succeed((bsets_clp:apply_to(F,int(3),_,_WF),F=[(int(3),[int(2),int(3)]),(int(2),[])])).
3751
3752		:- assert_must_fail(bsets_clp:apply_to([(int(1),int(2)),(int(1),int(3))],int(1),int(3),_WF)).
3753		/* input not a function */
3754		apply_to(R,X,Y,WF) :- apply_to(R,X,Y,unknown,unknown,WF).
3755		apply_to(R,X,Y,Span,WF) :- apply_to(R,X,Y,unknown,Span,WF).
3756
3757		:- block apply_to(-,-,-,?,?,?).
3758		apply_to(R,X,Y,_FunctionType,Span,WF) :-
3759		(\+ preferences:preference(find_abort_values,false) ; preference(data_validation_mode,true)),
3760		!,
3761		apply_to_var_block_abort(R,X,Y,R,Span,WF). % we have to know R before we can do anything
3762		apply_to(R,X,Y,FunctionType,Span,WF) :-
3763	?	(var(R),var(X) -> force_in_domain_wf(X,R,WF) ; true),
3764	?	apply_to1(R,X,Y,R,FunctionType,Span,WF).
3765
3766		force_in_domain_wf(El,S,WF) :-
3767		(preferences:preference(use_smt_mode,true) -> S=[(El,_)|_]
3768		; get_enumeration_starting_wait_flag(not_empty_domain_wf,WF,LWF), in_domain_lwf(El,S,LWF,WF)).
3769
3770		:- use_module(preferences,[preference/2]).
3771		:- use_module(clpfd_tables,[can_translate_function_to_element_constraint/2,check_apply_with_element_constraint/5]).
3772		:- block apply_to1(-,-,?,?,?,?,?).
3773		apply_to1(R,X,Y,InitialRel,FunctionType,Span,WF) :- % prints(apply2(R,X,Y,InitialRel,WF)),
3774	?	(var(R) -> apply_to_var(R,X,Y,InitialRel,Span,WF)
3775	?	; R\=[],can_translate_function_to_element_constraint(R,FunctionType) ->
3776		check_apply_with_element_constraint(R,X,Y,FunctionType,WF)
3777	?	; apply_to_nonvar(R,X,Y,InitialRel,Span,WF),
3778		propagate_range_membership(R,Y)
3779		).
3780		:- block apply_to2(-,-,?,?,?,?).
3781		apply_to2(R,X,Y,InitialRel,Span,WF) :- % prints(apply2(R,X,Y,InitialRel,WF)),
3782		(var(R) -> apply_to_var(R,X,Y,InitialRel,Span,WF)
3783		; apply_to_nonvar(R,X,Y,InitialRel,Span,WF)
3784		).
3785
3786		:- use_module(clpfd_lists,[get_finite_fdset_information/2,combine_fdset_information/3,
3787		assert_fdset_information/2,get_fdset_information/2]).
3788		% tested in test 1478; initially slows down NQueens
3789		%:- block propagate_range_membership(-,?). % not necessary
3790		propagate_range_membership([(_,RanEl)|T],X) :- nonvar(RanEl),
3791		preferences:preference(use_clpfd_solver,true),
3792		% preferences:preference(use_smt_mode,true),
3793		preferences:preference(find_abort_values,false),
3794		get_finite_fdset_information(RanEl,Info), % TO DO: try and detect if we can apply element/3 from clpfd
3795		\+ ground(X),
3796		get_fdset_information(X,InfoX),
3797		%print(start(Info,X,InfoX)),nl,
3798		Info \= InfoX, % avoids NQueens slowdown; TO DO: check if more precise than InfoX; otherwise no use in collecting info
3799		!,
3800		propagate_range_membership(T,Info,X).
3801		propagate_range_membership(_,_).
3802		:- block propagate_range_membership(-,?,?).
3803		propagate_range_membership([],Info,El) :- !,
3804		% 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 ??
3805		% print(mem_propagate(Info,El)),nl,
3806		assert_fdset_information(Info,El). %, tools_printing:print_arg(El),nl.
3807		propagate_range_membership([(_,RanEl)|T],Acc,X) :-
3808		nonvar(RanEl), % otherwise we have no info: we may just as well stop
3809		get_finite_fdset_information(RanEl,RInfo),
3810		combine_fdset_information(Acc,RInfo,NewAcc),
3811		NewAcc \= no_fdset_info,
3812		!,
3813		propagate_range_membership(T,NewAcc,X).
3814		propagate_range_membership(_,_,_).
3815
3816
3817
3818		apply_to_var(R,X,Y,InitialRel,Span,WF) :-
3819		%get_wait_flag(1.0,apply_to_var,WF,WF1), % see tests 1393, 1562??
3820		get_wait_flag0(WF,WF1),
3821		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 ??)
3822		(var(R) -> % print(instantiate(R,X,Y,InitialRel,WF1,WF)),nl,
3823		R=[(X,Y)|Tail],
3824		optional_functionality_check(Tail,X,WF)
3825		; apply_to_nonvar(R,X,Y,InitialRel,Span,WF))).
3826
3827
3828		:- block apply_to_var_block_abort(-,?,?,?,?,?).
3829		apply_to_var_block_abort(R,X,Y,InitialRel,Span,WF) :-
3830		apply_to_nonvar(R,X,Y,InitialRel,Span,WF).
3831		%apply_to_var_block_abort([(X,Y)|_],X,Y,_,_,_).
3832		%apply_to_var_block_abort(R,X,_Y,InitialRel,Span,WF) :-
3833		% not_in_domain_wf(X,R,WF),
3834		% kernel_tools:ground_value_check(R,RV),
3835		% when((ground(X),nonvar(RV)),
3836		% add_wd_error_span('function applied outside of domain (#1): ', '@fun'(X,InitialRel),Span,WF)).
3837
3838		optional_functionality_check(Tail,X,WF) :-
3839		preferences:preference(disprover_mode,true),!,
3840		not_in_domain_wf(X,Tail,WF). % we assert that R is a function ; when disproving we can assume well-definedness
3841		% 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)
3842		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
3843
3844
3845		:- use_module(memoization,[is_memoization_closure/4,apply_to_memoize/8]).
3846		:- load_files(library(system), [when(compile_time), imports([environ/2])]).
3847		:- if(\+ environ(no_wd_checking,true)).
3848		apply_to_nonvar([],X,_Y,InitialRel,Span,WF) :-
3849		\+ preferences:preference(find_abort_values,false),
3850		%%print(apply_to_empty(X,_Y,InitialRel)),nl,
3851		when(ground(X),add_wd_error_span('function applied outside of domain (#2): ', '@fun'(X,InitialRel),Span,WF)).
3852		:- endif.
3853		apply_to_nonvar([(X2,Y2)|T],X,Y,InitialRel,Span,WF) :- %translate:print_bvalue(((X,Y),(X2,Y2))),nl, trace,
3854		equality_objects_wf(X2,X,EqRes,WF),
3855		% this check on Y2 below is important if both Y and Y2 are instantiated but X,X2 not yet
3856		% example: aload_R07_cbc.mch (Savary) or cbc_sequence check for R08_ByteArray for aload_R07 event (test 1349)
3857		% however: slows down test 583 !
3858		(var(EqRes) -> equality_objects_wf(Y2,Y,EqResY,WF), %print(apply(X,X2,EqRes,Y2,Y,EqResY)),nl,
3859		prop_apply_eqxy(EqResY,EqRes) % propagate: if Y/=Y2 => X/=X2
3860		; EqResY=not_called),
3861		apply_to4(EqRes,EqResY,Y2,T,X,Y,InitialRel,Span,WF).
3862		%apply_to_nonvar(closure(Parameters,PT,Cond),X,Y,WF) :- !,
3863		% check_element_of_wf((X,Y),closure(Parameters,PT,Cond),WF).
3864		apply_to_nonvar(avl_set(A),X,Y,_InitialRel,Span,WF) :-
3865		%%debug:watch(10,custom_explicit_sets:apply_to_avl_set(A,X,Y,WF)). %%
3866	?	apply_to_avl_set(A,X,Y,Span,WF).
3867		apply_to_nonvar(closure(P,T,B),X,Y,_InitialRel,Span,WF) :-
3868		%is_custom_explicit_set(Closure,apply), % should also work for avl_set,...
3869	?	(is_memoization_closure(P,T,B,MemoID)
3870		% Function application with memoization; currently enabled by add /*@desc memo */ pragma to abstract constant
3871		-> apply_to_memoize(MemoID,P,T,B,X,Y,Span,WF)
3872	?	; 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 ??)
3873		-> % print_term_summary(apply_recursive_closure(X,P,T,B)),
3874		%hit_profiler:add_profile_hit(rec_apply_closure_to_nonvar(X,Y,P,T,B,Span,WF)),
3875		ground_value_check(X,XV), block_apply_closure_to_nonvar_groundx(XV,X,Y,P,T,B,Span,WF)
3876		%when(ground(X),apply_closure_to_nonvar_groundx(X,Y,P,T,B,Span,WF))
3877		; %hit_profiler:add_profile_hit(apply_closure_to_nonvar(X,Y,P,T,B,Span,WF)),
3878	?	apply_closure_to_nonvar(X,Y,P,T,B,Span,WF)).
3879
3880
3881		:- block block_apply_closure_to_nonvar_groundx(-,?,?, ?,?,?, ?,?).
3882		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).
3883
3884		apply_closure_to_nonvar_groundx(X,Y,P,T,B,Span,WF) :-
3885		kernel_tools:ground_bexpr(B),
3886		!, % then if the element of function succeeds there is no need to check WD
3887		if(check_element_of_function_closure(X,Y,P,T,B,WF),
3888		true, % No need to check for well-definedness; no pending choice points
3889		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
3890		).
3891		apply_closure_to_nonvar_groundx(X,Y,P,T,B,Span,WF) :-
3892		apply_closure_to_nonvar(X,Y,P,T,B,Span,WF).
3893
3894		% if we first check preferences:preference(find_abort_values,false) to avoid a choice
3895		% point, we get a big slow-down on Alstom models; e.g., vesg_Mar12
3896		% WARNING: This choice point can be set up in WF0 !
3897		apply_closure_to_nonvar(X,Y,P,T,B,_,WF) :-
3898	?	(preferences:preference(find_abort_values,true) -> true ; !), % slow down ???!
3899	?	check_element_of_function_closure(X,Y,P,T,B,WF) .
3900		apply_closure_to_nonvar(X,_,P,T,B,Span,WF) :- % removing this clause doubles runtime of COMPUTE_GRADIENT_CHANGE
3901		%hit_profiler:add_profile_hit(clause2(X,P,T,B,Span,WF),2),
3902		apply_closure_to_nonvar_wd_check(X,P,T,B,Span,WF).
3903
3904		apply_closure_to_nonvar_wd_check(X,P,T,B,Span,WF) :-
3905		%%print(potential_wd_error(X,P)),nl,nl,%trace,
3906		\+ preferences:preference(find_abort_values,false),
3907		not_in_domain_wf(X,closure(P,T,B),WF),
3908		when((ground(X),ground(closure(P,T,B))),
3909		add_wd_error_span('function applied outside of domain (#3): ', '@fun'(X,closure(P,T,B)),Span,WF)).
3910
3911
3912		% propagate equality_objects between range and domain elements for function application:
3913		:- block prop_apply_eqxy(-,-).
3914	?	prop_apply_eqxy(Eqy,Eqx) :- var(Eqy),!, (Eqx = pred_true -> Eqy = pred_true ; true).
3915		prop_apply_eqxy(pred_false,pred_false).
3916		prop_apply_eqxy(pred_true,_).
3917
3918		:- block apply_to4(-,?,?, -,?,?,?,?,?).
3919		apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) :- %print(app4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)),nl,
3920	?	var(EqResX),!, % Tail bound
3921	?	(Tail == []
3922	?	-> (preferences:preference(find_abort_values,false)
3923	?	-> EqResX = pred_true, apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)
3924		; apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)
3925		)
3926		; 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,...)
3927		; Tail = closure(_,_,_) -> apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)
3928		; Tail \= [_|_] -> add_internal_error('Illegal Tail: ',apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF)),fail
3929		; 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
3930		apply_to4_call5(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF, X3,Y3,T3)
3931		).
3932		apply_to4(pred_true,EqResY,Y2, Tail,X,Y,_InitialRel,_,WF) :-
3933		(EqResY==not_called -> equal_object_wf(Y2,Y,apply_to4,WF) ; EqResY = pred_true),
3934		optional_functionality_check(Tail,X,WF).
3935		apply_to4(pred_false,_EqResY,_Y2,T,X,Y,InitialRel,Span,WF) :- apply_to2(T,X,Y,InitialRel,Span,WF).
3936		% (nonvar(T) -> apply_to2(T,X,Y,InitialRel,WF)
3937		% ; when((ground(X);nonvar(T)), apply_to2(T,X,Y,InitialRel,WF))).
3938
3939		% we delay setting up equality_objects until X3 is at least partially known, see test 1715 Alstom_essai2_boucle1
3940		% TO DO: we could check if X3==X above
3941		:- block apply_to4_call5(-,?,?, ?,?,?,?,?,?, -,?,?).
3942		apply_to4_call5(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF, _X3,_Y3,_T3) :- nonvar(EqResX),!,
3943		apply_to4(EqResX,EqResY,Y2,Tail,X,Y,InitialRel,Span,WF).
3944		apply_to4_call5(EqResX,EqResY,Y2, _Tail,X,Y,InitialRel,Span,WF, X3,Y3,T3) :- % X3 must now be bound
3945		equality_objects_wf(X3,X,EqRes3,WF),
3946		%print(eq5(X3,X,EqRes3,Y3,T3)),nl,
3947		apply_to5(EqResX,EqResY,EqRes3, Y2,X3,Y3,T3, X,Y, InitialRel,Span,WF).
3948
3949		% version which wait suntil first argument known
3950		:- block apply_to4_block(-,?,?, ?,?,?,?,?,?).
3951		apply_to4_block(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF) :-
3952		apply_to4(EqResX,EqResY,Y2, Tail,X,Y,InitialRel,Span,WF).
3953
3954
3955		% apply_to5: implements a watched-literal style treatment of function application
3956		% we watch whether X unifies with two elements of the function, if only one element left we can force equality
3957		% TEST:
3958		% 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
3959		:- block apply_to5(-,?,-, ?,?,?,?, ?,?, ?,?,?),apply_to5(-,?,?, ?,?,?,-, ?,?, ?,?,?).
3960		apply_to5(EqRes,EqResY,EqRes3, Y2,_X3,Y3,T3, X,Y, InitialRel,Span,WF) :- %print(apply5(EqRes,EqResY,EqRes3, Y2,_X3,Y3,T3, X,Y, InitialRel,Span,WF)),nl,
3961		var(EqRes),!, %trace,
3962		% EqRes3 and T3 must be known; TO DO: improve predicate so that we have to wait on T3 only when EqRes3=pred_false
3963		(EqRes3 = pred_false -> % we cannot match next element, move tail one forward
3964		(T3 = [] -> EqRes=pred_true ; true),
3965		apply_to4(EqRes,EqResY,Y2,T3,X,Y,InitialRel,Span,WF)
3966		; /* EqRes3 = pred_true */
3967		% we match the next entry in the list; discard Y2 and jump to (X3,Y3) and return as solution
3968		equal_object_wf(Y3,Y,apply_to6,WF), optional_functionality_check(T3,X,WF),
3969		% TO DO: we could also do equality_objects if necessary between Y and Y3, as in apply_to4 for Y and Y2
3970		opt_force_false(EqRes)
3971		).
3972		apply_to5(pred_true,EqResY,EqRes3, Y2,X3,Y3,T3, X,Y, _InitialRel,_Span,WF) :-
3973	?	(EqResY==not_called -> equal_object_wf(Y2,Y,apply_to5,WF) ; EqResY = pred_true),
3974	?	opt_force_false(EqRes3),
3975		optional_functionality_check([(X3,Y3)|T3],X,WF).
3976		apply_to5(pred_false,_EqResY,EqRes3, _Y2,_X3,Y3,T3, X,Y, InitialRel,Span,WF) :-
3977	?	(var(EqRes3) -> % it can be that EqRes3 is about to be triggered, frozen(EqRes3,Goals), print(frozen(EqRes3,Goals)),nl, trace,
3978		equality_objects_wf(Y3,Y,EqResY3,WF), %print(apply(X,X2,EqRes,Y2,Y,EqResY)),nl,
3979		prop_apply_eqxy(EqResY3,EqRes3) % propagate: if Y/=Y3 => X/=X3
3980		; EqResY3=not_called),
3981	?	apply_to4(EqRes3,EqResY3,Y3, T3,X,Y,InitialRel,Span,WF).
3982
3983		opt_force_false(EqRes) :-
3984	?	(preference(find_abort_values,false) -> EqRes=pred_false
3985		; true). % TO DO: if EqRes becomes pred_true: raise abort_error as the relation was not a function
3986
3987
3988
3989		/********************************************/
3990		/* surjection_relation(R,Domain,Range) */
3991		/* R : Domain <->> Range */
3992		/********************************************/
3993		:- assert_must_succeed(exhaustive_kernel_check_wfdet(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)).
3994		:- 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)).
3995
3996		surjection_relation_wf(R,Domain,Range,WF) :-
3997		is_surjective(R,Range,WF),
3998		% TODO: is not optimal since ran(R)<:Range is already implied by is_surjective and
3999		% checked a second time by relation_over_wf/4
4000		relation_over_wf(R,Domain,Range,WF).
4001
4002		:- 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)).
4003
4004		not_surjection_relation_wf(R,Domain,Range,WF) :-
4005		expand_custom_set_to_list_wf(R,ER,Done,not_surjection_relation_wf,WF),
4006		not_tot_surj_rel(ER,Done,[],Domain,Range,Range,WF).
4007
4008		/*********************************************/
4009		/* total_surjection_relation(R,Domain,Range) */
4010		/* R : Domain <<->> Range */
4011		/*********************************************/
4012		:- 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)).
4013		:- 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)).
4014
4015
4016		:- assert_must_succeed((findall(R,bsets_clp:total_surjection_relation(R,[int(1)],[int(11),int(12)]),L),
4017		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
4018		length(SSL,1))).
4019		%:- assert_must_succeed((findall(R,bsets_clp:total_surjection_relation(R,[int(1),int(2)],[int(11),int(12)]),L), length(L,7))).
4020		% the new domain predicate also instantiates from result; meaning that duplicate solutions are now generated
4021		:- 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))).
4022		:- assert_must_succeed((findall(R,bsets_clp:total_surjection_relation(R,[int(1),int(2)],[int(11)]),L),
4023		length(L,1))).
4024
4025		total_surjection_relation(R,Domain,Range) :- init_wait_flags(WF),
4026		total_surjection_relation_wf(R,Domain,Range,WF), ground_wait_flags(WF).
4027
4028		total_surjection_relation_wf(R,Domain,Range,WF) :-
4029		relation_over_wf(R,Domain,Range,WF),
4030		check_relation_is_total(R,Domain,WF), % calls domain which now instantiates R if Domain known
4031		check_relation_is_surjective(R,Range,WF).
4032
4033
4034		:- 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)).
4035		:- 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)).
4036		:- 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)).
4037
4038		not_total_surjection_relation_wf(R,Domain,Range,WF) :-
4039		expand_custom_set_to_list_wf(R,ER,Done,not_total_surjection_relation_wf,WF),
4040		not_tot_surj_rel(ER,Done,Domain,Domain,Range,Range,WF).
4041
4042
4043		/********************************************/
4044		/* partial_surjection(R,DomType,RangeType) */
4045		/* R : DomType +->> RangeType */
4046		/********************************************/
4047
4048		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_surjection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4049		:- 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)).
4050		:- assert_must_succeed((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4051		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4052		:- assert_must_succeed((bsets_clp:partial_surjection(X,[int(1),int(2),int(3)],global_set('Name')),
4053		kernel_objects:equal_object(X,[(int(2),fd(1,'Name')),(int(1),fd(2,'Name')),(int(3),fd(3,'Name'))]))).
4054		:- assert_must_succeed((bsets_clp:partial_surjection_wf(X,[int(1),int(2),int(3)],global_set('Name'),_WF),
4055		kernel_objects:equal_object(X,[(int(2),fd(1,'Name')),(int(1),fd(2,'Name')),(int(3),fd(3,'Name'))]))).
4056		:- assert_must_succeed((bsets_clp:partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]),
4057		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4058		:- assert_must_succeed_multiple((bsets_clp:partial_surjection(X,[int(1),int(2),int(3),int(4)],[int(7),int(6)]),
4059		% print(X),nl,
4060		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6)),(int(3),int(6))]))). /* mult. */
4061		:- assert_must_succeed((X=[(int(2),int(7)),(int(1),int(6)),(int(3),int(6))],
4062		bsets_clp:partial_surjection(X,[int(1),int(2),int(3),int(4)],[int(7),int(6)]))).
4063		:- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4064		X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(7))])).
4065		:- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4066		X = [(int(2),int(7)),(int(1),int(7))])).
4067		:- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]),
4068		X = [(int(2),int(7)),(int(1),int(6)),(int(3),int(8))])).
4069		:- assert_must_succeed_multiple((bsets_clp:partial_surjection(_X,
4070		[int(1),int(2),int(3),int(4),int(5),int(6),int(7)],[int(2),int(3),int(4)]) )).
4071		:- assert_must_fail((bsets_clp:partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4072		X = [(int(2),int(7)),(int(2),int(6))])).
4073
4074		partial_surjection(R,Domain,Range) :- init_wait_flags(WF),
4075		partial_surjection_wf(R,Domain,Range,WF),
4076		ground_wait_flags(WF).
4077
4078		:- block partial_surjection_wf(-,-,?,?).
4079		partial_surjection_wf(R,Domain,Range,WF) :-
4080		check_card_greater_equal(Domain,geq,Range,CardDom,CardRange),
4081		(surjection_has_to_be_total_injection(CardDom,CardRange)
4082		% LAW: card(setX) = card(setY) => ff: setX +->> setY <=> ff: setX >-> setY
4083		-> total_function_wf(R,Domain,Range,WF),
4084		injective(R,WF)
4085		; is_surjective(R,Range,WF),
4086		partial_function_wf(R,Domain,Range,WF)
4087		).
4088
4089
4090		% check_card_greater_equal(A,B) : quick check that card(A) >= card(B); also works with infinite cardinality
4091		% TO DO: replace by a better constraint propagating predicate (also working for partially instantiated lists,...)
4092		% compared with computing card and setting up < constraint: will only compute card if it can be done efficiently + deals with inf
4093		% check_card_greater_equal(SetA,EQ,SetB) ; EQ=eq or geq
4094		:- block check_card_greater_equal(-,?,?,?,?).
4095		check_card_greater_equal([],_,R,0,0) :- !, empty_set(R).
4096		check_card_greater_equal(A,EQ,B,CA,CB) :- check_card_greater_equal2(A,EQ,B,CA,CB).
4097
4098		:- use_module(inf_arith,[block_inf_greater_equal/2]).
4099		:- block check_card_greater_equal2(?,?,-,?,?).
4100		check_card_greater_equal2(A,EQ,B,CardA,CardB) :-
4101		efficient_card_for_set(A,CardA,CodeA),
4102		efficient_card_for_set(B,CardB,CodeB),!,
4103		%print(check_geq(A,B,CardA,CodeA,CardB,CodeB)),nl,
4104		call(CodeA), call(CodeB),
4105		%% print(check_geq_val(CardA,CardB)),nl, %%
4106		(EQ=eq -> CardA=CardB ; block_inf_greater_equal(CardA,CardB)).
4107		check_card_greater_equal2(_A,_,_B,'?','?').
4108
4109
4110		:- block is_surjective(-,-,?).
4111		is_surjective(R,Range,WF) :- % print(is_surjective(R,Range,WF)),nl, %
4112		(var(R) -> setup_surj_range(Range,R)
4113		; range_wf(R,Range,WF)).
4114
4115		setup_surj_range(Range,R) :-
4116		setup_range(Range,Res,DONE), %print(setup_range(Range,Res,DONE)),nl,
4117		equal_when_done(Res,R,DONE).
4118		:- block equal_when_done(?,?,-).
4119		equal_when_done(Res,R,_DONE) :- equal_object(Res,R).
4120
4121
4122		:- block setup_range(-,?,?).
4123		setup_range(global_set(G),Res,DONE) :-
4124		expand_custom_set(global_set(G),ES), setup_range(ES,Res,DONE).
4125		setup_range(freetype(ID),Res,DONE) :-
4126		expand_custom_set(freetype(ID),ES), setup_range(ES,Res,DONE).
4127		setup_range(avl_set(S),Res,DONE) :- expand_custom_set(avl_set(S),ES), setup_range(ES,Res,DONE).
4128		setup_range(closure(P,T,B),Res,DONE) :-
4129		expand_custom_set(closure(P,T,B),ES), setup_range(ES,Res,DONE).
4130		setup_range([],_,done).
4131		setup_range([H|T],[(_,H)|ST],DONE) :- setup_range(T,ST,DONE).
4132
4133
4134
4135		:- assert_must_succeed(exhaustive_kernel_fail_check_wf(bsets_clp:not_partial_surjection_wf([(int(1),int(6)),(int(2),int(7))],
4136		[int(1),int(2)],[int(7),int(6)],WF),WF)).
4137		:- 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)],
4138		[int(7),int(6),int(2)],WF),WF)).
4139		:- assert_must_fail((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4140		X = [(int(2),int(7)),(int(1),int(6))])).
4141		:- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4142		X = [(int(2),int(7)),(int(2),int(6))])).
4143		:- assert_must_fail((bsets_clp:not_partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]),
4144		X = [(int(2),int(7)),(int(1),int(6))])).
4145		:- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4146		X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(7))])).
4147		:- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4148		X = [(int(2),int(7)),(int(1),int(7))])).
4149		:- assert_must_succeed((bsets_clp:not_partial_surjection(X,[int(1),int(2),int(3)],[int(7),int(6)]),
4150		X = [(int(2),int(7)),(int(1),int(6)),(int(3),int(8))])).
4151
4152		/* /: Domain +->> Range */
4153		not_partial_surjection(R,Domain,Range) :- init_wait_flags(WF),
4154		not_partial_surjection_wf(R,Domain,Range,WF),
4155		ground_wait_flags(WF).
4156
4157		:- block not_partial_surjection_wf(-,?,?,?), not_partial_surjection_wf(?,-,?,?),
4158		not_partial_surjection_wf(?,?,-,?).
4159		not_partial_surjection_wf(R,DomType,RangeType,WF) :-
4160		% TO DO: create a new partial_function_test kernel_equality like function instead
4161		% The fact that R is not a partial surjection is difficult to exploit !?
4162		kernel_tools:ground_value_check(R,RV),
4163		not_partial_surjection2(R,DomType,RangeType,WF,RV).
4164
4165		:- block not_partial_surjection2(?,?,?,?,-).
4166		not_partial_surjection2(R,DomType,RangeType,WF,_) :-
4167		not_partial_function(R,DomType,RangeType,WF).
4168		not_partial_surjection2(R,DomType,RType,WF,_) :-
4169		partial_function_wf(R,DomType,RType,WF),
4170		invert_relation_wf(R,IR,WF),
4171		not_total_relation_wf(IR,RType,DomType,WF).
4172
4173		:- 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)).
4174		:- 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)).
4175
4176		:- assert_must_succeed((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4177		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4178		:- assert_must_succeed((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4179		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
4180		:- assert_must_succeed((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4181		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6)),(int(1),int(7))]))).
4182		:- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4183		kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
4184		:- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4185		kernel_objects:equal_object(X,[(int(2),int(7))]))).
4186		:- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4187		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6)),(int(1),int(8))]))).
4188		:- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4189		kernel_objects:equal_object(X,[(int(2),int(7)),(int(3),int(6)),(int(1),int(7))]))).
4190		:- assert_must_fail((bsets_clp:total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4191		kernel_objects:equal_object(X,[]))).
4192
4193
4194		total_relation_wf(R,Domain,Range,WF) :- relation_over_wf(R,Domain,Range,WF),
4195		check_relation_is_total(R,Domain,WF).
4196
4197		% this predicates assume that the relation's range and domain have already been checked
4198		check_relation_is_total(Relation,Domain,WF) :- domain_wf(Relation,Domain,WF).
4199		check_relation_is_surjective(Relation,Range,WF) :-
4200		range_wf(Relation,Range,WF). % we could also call is_surjective (which does setup_surj_range) ?
4201
4202		:- 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)).
4203		:- 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)).
4204		:- assert_must_fail((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4205		X = [(int(2),int(7)),(int(1),int(6))])).
4206		:- assert_must_fail((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4207		X = [(int(2),int(7)),(int(1),int(7))])).
4208		:- assert_must_fail((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4209		X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(7))])).
4210		:- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4211		X = [(int(2),int(7)),(int(2),int(6))])).
4212		:- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4213		X = [(int(2),int(7))])).
4214		:- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4215		X = [(int(2),int(7)),(int(1),int(6)),(int(1),int(8))])).
4216		:- assert_must_succeed((bsets_clp:not_total_relation_wf(X,[int(1),int(2)],[int(7),int(6)],_WF),
4217		X = [(int(2),int(7)),(int(3),int(6)),(int(1),int(7))])).
4218
4219		:- block not_total_relation_wf(-,?,?,?).
4220		not_total_relation_wf(FF,Domain,Range,WF) :- nonvar(FF),custom_explicit_sets:is_definitely_maximal_set(Range),
4221		% we do not need the Range; this means we can match more closures (e.g., lambda)
4222		custom_explicit_sets:dom_for_specific_closure(FF,FFDomain,function(_)),!,
4223		not_equal_object_wf(FFDomain,Domain,WF).
4224		not_total_relation_wf(FF,Domain,Range,WF) :- nonvar(FF),
4225		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(_)),!,
4226		equality_objects_wf(FFDomain,Domain,Result,WF), % not yet implemented ! % TODO ! -> sub_set,equal,super_set
4227		when(nonvar(Result),(Result=pred_false -> true ; not_subset_of_wf(FFRange,Range,WF))).
4228		not_total_relation_wf(R,Domain,Range,WF) :-
4229		expand_custom_set_to_list_wf(R,ER,Done,not_total_relation_wf,WF), %print(not_tot_rel(ER,Domain)),nl,trace,
4230		not_tot_surj_rel(ER,Done,Domain,Domain,[],Range,WF). % empty DelRange means we don't do surjective test
4231
4232		% can be used to check not total, not surj, not total surj relation
4233		:- block not_tot_surj_rel(-,?,?,?,?,?,?).
4234		not_tot_surj_rel([],_,DelDomain,_,DelRange,_,WF) :-
4235		at_least_one_set_not_empty(DelDomain,DelRange,WF).
4236		not_tot_surj_rel([_|_],Done,_DelDom,Dom,_DelRan,_Ran,_WF) :- nonvar(Done),
4237		Done \= no_check_to_be_done,
4238		nonvar(Dom),is_infinite_explicit_set(Dom),
4239		!. % a finite expanded list can never be a total relation over an infinite domain
4240		not_tot_surj_rel([(X,Y)|T],_Done,DelDom,Dom,DelRan,Ran,WF) :-
4241		membership_test_wf(Dom,X,MemRes,WF),
4242		not_tr2(MemRes,X,Y,T,DelDom,Dom,DelRan,Ran,WF).
4243
4244		% check if one of the two sets is non-empty
4245		at_least_one_set_not_empty(Set1,_,_) :- nonvar(Set1),
4246		(Set1=avl_set(_) ; Set1=[_|_]), % we can avoid leaving choice point
4247		!.
4248		at_least_one_set_not_empty(Set1,_,WF) :- not_empty_set_wf(Set1,WF).
4249		at_least_one_set_not_empty(Set1,Set2,WF) :- empty_set_wf(Set1,WF),not_empty_set_wf(Set2,WF).
4250
4251		:- block not_tr2(-,?,?,?,?,?,?,?,?).
4252		not_tr2(pred_false,_X,_Y,_T,_DelDom,_Dom,_DelRan,_Ran,_WF).
4253		not_tr2(pred_true,X,Y,T,DelDom,Dom,DelRan,Ran,WF) :-
4254		delete_element_wf(X,DelDom,DelDom2,WF), % set DelDom initially to [] to avoid totality check
4255		membership_test_wf(Ran,Y,MemRes,WF),
4256		not_tr3(MemRes,Y,T,DelDom2,Dom,DelRan,Ran,WF).
4257
4258		:- block not_tr3(-,?,?,?,?,?,?,?).
4259		not_tr3(pred_false,_Y,_T,_DelDom2,_Dom,_DelRan,_Ran,_WF).
4260		not_tr3(pred_true,Y,T,DelDom2,Dom,DelRan,Ran,WF) :-
4261		delete_element_wf(Y,DelRan,DelRan2,WF), % set DelRan initially to [] to avoid surjection check
4262		not_tot_surj_rel(T,no_check_to_be_done,DelDom2,Dom,DelRan2,Ran,WF).
4263
4264		/******************************************/
4265		/* total_surjection(R,DomType,RangeType) */
4266		/* R : DomType -->> RangeType */
4267		/******************************************/
4268
4269		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:total_surjection_wf([(int(2),int(6)),(int(1),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4270		:- 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
4271		:- assert_must_succeed((bsets_clp:total_surjection(X,[int(1)],[int(7)]),
4272		kernel_objects:equal_object(X,[(int(1),int(7))]))).
4273		:- assert_must_succeed((bsets_clp:total_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4274		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4275		:- assert_must_succeed((bsets_clp:total_surjection(X,[int(1),int(2)],[int(7)]),
4276		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
4277		:- assert_must_fail((bsets_clp:total_surjection([],[int(1)],[int(7)]))).
4278		:- assert_must_fail((bsets_clp:total_surjection([(int(7),int(7))],[int(1)],[int(7)]))).
4279		:- assert_must_fail((bsets_clp:total_surjection([(int(1),int(7)), (int(2),int(1))],
4280		[int(1),int(2)],[int(7)]))).
4281		:- assert_must_fail((bsets_clp:total_surjection(X,[int(1),int(2)],[int(7),int(6)]),
4282		kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
4283
4284
4285		total_surjection(R,Domain,Range) :- init_wait_flags(WF),
4286		total_surjection_wf(R,Domain,Range,WF),
4287		ground_wait_flags(WF).
4288
4289		:- block total_surjection_wf(-,-,?,?).
4290		total_surjection_wf(R,DomType,RangeType,WF) :-
4291		check_card_greater_equal(DomType,geq,RangeType,CardDom,CardRange),
4292		total_function_wf(R,DomType,RangeType,WF),
4293		% setup_surj_range(RangeType,R).
4294		%print(totsurj(R,DomType,RangeType,CardDom,CardRange)),nl,
4295		(surjection_has_to_be_total_injection(CardDom,CardRange)
4296		% LAW: card(setX) = card(setY) => ff: setX -->> setY <=> ff: setX >-> setY
4297		-> 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
4298		; check_relation_is_surjective(R,RangeType,WF)).
4299		% invert_relation_wf(R,IR,WF), total_relation_wf(IR,RangeType,DomType,WF).
4300
4301		surjection_has_to_be_total_injection(CardDom,CardRange) :- number(CardDom), CardDom=CardRange.
4302		% 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)
4303
4304		:- 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)).
4305		:- 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)).
4306		:- 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)).
4307		:- 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)).
4308		:- 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)).
4309		:- 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)).
4310
4311		:- block not_total_surjection_wf(-,?,?,?), not_total_surjection_wf(?,-,?,?),
4312		not_total_surjection_wf(?,?,-,?).
4313		not_total_surjection_wf(R,DomType,RangeType,WF) :-
4314		%get_middle_wait_flag(not_total_surjection,WF,LWF),
4315		% TO DO: create a new total_function_test kernel_equality like function instead; or write custom not_total_function code
4316		% The fact that R is not a total surjection is difficult to exploit !?
4317		ground_value_check(R,RV),
4318		not_total_surjection2(R,DomType,RangeType,WF,RV).
4319		:- block not_total_surjection2(?,?,?,?,-).
4320		not_total_surjection2(R,DomType,RangeType,WF,_) :-
4321		not_total_function(R,DomType,RangeType,WF).
4322		not_total_surjection2(R,DomType,RangeType,WF,_) :-
4323		total_function_wf(R,DomType,RangeType,WF),
4324		not_partial_surjection_wf(R,DomType,RangeType,WF).
4325
4326		/*******************************************/
4327		/* partial_injection(R,DomType,RangeType) */
4328		/* R : DomType >+> RangeType */
4329		/*******************************************/
4330
4331		:- 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)).
4332		:- 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)).
4333		:- 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)).
4334		:- assert_must_succeed((bsets_clp:partial_injection(X,[int(1)],[int(7)]),
4335		kernel_objects:equal_object(X,[(int(1),int(7))]))).
4336		:- assert_must_succeed((bsets_clp:partial_injection(X,[int(1),int(2)],[int(7),int(6)]),
4337		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4338		:- assert_must_fail((bsets_clp:partial_injection(X,[int(1),int(2)],[int(7)]),
4339		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
4340		:- assert_must_succeed((bsets_clp:partial_injection([],[int(1)],[int(7)]))).
4341		:- assert_must_fail((bsets_clp:partial_injection([(int(7),int(7))],[int(1)],[int(7)]))).
4342		:- assert_must_fail((bsets_clp:partial_injection([(int(1),int(7)), (int(2),int(1))],
4343		[int(1),int(2)],[int(7)]))).
4344		:- assert_must_fail((bsets_clp:partial_injection(X,[int(1),int(2)],[int(7),int(6)]),
4345		kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
4346
4347
4348		partial_injection(R,Domain,Range) :- init_wait_flags(WF),
4349		partial_injection_wf(R,Domain,Range,WF),
4350		ground_wait_flags(WF).
4351
4352		:- block partial_injection_wf(-,-,?,?).
4353		partial_injection_wf(FF,Domain,Range,WF) :- nonvar(FF),
4354		custom_explicit_sets:dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection)),!,
4355		check_subset_of_wf(FFDomain,Domain,WF),
4356		check_subset_of_wf(FFRange,Range,WF).
4357		partial_injection_wf(R,DomType,RangeType,WF) :-
4358		try_expand_and_convert_to_avl_unless_large(R,ER),
4359		partial_function_wf(ER,DomType,RangeType,WF),
4360		injective(ER,WF).
4361		% invert_relation_wf(R,IR,WF),
4362		% print(pf(IR)),nl,
4363		% partial_function_wf(IR,RangeType,DomType,WF).
4364
4365		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:injective([(int(1),int(6)),(int(4),int(7)),(int(2),int(8))],WF),WF)).
4366		:- 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)).
4367
4368		:- block injective(-,?).
4369		injective(FF,_WF) :- %tools_printing:print_term_summary(injective(FF)),nl,
4370		custom_explicit_sets:dom_range_for_specific_closure(FF,_FFDomain,_FFRange,function(bijection)),!.
4371		injective(avl_set(AVL),_WF) :- !,
4372		is_injective_avl_relation(AVL,_Range). % seems slightly faster than code below
4373		injective(Rel,WF) :- expand_custom_set_to_list_wf(Rel,ERel,_,injective,WF),
4374		injective(ERel,[],WF).
4375
4376		%:- use_module(library(lists),[maplist/3]).
4377		% for FD-sets we could setup all_different constraint
4378		:- block injective(-,?,?).
4379		injective([],_SoFar,_). % :- print(all(SoFar)),nl,
4380		% (maplist(get_fd_val,SoFar,FDL) -> clpfd:all_distinct(FDL) ; true). %clpfd_interface:clpfd_alldifferent(FDL) ; true).
4381		%get_fd_val(int(H),H).
4382		injective([(_From,To)|T],SoFar,WF) :- %print(inj_check(_From,To,SoFar,T)),nl,
4383		not_element_of_wf(To,SoFar,WF), /* check that it is injective */
4384		%print(not_el(To)),nl,
4385		add_new_element_wf(To,SoFar,SoFar2,WF), %SoFar2=[To|SoFar], could also work and be faster ?
4386		%print(added(To,SoFar2)),nl,
4387		injective(T,SoFar2,WF).
4388		% no case for global_set: it cannot be a relation; two cases below not required because of expand_custom_set_to_list
4389		%injective(avl_set(S),SoFar,WF) :- expand_custom_set(avl_set(S),ES), injective(ES,SoFar,WF).
4390		%injective(closure(P,T,B),SoFar,WF) :- expand_custom_set(closure(P,T,B),ES), injective(ES,SoFar,WF).
4391
4392
4393
4394		/* /: Dom >+> R */
4395
4396		:- 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)).
4397		:- 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)).
4398		:- 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)).
4399		:- 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)).
4400
4401		:- block not_partial_injection(-,?,?,?), not_partial_injection(?,-,?,?),
4402		not_partial_injection(?,?,-,?).
4403		not_partial_injection(R,DomType,RangeType,WF) :-
4404		%get_middle_wait_flag(not_partial_injection,WF,LWF),
4405		% TO DO: create a new partial_function_test kernel_equality like function instead
4406		%ground_value_check(R,RV),
4407		kernel_tools:ground_value_check((R,DomType),RDV),
4408		not_partial_injection2(R,DomType,RangeType,WF,RDV).
4409		% TO DO: should we check dom_range_for_specific_closure ?
4410		:- block not_partial_injection2(?,?,?,?,-).
4411		not_partial_injection2(R,DomType,RType,WF,_) :- is_ground_set(R),
4412		is_ground_set(DomType), is_ground_set(RType),
4413		!, % avoid backtracking and checking for partial_function twice
4414		(not_partial_function(R,DomType,RType,WF)
4415		-> true
4416		; not_inection_wf(R,DomType,RType,WF)
4417		).
4418		not_partial_injection2(R,DomType,RType,WF,_) :-
4419		not_partial_function(R,DomType,RType,WF). % we could perform a cut if RType is also ground
4420		not_partial_injection2(R,DomType,RType,WF,_) :-
4421		partial_function_wf(R,DomType,RType,WF),
4422		not_inection_wf(R,DomType,RType,WF).
4423
4424		not_inection_wf(R,DomType,RType,WF) :-
4425		invert_relation_wf(R,IR,WF),
4426		not_partial_function(IR,RType,DomType,WF).
4427
4428		/*****************************************/
4429		/* total_injection(R,DomType,RangeType) */
4430		/* R : DomType >-> RangeType */
4431		/*****************************************/
4432
4433		:- 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)).
4434		:- 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)).
4435		:- 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)).
4436		:- 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)).
4437		:- assert_must_succeed((bsets_clp:total_injection(X,[int(1)],[int(7)]),
4438		kernel_objects:equal_object(X,[(int(1),int(7))]))).
4439		:- assert_must_succeed((bsets_clp:total_injection(X,[int(1),int(2)],[int(7),int(6)]),
4440		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(6))]))).
4441		:- assert_must_fail((bsets_clp:total_injection(X,[int(1),int(2)],[int(7)]),
4442		kernel_objects:equal_object(X,[(int(2),int(7)),(int(1),int(7))]))).
4443		:- assert_must_fail((bsets_clp:total_injection([],[int(1)],[int(7)]))).
4444		:- assert_must_fail((bsets_clp:total_injection([(int(7),int(7))],[int(1)],[int(7)]))).
4445		:- assert_must_fail((bsets_clp:total_injection([(int(1),int(7)), (int(2),int(1))],
4446		[int(1),int(2)],[int(7)]))).
4447		:- assert_must_fail((bsets_clp:total_injection(X,[int(1),int(2)],[int(7),int(6)]),
4448		kernel_objects:equal_object(X,[(int(2),int(7)),(int(2),int(6))]))).
4449
4450
4451		total_injection(R,Domain,Range) :- init_wait_flags(WF),
4452		total_injection_wf(R,Domain,Range,WF),
4453		ground_wait_flags(WF).
4454
4455		:- block total_injection_wf(-,-,?,?). % with just ?,-,?,? we may wait too long to start injective check
4456		% Note: no need to check: dom_range_for_specific_closure(FF,FFDomain,FFRange,function(bijection)),
4457		total_injection_wf(R,DomType,RangeType,WF) :- % print_message(total_inj(R)),
4458		check_card_greater_equal(RangeType,geq,DomType,_,_), % there must be more Range elements than domain elements; pigeonhole principle
4459		total_injection_wf2(R,DomType,RangeType,WF).
4460		total_injection_wf2(R,DomType,RangeType,WF) :-
4461		try_expand_and_convert_to_avl_unless_large(R,ER),
4462		total_function_wf(ER,DomType,RangeType,WF), % print_message(total_f(ER)),
4463		injective(ER,WF).
4464
4465
4466		:- block not_total_injection(-,?,?,?), not_total_injection(?,-,?,?),
4467		not_total_injection(?,?,-,?).
4468		not_total_injection(R,DomType,RangeType,WF) :-
4469		%get_middle_wait_flag(not_total_injection,WF,LWF),
4470		% TO DO: create a new total_function_test kernel_equality like function instead
4471		kernel_tools:ground_value_check((R,DomType),RDV),
4472		not_total_injection2(R,DomType,RangeType,WF,RDV).
4473
4474		:- block not_total_injection2(?,?,?,?,-).
4475		not_total_injection2(R,DomType,RangeType,WF,_) :- is_ground_set(R),
4476		is_ground_set(DomType), is_ground_set(RangeType),
4477		!, % avoid backtracking and checking for total_function twice
4478		(not_total_function(R,DomType,RangeType,WF)
4479		-> true
4480		; not_inection_wf(R,DomType,RangeType,WF)
4481		).
4482		not_total_injection2(R,DomType,RangeType,WF,_) :- %print(not_tot_inj(R)),nl,
4483		not_total_function(R,DomType,RangeType,WF) . %, print(not_tot_fun(R)),nl.
4484		not_total_injection2(R,DomType,RangeType,WF,_) :- % print(try2(R)),nl,
4485		total_function_wf(R,DomType,RangeType,WF), %print(tot_fun(R)),nl,
4486		not_inection_wf(R,DomType,RangeType,WF).
4487
4488		/***********************************/
4489		/* partial_bijection(R,DomType,RangeType) */
4490		/* R : DomType >+>> RangeType */
4491		/***********************************/
4492
4493
4494		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:partial_bijection_wf([(int(1),int(6)),(int(2),int(7))],[int(1),int(2)],[int(7),int(6)],WF),WF)).
4495		:- 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)).
4496		:- assert_must_succeed((partial_bijection(X,[int(1),int(2)],[int(7),int(6)]),
4497		kernel_objects:equal_object(X,[(int(1),int(6)),(int(2),int(7))]))).
4498		:- assert_must_succeed((partial_bijection(X,[int(1),int(2),int(3),int(4)],[int(7),int(6)]),
4499		X = [(int(2),int(7)),(int(3),int(6))])).
4500		:- assert_must_fail((partial_bijection(X,[int(1),int(2)],[int(7),int(6),int(5)]),
4501		X = [(int(2),int(7)),(int(1),int(6))])).
4502
4503		partial_bijection(R,Domain,Range) :- init_wait_flags(WF),
4504		partial_bijection_wf(R,Domain,Range,WF),
4505		ground_wait_flags(WF).
4506
4507		partial_bijection_wf(R,DomType,RangeType,WF) :-
4508		partial_injection_wf(R,DomType,RangeType,WF),
4509		partial_surjection_wf(R,DomType,RangeType,WF).
4510
4511		:- 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)).
4512		:- 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)).
4513
4514		:- 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)).
4515
4516		:- 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)).
4517		:- 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)).
4518
4519
4520		:- block not_partial_bijection(-,?,?,?), not_partial_bijection(?,-,?,?),
4521		not_partial_bijection(?,?,-,?).
4522		not_partial_bijection(R,DomType,RangeType,WF) :-
4523		%get_middle_wait_flag(not_partial_bijection,WF,LWF),
4524		kernel_tools:ground_value_check((R,DomType,RangeType),LWF),
4525		not_partial_bijection2(R,DomType,RangeType,WF,LWF).
4526		:- block not_partial_bijection2(?,?,?,?,-).
4527		not_partial_bijection2(R,DomType,RangeType,WF,_) :-
4528		not_partial_injection(R,DomType,RangeType,WF).
4529		not_partial_bijection2(R,DomType,RangeType,WF,_) :-
4530		partial_injection_wf(R,DomType,RangeType,WF),
4531		not_partial_surjection_wf(R,DomType,RangeType,WF).
4532
4533
4534
4535
4536
4537
4538		/* The transitive (not reflexive) closure of a relation */
4539
4540		:- 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))]))).
4541		:- 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))]))).
4542		:- 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))]))).
4543		:- assert_must_succeed((bsets_clp:relational_trans_closure([(int(1),int(4))],X),
4544		kernel_objects:equal_object(X,[(int(1),int(4))]))).
4545		:- assert_must_succeed((bsets_clp:relational_trans_closure([(int(1),int(4)),(int(4),int(2))],X),
4546		kernel_objects:equal_object(X,[(int(1),int(4)),(int(4),int(2)),
4547		(int(1),int(2))]))).
4548		:- assert_must_succeed((bsets_clp:relational_trans_closure([(int(1),int(4)),(int(4),int(2)),(int(2),int(3))],X),
4549		kernel_objects:equal_object(X,[(int(1),int(4)),(int(4),int(2)),(int(2),int(3)),
4550		(int(4),int(3)),(int(1),int(2)),(int(1),int(3))]))).
4551
4552		relational_trans_closure(Rel,Res) :- relational_trans_closure_wf(Rel,Res,no_wf_available).
4553
4554		% transitive closure for relations (closure1)
4555		:- block relational_trans_closure_wf(-,?,?).
4556		relational_trans_closure_wf(Relation,Result,WF) :- % print_term_summary(closure1(Relation,Result)),
4557	?	try_expand_and_convert_to_avl_with_check(Relation,ARelation,relational_trans_closure_wf),
4558	?	relational_trans_closure2(ARelation,Result,WF).
4559		:- block relational_trans_closure2(-,?,?).
4560		relational_trans_closure2(ARelation,Result,WF) :- %print(closure1(ARelation)),nl,
4561	?	(closure1_for_explicit_set(ARelation,Res)
4562		-> % print_term_summary(closure1_explicit(ARelation,Res)),
4563		kernel_objects:equal_object_wf(Res,Result,relational_trans_closure_wf,WF)
4564	?	; expand_custom_set_to_list_wf(ARelation,ERelation,_,relational_trans_closure2,WF),
4565	?	is_full_relation(ERelation,WaitVar),
4566	?	compute_trans_closure(ERelation,Result,WaitVar,WF)
4567		).
4568
4569		:- block compute_trans_closure(?,?,-,?).
4570		compute_trans_closure(Relation,Result,_,WF) :- % print(computing_trans_closure(Relation)),nl,
4571	?	compute_trans_closure2(Relation,Result,WF). %,print(result(Result)),nl.
4572
4573		compute_trans_closure2(Relation,Result,WF) :- %print_message(iter(Relation)),
4574	?	one_closure_iteration(Relation,Relation,Relation,Result1,WF),
4575	?	( equal_object_wf(Result1,Relation,relational_trans_closure_wf,WF), % should we do equality_objects here?
4576		equal_object_optimized_wf(Result,Result1,compute_trans_closure,WF)
4577		; % TO DO: use reification instead of is_full_relation check above ??
4578		not_equal_object(Result1,Relation), % not a fixpoint; continue
4579		compute_trans_closure2(Result1,Result,WF)
4580		).
4581
4582		one_closure_iteration([],_,Res,Res,_WF).
4583		one_closure_iteration([(X,Y)|T],ExpandedPreviousRel,PreviousRel,OutRel,WF) :-
4584		add_tuples(ExpandedPreviousRel,X,Y,PreviousRel,IntRel,WF),
4585		one_closure_iteration(T,ExpandedPreviousRel,IntRel,OutRel,WF).
4586
4587
4588		add_tuples([],_,_,OutRel,OutRel,_).
4589		add_tuples([(X,Y)|T],OX,OY,InRel,OutRel,WF) :-
4590		( equal_object_wf(Y,OX,add_tuples,WF),add_element((X,OY),InRel,IntRel) ;
4591		not_equal_object(Y,OX), IntRel = InRel),
4592		add_tuples(T,OX,OY,IntRel,OutRel,WF).
4593
4594
4595		:- assert_must_succeed((is_full_relation(X,R),var(R),X=[],R==true)).
4596		:- 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)).
4597		:- block is_full_relation(-,?).
4598		is_full_relation([],R) :- !,R=true.
4599		is_full_relation([H|T],W) :- !, is_full_relation_aux(H,T,W).
4600		is_full_relation(X,R) :-
4601		add_internal_error('Illegal Set for is_full_relation: ',is_full_relation(X,R)),fail.
4602
4603		:- block is_full_relation_aux(-,?,?).
4604		is_full_relation_aux((X,Y),T,W) :- !, is_full_relation_aux2(X,Y,T,W).
4605		is_full_relation_aux(X,T,W) :-
4606		add_internal_error('Illegal Set for is_full_relation: ',is_full_relation_aux(X,T,W)),fail.
4607		:- block is_full_relation_aux2(-,?,?,?), is_full_relation_aux2(?,-,?,?).
4608		is_full_relation_aux2(_X,_Y,T,W) :- is_full_relation(T,W).
4609
4610		/* ------------------ */
4611
4612		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_closure1_wf((int(1),int(3)),[(int(1),int(2)),(int(2),int(1)),(int(2),int(3))],WF),WF)).
4613
4614		in_closure1_wf(Pair,Relation,WF) :- %Pair = (_A,B), %print(in_closure1(Pair,Relation)),nl,
4615		%in_domain_wf_lazy(A,Relation,WF), % done below
4616		%check_element_of_wf((_,B),Relation,WF), % multiple solutions for _, see test 634, 637
4617	?	in_closure1_membership_test_wf(Pair,Relation,pred_true,WF).
4618
4619
4620		:- 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)).
4621
4622		not_in_closure1_wf(Pair,Relation,WF) :-
4623		in_closure1_membership_test_wf(Pair,Relation,pred_false,WF).
4624
4625		:- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[],Res,_WF),Res==pred_false)).
4626		:- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(2))],Res,_WF),Res==pred_true)).
4627		:- assert_must_succeed((bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(3))],Res,_WF),Res==pred_false)).
4628		:- 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)).
4629		:- assert_must_succeed(exhaustive_kernel_check_wfdet(bsets_clp:in_closure1_membership_test_wf((int(1),int(2)),[(int(1),int(3)),(int(3),int(2))],pred_true,WF),WF)).
4630		:- 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)).
4631		:- 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)).
4632		:- 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)).
4633		:- assert_must_succeed(exhaustive_kernel_check_wfdet(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)).
4634		:- 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)).
4635
4636		:- block force_in_domain(-,?,?,?).
4637		force_in_domain(pred_false,_A,_Relation,_WF).
4638		force_in_domain(pred_true,A,Relation,WF) :- % force A to be in domain, avoid enumeration warnings,...
4639		% maybe only for non-ground A
4640		in_domain_wf_lazy(A,Relation,WF). % slowdown Loop.mch (tests 634, 637) if we use in_domain_wf ?
4641
4642		% (x,y) : closure1(Rel)
4643		:- block in_closure1_membership_test_wf(?,-,?,?).
4644		in_closure1_membership_test_wf((A,B),CSRelation,MemRes,WF) :-
4645	?	is_custom_explicit_set(CSRelation,in_closure1),
4646	?	!,
4647	?	image_for_closure1_wf(CSRelation,[A],Image,WF),
4648		force_in_domain(MemRes,A,CSRelation,WF),
4649		membership_test_wf(Image,B,MemRes,WF).
4650		in_closure1_membership_test_wf((X,Y),Relation,MemRes,WF) :-
4651		expand_custom_set_to_list_wf(Relation,ERelation,_,in_closure1_membership_test_wf,WF),
4652		Discarded = [], % pairs discarded in current iteration
4653		force_in_domain(MemRes,X,Relation,WF),
4654		in_closure1_membership_test_wf2(ERelation,X,Y,Discarded,MemRes,WF).
4655
4656		:- block in_closure1_membership_test_wf2(-,?,?,?,?,?).
4657		in_closure1_membership_test_wf2([],_X,_Y,_,MemRes,_WF) :- MemRes=pred_false.
4658		in_closure1_membership_test_wf2([(V,W)|Rest],X,Y,Discarded,MemRes,WF) :- % TO DO: Rest==[] -->
4659		equality_objects_wf(V,X,VXResult,WF),
4660		in_closure1_membership_test_wf3(VXResult,V,W,Rest,X,Y,Discarded,MemRes,WF).
4661
4662		:- block in_closure1_membership_test_wf3(-,?,?,?,?,?,?,?,?).
4663		in_closure1_membership_test_wf3(pred_false,V,W,Rest,X,Y,Discarded,MemRes,WF) :-
4664		in_closure1_membership_test_wf2(Rest,X,Y,[(V,W)|Discarded],MemRes,WF).
4665		in_closure1_membership_test_wf3(pred_true,V,W,Rest,X,Y,Discarded,MemRes,WF) :- % V=X
4666		propagate_false(MemRes,WYResult),
4667		% TODO: Res=[],Discarded=[] -> MemRes=WYResult
4668		equality_objects_wf(W,Y,WYResult,WF), % MemRes = pred_false => WYResult = pred_false
4669		in_closure1_membership_test_wf4(WYResult,V,W,Rest,X,Y,Discarded,MemRes,WF).
4670
4671		:- block in_closure1_membership_test_wf4(-,?,?,?,?,?,?,?,?).
4672		in_closure1_membership_test_wf4(pred_false,_V,W,Rest,X,Y,Discarded,MemRes,WF) :-
4673		append(Discarded,Rest,Restart),
4674		in_closure1_membership_test_wf2(Restart,W,Y,[],MemRes1,WF),
4675		propagate_false(MemRes,MemRes1), % MemRes = false -> MemRes1=false
4676		when(nonvar(MemRes1),
4677		(MemRes1=pred_true -> MemRes=pred_true
4678		; in_closure1_membership_test_wf2(Rest,X,Y,Discarded,MemRes,WF) % (V,W) not in Discarded: was not useful
4679		)).
4680		in_closure1_membership_test_wf4(pred_true,_V,_W,_Rest,_X,_Y,_Discarded,MemRes,_WF) :- % W=Y
4681		MemRes = pred_true.
4682		/* ------------------ */
4683
4684		:- block propagate_false(-,?).
4685		propagate_false(pred_false,pred_false).
4686		propagate_false(pred_true,_).
4687