1		% (c) 2014-2022 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(clpfd_lists,[
6		lazy_fd_value_check/4,
7		try_in_fd_value_list_check/4,
8		avl_fd_value_check/4,
9		in_fd_value_list_wf/4, in_fd_value_list_wf/3,
10		get_fd_value_list/5,
11		try_get_fd_value_list/4,
12		get_fd_value/3,
13
14		get_fdset_information/2, get_finite_fdset_information/2,
15		combine_fdset_information/3,
16		assert_fdset_information/2
17		]).
18
19		:- use_module(preferences).
20		:- use_module(error_manager).
21
22		:- use_module(module_information,[module_info/2]).
23		:- module_info(group,kernel).
24		:- module_info(description,'This module provides a way to call the CLPFD clpfd_inlist and clpfd:element predicates for lists of FD values.').
25
26		% see clpfd_tables test category
27
28		% -----------------------------------------------------
29
30		:- block complete_type(-).
31		% check if we have a complete value type or if we extract only part of the value
32		complete_type(global(_)).
33		complete_type(integer).
34		%complete_type(couple(A,B)) :- fail. % THIS IS NOT COMPLETE !! -> the element checks are done for each component in isolation ! (there is no guarantee that the pair is in the list of pairs)
35
36		% -----------------------------------------------------
37
38		:- block try_in_fd_value_list_check(-,?,?,?).
39		try_in_fd_value_list_check([],_,_,_) :- fail.
40		try_in_fd_value_list_check([H|T],El,Type,WF) :-
41		try_get_fd_value_type(El,H,Type), % print(fd_val_type(El,H,T)),nl,
42		!,
43		get_fd_value_list([H|T],Type,FDList,GroundList,El),
44		get_fd_value(Type,El,ElFD),
45		in_fd_value_list_wf(GroundList,ElFD,FDList,WF).
46		try_in_fd_value_list_check(S,El,Type,WF) :-
47		(S=[_|_] -> true
48		; add_internal_error('Illegal call: ',try_in_fd_value_list_check(S,El,Type,WF))).
49
50		:- use_module(kernel_freetypes,[get_freeval_type/3]).
51
52		% try get fd_value type from two values; one from element one from set
53	?	try_get_fd_value_type(V1,V2,T) :- var(V1),!, try_get_fd_value(T,V2,_).
54		try_get_fd_value_type((A1,_),(A2,_),T) :- nonvar(T),T=couple_left(TA),!,
55		try_get_fd_value_type(A1,A2,TA). % useful for domain checks
56		try_get_fd_value_type((A1,B1),(A2,B2),Type) :- !,
57	?	(try_get_fd_value_type(A1,A2,TA)
58		-> (try_get_fd_value_type(B1,B2,TB)
59		-> Type = couple(TA,TB) % we have two values
60		; %print(failed_right(B1,B2,TB)),nl,
61		Type = couple_left(TA))
62		; Type = couple_right(TB),
63		try_get_fd_value_type(B1,B2,TB)).
64		try_get_fd_value_type(freeval(ID,Case,Val1),V2, freeval_case(ID,Case,Type)) :- !,
65		nonvar(Case), ground(ID),
66		(nonvar(V2),V2 = freeval(ID2,Case2,Val2),
67		(ID,Case) == (ID2,Case2)
68		-> try_get_fd_value_type(Val1,Val2,Type)
69		; % TO DO: if the cases do not match and if Val1 is a variable then we may miss FD values
70		%print(case_mismatch(ID,Case,V2)),nl,
71		get_freeval_type(ID,Case,_CaseType),
72		%print(freeval_case_type(ID,Case,CaseType,Val1)),nl,
73		% TO DO: use CaseType in case Val1 is not instantiated enough
74		try_get_fd_value(Type,Val1,_)).
75		try_get_fd_value_type(V1,V2,T) :-
76	?	(var(V2) -> try_get_fd_value(T,V1,_) ; try_get_fd_value(T,V2,_)).
77
78		% TO DO: merge both versions of try_get_fd_value
79		try_get_fd_value(T,V,_) :- var(V),var(T),!,fail.
80		try_get_fd_value(TV,(A,B),FD) :- var(TV),!,
81	?	(try_get_fd_value(TA,A,FDA)
82	?	-> (try_get_fd_value(TB,B,FDB) % What if this fails because B is still a variable !? --> ideally, typing info would help
83		-> TV = couple(TA,TB), FD=fd_pair(FDA,FDB) % we have two values
84		; TV = couple_left(TA), FD=FDA)
85		; TV = couple_right(TB),
86		try_get_fd_value(TB,B,FD)).
87		try_get_fd_value(couple(TA,TB),(A,B),fd_pair(FDA,FDB)) :-
88		try_get_fd_value(TA,A,FDA),try_get_fd_value(TB,B,FDB).
89		try_get_fd_value(couple_left(T),(A,_),FDA) :- try_get_fd_value(T,A,FDA). % useful for domain checks
90		% to do: try and get both and do multiple in_list/element calls later
91		try_get_fd_value(couple_right(T),(_,A),FDA) :- try_get_fd_value(T,A,FDA). % useful for range checks
92		try_get_fd_value(rec_fields(T),rec(Fields),fd_rec(FD)) :-
93		try_get_field_fd_values(T,Fields,FD),
94		T \= [].
95		try_get_fd_value(global(GS),fd(X,GS),X).
96		try_get_fd_value(integer,int(X),X).
97
98		try_get_field_fd_values(_,Fields,_) :- var(Fields),!,fail. % we don't know all the fields; better do nothing
99		try_get_field_fd_values(Types,[],FDVals) :- !,Types=[],FDVals=[].
100		try_get_field_fd_values(_,[FN|_],_) :- var(FN),!,fail.
101		try_get_field_fd_values(_,[field(Name,_)|_],_) :- var(Name),!,fail.
102		try_get_field_fd_values(Types,[field(Name,Value)|TF],FDVals) :-
103	?	try_get_fd_value(T,Value,FDVal),
104		!,
105		Types = [field(Name,T)|TTypes],
106		FDVals = [FDVal|TFD],
107		try_get_field_fd_values(TTypes,TF,TFD).
108		try_get_field_fd_values([field_no_fd(Name)|Types],[field(Name,_)|TF],FDVals) :-
109		try_get_field_fd_values(Types,TF,FDVals).
110
111
112		:- use_module(b_global_sets,[get_global_type_value/3]).
113
114		get_fd_value(T,V,E) :- var(V),var(T),!,
115		add_internal_error('Variable arguments: ',get_fd_value(V,T,E)),fail.
116		get_fd_value(couple(TA,TB),(A,B),fd_pair(FDA,FDB)) :-
117		get_fd_value(TA,A,FDA), get_fd_value(TB,B,FDB).
118		get_fd_value(couple_left(T),(A,_),FDA) :- get_fd_value(T,A,FDA).
119		get_fd_value(couple_right(T),(_,A),FDA) :- get_fd_value(T,A,FDA).
120		get_fd_value(rec_fields(T),rec(Fields),fd_rec(FD)) :- get_field_fd_values(T,Fields,FD).
121		get_fd_value(freeval_case(ID,Case,T),freeval(ID,Case,A),FDA) :-
122		get_fd_value(T,A,FDA).
123		get_fd_value(global(GS),FD,X) :- get_global_type_value(FD,GS,X).
124		get_fd_value(integer,int(X),X).
125
126		get_field_fd_values([],[],[]).
127		get_field_fd_values([field_no_fd(Name)|TTypes],[field(Name,_)|TF],FDVals) :-
128		get_field_fd_values(TTypes,TF,FDVals).
129		get_field_fd_values([field(Name,T)|TTypes],[field(Name,Value)|TF],[FDVal|TFD]) :-
130		get_fd_value(T,Value,FDVal),
131		get_field_fd_values(TTypes,TF,TFD).
132
133		:- use_module(library(lists),[maplist/2]).
134		check_valid_fd_type(Type) :-
135		(valid_type(Type) -> true
136		; add_internal_error('Illegal FD type:',check_valid_fd_type(Type)),fail).
137		valid_type(couple(TA,TB)) :- valid_type(TA),valid_type(TB).
138		valid_type(couple_left(TA)) :- valid_type(TA).
139		valid_type(couple_right(TA)) :- valid_type(TA).
140		valid_type(global(GS)) :- atomic(GS).
141		valid_type(rec_fields(Fs)) :- maplist(valid_rec_type,Fs).
142		valid_type(freeval_case(_,_,TA)) :- valid_type(TA).
143		valid_type(integer).
144
145		valid_rec_type(field(_,T)) :- valid_type(T).
146		valid_rec_type(field_no_fd(_)).
147
148		% -----------------------------------------------------
149
150		% extract from a Set (List) representation a list of FDValues which can be used by the clpfd library
151		try_get_fd_value_list(Set,Type,FDList,GroundList) :-
152		try_get_fd_value_list5(Set,Type,FDList,true,GroundList).
153		try_get_fd_value_list5(V,_,_,_,_) :- var(V),!,fail.
154		try_get_fd_value_list5([],_,[],G,G). % Note if this is the base case then the type could be that of an empty list of pairs !
155		try_get_fd_value_list5([H|T],Type,FDList,GroundIn,GroundOut) :-
156		try_get_fd_value(Type,H,Value),!, FDH=Value,
157		(GroundIn=true,integer(FDH) -> Ground1=true ; Ground1=false),
158		%%(ground(T) -> true ; print(get_fd_val_list(H,T)),nl), %%
159		check_non_var_list(T), % do not instantiate any free variable ! otherwise we get full domain probably anyway ?
160		if(get_fd_value_list5(T,Type,FDT,Ground1,GroundOut,_NoFilterEl,1),
161		FDList = [FDH|FDT],
162		FDList = []). % obtaining FD value triggered inconsistency
163		try_get_fd_value_list5(avl_set(A),_,_,_,_) :-
164		add_internal_error('Not a list: ',try_get_fd_value_list5(avl_set(A),_,_,_,_)),fail.
165		try_get_fd_value_list5(node(A,B,C,D,E),_,_,_,_) :-
166		add_internal_error('Not a list: ',try_get_fd_value_list5(node(A,B,C,D,E),_,_,_,_)),fail.
167		try_get_fd_value_list5(closure(A,B,C),_,_,_,_) :-
168		add_internal_error('Not a list: ',try_get_fd_value_list5(closure(A,B,C),_,_,_,_)),fail.
169
170		check_non_var_list(V) :- var(V),!,fail. %print(check_non_var_failed),nl,fail.
171		check_non_var_list([]).
172		check_non_var_list([H|T]) :- !, nonvar(H), check_non_var_list(T).
173
174		% -----------------------------------------------------
175
176		% remove from a list of FDValues those that belong to objects that definitely cannot match Element
177		% this improves the precision of a later in_fd_value_list_wf call
178		% cannot_match: quick check to see if the (AVL or List) element could match
179
180		:- use_module(kernel_tools,[cannot_match/2, cannot_match_aggressive/2]).
181
182		% gets a (filtered) FD Value list (El used for filtering)
183		get_fd_value_list(Set,Type,FDList,GroundList,El) :-
184		get_fd_value_list5(Set,Type,FDList,true,GroundList,El,0).
185		get_fd_value_list5(V,_,_,_,_,_,_) :- var(V),!,fail.
186		get_fd_value_list5([],_,[],G,G,_,_).
187		get_fd_value_list5([H|T],Type,FDValList,GroundIn,GroundOut,El,NrMatch) :-
188		(NrMatch<2 -> cannot_match_aggressive(H,El) % there is still hope of obtaining something deterministic; try more aggressive version; important for test 34; see also test 985 where too much propagation hurts
189		; cannot_match(H,El)),
190		!, % we can filter this FD Value out
191		get_fd_value_list5(T,Type,FDValList,GroundIn,GroundOut,El,NrMatch).
192		get_fd_value_list5([H|T],Type,FDValList,GroundIn,GroundOut,El,NrMatch) :-
193		if(get_fd_value(Type,H,FDH),
194		(FDValList = [FDH|FDT], N1 is NrMatch+1,
195		(GroundIn=true,number(FDH) -> Ground1=true ; Ground1=false)),
196		% Failure can happen when a variable gets instantiated (eg. X -> fd(_,t))
197		% and triggers co-routines which fail (happens for SelfGrandpas.als for scope 3)
198		% TO DO: review that this is the only possibility of failure
199		(debug:debug_println(9,get_fd_value_failed(Type,H,_)),
200		check_valid_fd_type(Type),fail)
201		),
202		get_fd_value_list5(T,Type,FDT,Ground1,GroundOut,El,N1).
203
204		% -----------------------------------------------------
205
206		:- use_module(library(clpfd)).
207		:- use_module(clpfd_interface).
208		:- use_module(kernel_waitflags,[get_enumeration_starting_wait_flag/3]).
209
210		in_fd_value_list_wf(Element,List,WF) :-
211		(ground_integer_list(List) -> Gr=true ; Gr=false),
212		in_fd_value_list_wf(Gr,Element,List,WF).
213
214		ground_integer_list(Var) :- var(Var),!,fail.
215		ground_integer_list([]).
216		ground_integer_list([H|T]) :- integer(H), ground_integer_list(T).
217
218		% assert that an FD Value is in a list of FD Values
219		% in_fd_value_list(ListIsGroundOfSimpleIntegers, FDElement, ListOfFDValues)
220		in_fd_value_list_wf(true,Element,List,_WF) :-
221		List \= [], % avoid calling in case Element is compound (as try_get_fd_value_list will return ground for empty list)
222		clpfd_inlist(Element,List). % element should not be a compound like fd_pair!
223		in_fd_value_list_wf(false,Element,List,WF) :-
224		%get_enumeration_finished_wait_flag(WF,EWF),
225		get_enumeration_starting_wait_flag(in_fd_value_list_wf,WF,EWF), % relevant for test 2070 to avoid enum warning
226		in_non_ground_fd_value_lists(Element,List,EWF,top).
227
228		in_non_ground_fd_value_lists(FDP,List,EWF,_) :- nonvar(FDP), FDP = fd_pair(A,B), !,
229		split_fd_pair_list(List,ListA,ListB),
230		in_non_ground_fd_value_lists(A,ListA,EWF,left),
231		in_non_ground_fd_value_lists(B,ListB,EWF,right).
232		in_non_ground_fd_value_lists(FDR,List,EWF,_) :- nonvar(FDR), FDR = fd_rec(Fields), !,
233		%print(treat_fd_rec_fields(Fields,List)),nl,
234		treat_fd_rec_fields(Fields,List,EWF).
235		in_non_ground_fd_value_lists(Element,List,_EWF,Path) :-
236		Path \= top, % otherwise we know List not to be ground
237		ground(List), %ground_number_list(List,Min,Max,Len), List can be a large term
238		!,
239		clpfd_interface:clpfd_inlist(Element,List). % this is considerably faster; especially in compiled version (see SLOT-PERFORMANCE2)
240		% TODO: use force_clpfd_inlist ? clpfd_inlist uses try_post_constraint
241		in_non_ground_fd_value_lists(Element,List,_EWF,_Path) :-
242		tools:exact_member(Element,List), % avoid generating choice point for element position below
243		!.
244		in_non_ground_fd_value_lists(Element,List,EWF,_Path) :-
245		% asserts that Element is the _Nr-th element of List; in contrast to clpfd_inlist List do not have to be numbers
246		post_clpfd_element(List,Element,EWF).
247
248
249		% we cannot use new element/2 constraint in SICStus 4.7.0, because this will not enumerate the Idx before infinite enumeration starts (cf test 2070)
250		post_clpfd_element(List,Element,EWF) :-
251		element(Nr,List,Element),
252		label_el_nr(Nr,Element,List,EWF).
253
254
255
256		/* using this + Element in Min..Max
257		does not seem to buy anything/ a lot to comparing calling clpfd_inlist for large lists
258		ground_number_list([],0,0,0).
259		ground_number_list([H|T],Min,Max,Len) :- number(H),
260		ground_number_list_acc(T,H,H,1,Min,Max,Len).
261		ground_number_list_acc([],Min,Max,Len,Min,Max,Len).
262		ground_number_list_acc([H|T],Min0,Max0,Len0,Min,Max,Len) :- number(H),
263		(H<Min0 -> Min1 = H ; Min1 = Min0),
264		(H>Max0 -> Max1 = H ; Max1 = Max0),
265		L1 is Len0+1,
266		ground_number_list_acc(T,Min1,Max1,L1,Min,Max,Len).
267		*/
268
269		treat_fd_rec_fields([],_,_).
270		treat_fd_rec_fields([V|TF],List,EWF) :-
271		get_next_fd_rec_field(List,FieldFDList,RemainingList),
272		%print(check(V,FieldFDList)),nl,
273		in_non_ground_fd_value_lists(V,FieldFDList,EWF,rec),
274		treat_fd_rec_fields(TF,RemainingList,EWF).
275
276		get_next_fd_rec_field([],FieldList,RemList) :- !, FieldList=[], RemList=[].
277		get_next_fd_rec_field([fd_rec([FDV|Rem]) | TList], [FDV|TFieldList], [ fd_rec(Rem) | TRemList]) :- !,
278		get_next_fd_rec_field(TList, TFieldList, TRemList).
279		get_next_fd_rec_field(List,FieldList,RemainingList) :-
280		add_internal_error('Illegal call: ',get_next_fd_rec_field(List,FieldList,RemainingList)),
281		FieldList=[], RemainingList=[].
282
283		% label ElementNr of element/3 clpfd constraint if necessary
284		% Note: ElementNr is a local variable not used outside of in_non_ground_fd_value_lists
285		:- block label_el_nr(?,-,?,?), label_el_nr(-,?,?,-).
286		label_el_nr(ElementNr,Element,List,_) :-
287		(number(ElementNr) -> true % clpfd:element already has a solution
288		; exact_member_nr(Element,List,1,Nr) -> ElementNr=Nr
289		; \+ fd_var(ElementNr) -> print(already_enumerating(Element,ElementNr)),nl
290		% probably co-routine got activated while enumerating Element and clpfd has not yet set ElementNr,
291		% but clpfd has removed the fd domain
292		; ground(List) -> (labeling([],[ElementNr]) -> true) % avoid pending co-routines in case the Element appears multiple times in the list by picking an arbitrary solution !)
293		; %translate:print_clpfd_variable(ElementNr),nl,
294		labeling([],[ElementNr]) % enumerate ElementNr -> before infinite enumeration we chose possible values
295		% we cannot use cut after labeling, labeling ElementNr can instantiate List
296		% example where this is needed, {r|3 : {r,r+1} } in CLPFD=TRUE mode
297		).
298
299		exact_member_nr(X,[Y|_],Acc,R) :- X==Y, !, Acc=R.
300		exact_member_nr(X,[_|T],Acc,R) :- A1 is Acc+1, exact_member_nr(X,T,A1,R).
301
302		split_fd_pair_list([],[],[]).
303		split_fd_pair_list([fd_pair(A,B)|T],[A|TA],[B|TB]) :- split_fd_pair_list(T,TA,TB).
304
305
306		% -----------------------------------------------------
307
308		:- use_module(kernel_objects,[equal_object/2]).
309
310		% a lazy, blocking version which waits for Set to become sufficiently instantiated and then
311		% calls in_fd_value_list_wf
312		% Trys to transform E:Set into calls to clpfd library: ;
313		% When FullyChecked becomes true, then there is no need to perform other processing (apart from labeling/enumeration of the involved values)
314		% When FullyChecked becomes false
315		lazy_fd_value_check(Set,E,_,FC) :- nonvar(Set), Set=[H|T], T==[],
316		!, % we have a one-element singleton set
317		%tools_printing:print_term_summary(equal_object(H,E)),nl,
318		equal_object(H,E),
319		FC=true.
320		lazy_fd_value_check(Set,E,WF,FullyChecked) :- preferences:preference(use_clpfd_solver,true),!,
321		lazy_in_list_propagation_block(Set,E,WF,FullyChecked).
322		lazy_fd_value_check(_Set,_E,_WF,false).
323
324		:- block lazy_in_list_propagation_block(-,?,?,?).
325		lazy_in_list_propagation_block([],_,_,_) :- fail. % nothing can be element of empty set
326		lazy_in_list_propagation_block([H|T],E,WF,FullyChecked) :- contains_fd_element(H,Res,WF),
327		lazy_in_list_propagation_block_2(Res,H,T,E,WF,FullyChecked).
328
329		:- block lazy_in_list_propagation_block_2(-,?,?,?,?,?).
330		lazy_in_list_propagation_block_2(pred_false,_H,_T,_E,_WF,false). % nothing to propagate
331		lazy_in_list_propagation_block_2(pred_true,H,T,E,WF,FullyChecked) :- % print(bound_h(H)),nl,
332		bound_list(T,Bound),
333		lazy_in_list_propagation_block_3(Bound,H,T,E,WF,FullyChecked).
334
335		:- block lazy_in_list_propagation_block_3(-,?,?,?,?,?).
336		lazy_in_list_propagation_block_3(pred_false,_H,_T,_E,_WF,FC) :- !, FC=false. % nothing to propagate
337		lazy_in_list_propagation_block_3(pred_true,H,T,E,WF,FullyChecked) :-
338	?	try_get_fd_value_type(E,H,Type), % print(fd_val_type(E,H,Type)),nl,
339		get_fd_value_list([H|T],Type,FDVals,GroundList,E), % try and extract values which can be used for CLPFD
340		get_fd_value(Type,E,EFD),!,
341		FDVals \= [], % if we have the empty list then membership fails
342		(complete_type(Type) -> FullyChecked = true ; FullyChecked = false),
343		% print(lazy_in_element(FullyChecked,GroundList,E,[H|T],WF)),nl,
344		% print(in_fd_value_list_wf(GroundList,EFD,FDVals,WF,FullyChecked)),nl,
345		in_fd_value_list_wf(GroundList,EFD,FDVals,WF).
346		lazy_in_list_propagation_block_3(pred_true,_H,_T,_E,_WF,FullyChecked) :- !,
347		% should only happen for freeval with no fd type inside or for freevalues if element is not instantiated (we don't know which freval case we have)
348		FullyChecked=false.
349		lazy_in_list_propagation_block_3(P,H,T,E,WF,false) :-
350		add_internal_error('Illegal call: ',lazy_in_list_propagation_block_3(P,H,T,E,WF,false)).
351
352		:- block contains_fd_element(-,?,?).
353		contains_fd_element(int(_),R,_WF) :- !, R=pred_true.
354		contains_fd_element(fd(_,_),R,_WF) :- !, R=pred_true.
355		contains_fd_element((A,B),R,WF) :- !,contains_fd_element(A,RA,WF), contains_fd_element(B,RB,WF),
356		b_interpreter_check:disjoin(RA,RB,R,priority(16384),priority(16384),WF). % TO DO: examine priority to be used
357		contains_fd_element(rec(Fields),R,WF) :- !, contains_field_fd_el(Fields,R,WF).
358		contains_fd_element(freeval(_ID,_Case,_Val),R,_WF) :- !,
359		% We assume that a freetype can contain FD elements; TO DO: really check !
360		% ID is something of the form 'List'(integer) ; we use get_freeval_type(ID,_Case) from kernel_freetypes to get subtypes
361		% we could look at the value; but we could be unlucky in that this particular Case has no fd subtype but others do
362		% anyway: try_get_fd_value_type will fail if there is no fd type
363		R=pred_true.
364		contains_fd_element(_,pred_false,_).
365
366		:- block contains_field_fd_el(-,?,?).
367		contains_field_fd_el([],R,_WF) :- !, R=pred_false.
368		contains_field_fd_el([field(_,V)|_],R,WF) :- contains_fd_element(V,R,WF). % TO DO: look at other fields
369		% deal with freetypes: freeval(ID,Case,Value); but here we need a different scheme: we need to find the case of the element and only look at elements in the list with the same constructor
370		% we could also deal with set types {x,y} : { {1,2}, {2,3} } --> x/y : 1..3
371		% TO DO: maybe filter out non-matching elements also here (see filter_non_matching_elements for quick_propagate)
372
373		% set output variable as soon as we can determine if we have a bound list
374		:- block bound_list(-,?).
375		bound_list(List,BoundList) :-
376		(List = [] -> BoundList=pred_true
377		; List = [_|T] -> bound_list(T,BoundList)
378		; BoundList=pred_false). % we have avl_set or global_set or closure; TO DO: also allow avl_set
379
380
381		% -----------------------------------------------------
382
383		% generate an in_fd_value_list_wf call for checking that E is a member of an AVL set encoding
384		:- use_module(library(avl),[avl_domain/2]).
385		avl_fd_value_check(AVL,E,WF,FullyChecked) :-
386		AVL = node(TopEl,_True,_,_,_),!,
387		contains_fd_element(TopEl,Res,WF),
388		(Res==pred_true
389		-> avl_domain(AVL,DomainList),
390		DomainList = [H|T],
391		lazy_in_list_propagation_block_3(pred_true,H,T,E,WF,FullyChecked)
392		; FullyChecked=false).
393		avl_fd_value_check(AVL,E,WF,FullyChecked) :-
394		add_internal_error('Illegal call: ',avl_fd_value_check(AVL,E,WF,FullyChecked)),
395		FullyChecked=false.
396
397
398
399
400		% ------------------------------------------------------------------------
401
402		% alternative utilities for collecting fd_set information, combine it and then use it
403
404		% FD-SET
405
406		% succeeds if we can obtain FD information for a B data value
407		get_fdset_information(V,Info) :- var(V),!,Info=no_fdset_info.
408		get_fdset_information(int(V),int_fdset(FDSET)) :- fd_set(V,FDSET).
409		get_fdset_information(fd(V,GS),fd_fdset(FDSET,GS)) :- fd_set(V,FDSET).
410		get_fdset_information(pred_true,single_value(pred_true)).
411		get_fdset_information(pred_false,single_value(pred_false)).
412		get_fdset_information(string(S),single_value(string(S))) :- ground(S).
413		% TO DO: add more: couples, records, ...
414
415		get_finite_fdset_information(V,_Info) :- var(V),!,fail.
416		get_finite_fdset_information(int(V),int_fdset(FDSET)) :- finite_fd_set(V,FDSET).
417		get_finite_fdset_information(fd(V,GS),fd_fdset(FDSET,GS)) :- finite_fd_set(V,FDSET).
418		get_finite_fdset_information(pred_true,single_value(pred_true)).
419		get_finite_fdset_information(pred_false,single_value(pred_false)).
420		get_finite_fdset_information(string(S),single_value(string(S))) :- ground(S).
421
422		finite_fd_set(V,FDSET) :- fd_set(V,FDSET), fdset_size(FDSET,N), number(N). %FDSET \= [[inf|sup]].
423
424		% will combine (union) two FD infos; have to be of compatible type
425		combine_fdset_information(no_fdset_info,I,R) :- !, R=I.
426		combine_fdset_information(I,no_fdset_info,R) :- !, R=I.
427		combine_fdset_information(int_fdset(A),int_fdset(B),int_fdset(C)) :- !,
428		%print(un(A,B,C)),nl,
429		fdset_union(A,B,C).
430		combine_fdset_information(fd_fdset(A,GS),fd_fdset(B,GS),fd_fdset(C,GS)) :- !,
431		fdset_union(A,B,C).
432		combine_fdset_information(single_value(V),single_value(W),R) :- !,
433		(V==W -> R=single_value(V) ; R=no_fdset_info).
434		combine_fdset_information(A,B,C) :-
435		add_internal_error('Illegal FD info: ',combine_fdset_information(A,B,C)),fail.
436
437		% assert that a variable/value matches collected FD information
438		assert_fdset_information(int_fdset(FDSet),X) :- !,
439		(ground(X) -> true ; X=int(XX),in_set(XX,FDSet)).
440		assert_fdset_information(fd_fdset(FDSet,GS),X) :- !,
441		(ground(X) -> true ; X=fd(XX,GS),in_set(XX,FDSet)).
442		assert_fdset_information(single_value(V),X) :- !, equal_object(V,X).
443		assert_fdset_information(_,_).
444
445
446