1% BEGIN LICENSE BLOCK
2% Version: CMPL 1.1
3%
4% The contents of this file are subject to the Cisco-style Mozilla Public
5% License Version 1.1 (the "License"); you may not use this file except
6% in compliance with the License.  You may obtain a copy of the License
7% at www.eclipse-clp.org/license.
8%
9% Software distributed under the License is distributed on an "AS IS"
10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
11% the License for the specific language governing rights and limitations
12% under the License.
13%
14% The Original Code is  The ECLiPSe Constraint Logic Programming System.
15% The Initial Developer of the Original Code is  Cisco Systems, Inc.
16% Portions created by the Initial Developer are
17% Copyright (C) 1995-2006 Cisco Systems, Inc.  All Rights Reserved.
18%
19% Contributor(s):
20%
21% END LICENSE BLOCK
22% ----------------------------------------------------------------------
23% System:	ECLiPSe Constraint Logic Programming System
24% Version:	$Id: ilog.pl,v 1.1 2006/09/23 01:54:04 snovello Exp $
25% ----------------------------------------------------------------------
26
27% $Id: ilog.pl,v 1.1 2006/09/23 01:54:04 snovello Exp $
28
29:- module_interface(ilog).
30
31:- lib(structures).
32
33:- export
34      dvar_domain/2,
35      is_domain/1,
36      dom_range/3,
37      dom_size/2,
38      dom_member/2,
39      dom_check_in/2,
40      dom_compare/3,
41      dom_intersection/4,
42      dom_difference/4,
43      dom_union/4,
44      dom_copy/4,
45      domain_msg/3,
46      var_fd/2,
47      list_to_dom/2,
48      sorted_list_to_dom/2,
49      integer_list_to_dom/2,
50      ilog_init/0,
51      ilog_intvar/3,
52      ilog_intvar/2,
53      ilog_add/1,
54      ilog_info/0,
55      dvar_attribute/2,
56      default_domain/1,
57      setmin/1,
58      removemin/1.
59
60:- export ilog_var_print/2.
61
62% Must be COHERENT with ilog.cc (VARIABLE_INDEX, ...)
63:- define_struct(fd(domain, variable, min, max, any)).
64:- meta_attribute(fd, [
65        print:ilog_var_print/2,
66        copy_term: copy_term_domain/2,
67	unify:unify_ilog/2]).
68
69:- begin_module(ilog).
70
71
72:- op(600, xfx, [..]).
73
74:- import
75	call_priority/3,
76	setarg/3,
77	suspensions/1,
78	symbol_address/2
79    from sepia_kernel.
80
81:-
82   ( symbol_address(c_ilog_init, _) ->
83       true
84   ;
85       write("loading ILOG ... "), flush(output),
86       get_flag(hostarch, Arch),
87       get_flag(object_suffix, O),
88       ( O = "o" ->
89	   concat_string([Arch,'/ilog.',O,' -lm'], Load)
90       ;
91	   concat_string([Arch,'/ilog.',O], Load)
92       ),
93       load(Load),
94       writeln(done)
95   ),
96   external(ext_ilog_init/1, c_ilog_init),
97   external(ilog_info/0, c_ilog_print_info),
98   external(ilog_range_var/4, c_ilog_intvar),
99   external(ilog_enum_var/3, c_ilog_enum_var),
100   external(ilog_copy_var/3, c_ilog_copy_var),
101   external(ilog_get_range/3, c_ilog_get_range),
102   external(ilog_get_size/2, c_ilog_get_size),
103   external(ilog_get_domain/2, c_ilog_get_domain),
104   external(ext_ilog_set_value/3, c_ilog_set_value),
105   external(ilog_eq_vars/3, c_ilog_eq_vars),
106   external(ilog_add/2, c_ilog_add),
107   external(ilog_setmin/2, c_ilog_setmin),
108   external(ilog_removemin/2, c_ilog_removemin),
109   external(ilog_is_intvar/1, c_ilog_is_intvar),
110   make_array(ilog_handle, global_reference).
111
112ilog_init :-
113  ext_ilog_init(H),
114  setval(ilog_handle, H).
115
116unify_ilog(_Term, Attr) :-
117  var(Attr).		% Ignore if no attribute for this extension
118unify_ilog(Term, Attr) :-
119  compound(Attr),
120  unify_term_ilog(Term, Attr).
121
122:- mode unify_term_ilog(?, +).
123unify_term_ilog(X, fd with [domain:Id]) :-
124  integer(X), !,		% The variable was instantiated
125  ilog_id_set_value(Id, X).
126unify_term_ilog(Y, AttrX) :-
127  get_ilog_attr(Y, AttrY),
128  unify_ilog_ilog(Y, AttrX, AttrY).
129
130unify_ilog_ilog(Y, AttrX, AttrY) :-
131  var(AttrY), 		% No attribute for this extension
132  AttrX = AttrY,		% Transfer the attribute
133  notify_constrained(Y).
134unify_ilog_ilog(_Y, fd with [domain:IdX], AttrY) :-
135  nonvar(AttrY),
136  AttrY = fd with [domain:IdY],
137  getval(ilog_handle, H),
138  ilog_eq_vars(H, IdX, IdY).
139
140
141
142%----------------------------------------------------------------
143% print
144%----------------------------------------------------------------
145
146
147ilog_var_print(Var, IlogDomain) :-
148  get_ilog_attr(Var, fd with [domain:Id]),
149  ilog_get_domain(Id, IlogDomain).
150
151
152
153%----------------------------------------------------------------
154% copy_term
155%----------------------------------------------------------------
156
157copy_term_domain(X{fd:AttrX}, Copy) :-
158    -?->
159    copy_term_domain(X, Copy, AttrX).
160
161
162copy_term_domain(_, _, AttrX) :-
163    /*** VAR ***/
164    var(AttrX).
165copy_term_domain(_, Copy, fd with domain:IlogId1) :-
166    -?->
167    /*** META ***/
168    set_ilog_attr(Copy, IlogId2, Attr),
169    ilog_copy_var(Attr, IlogId2, IlogId1).
170
171empty_domain(D, fd with [domain:D, any:[], min:[], max:[]]).
172
173
174ilog_id_set_value(Id, Val) :-
175  getval(ilog_handle, H),
176  ext_ilog_set_value(H, Id, Val).
177
178ilog_intvar(Var, Min, Max) :-
179  set_ilog_attr(V, Id, Attr),
180  ilog_range_var(Attr, Id, Min, Max),
181  V = Var. % To get correct behaviour if Var is instantiated or constrained
182
183ilog_intvar(Var, Values) :-
184  set_ilog_attr(V, Id, Attr),
185  ilog_enum_var(Attr, Id, Values),
186  V = Var. % To get correct behaviour if Var is instantiated or constrained
187
188get_ilog_attr(_{fd:Attr}, A) :-
189  -?->
190  A = Attr.
191
192
193dvar_attribute(I, A) :-
194  integer(I), !,
195  A = fd with [domain:I, min:[], max:[], any:[]].
196dvar_attribute(I, A) :-
197  get_ilog_attr(I, A).
198
199is_domain(X) :-
200  get_ilog_attr(X, A),
201  nonvar(A).
202
203set_ilog_attr(Var, IlogHandle, Attr) :-
204  -?->
205  Attr = fd with [domain:IlogHandle,variable:Var],
206  init_suspension_list(min of fd, Attr),
207  init_suspension_list(max of fd, Attr),
208  init_suspension_list(any of fd, Attr),
209  add_attribute(Var, Attr, fd).
210
211default_domain(V) :-
212  ilog_intvar(V, -10000000, 10000000).
213
214
215ec_vars2ilog_vars(VE, VI) :-
216  var(VE), !,
217  ( get_ilog_attr(VE, fd with domain:VI) -> true
218  ;
219    default_domain(VE),
220    get_ilog_attr(VE, fd with domain:VI)
221  ).
222ec_vars2ilog_vars(TermE, TermI) :-
223  functor(TermE, F, N), functor(TermI, F, N),
224  ( foreacharg(VE, TermE), foreacharg(VI, TermI)
225  do
226    ec_vars2ilog_vars(VE, VI)
227  ).
228
229ilog_add(C) :-
230  getval(ilog_handle, H),
231  ec_vars2ilog_vars(C, CI),
232  ilog_add(H, CI),
233  wake.
234
235dvar_domain(X, I) :-
236  integer(X), !,
237  I = X.
238dvar_domain(X, I) :-
239  get_ilog_attr(X, fd with domain:I).
240
241dom_range(I, Min, Max) :-
242  integer(I), !,
243  Min = I, Max = I.
244dom_range(I, Min, Max) :-
245  ilog_get_range(I, Min, Max).
246
247dom_size(I, Size) :-
248  integer(I), !,
249  Size=1.
250dom_size(I, Size) :-
251  ilog_get_size(I, Size).
252
253
254
255setmin(X) :-
256  integer(X), !.
257setmin(X) :-
258  get_ilog_attr(X, fd with [domain:I]),
259  getval(ilog_handle, H),
260  ilog_setmin(H, I).
261  % wake not necessary because an instanciation occurs ?
262
263removemin(X) :-
264  integer(X), !, fail.
265removemin(X) :-
266  get_ilog_attr(X, fd with [domain:I]),
267  getval(ilog_handle, H),
268  ilog_removemin(H, I),
269  wake.
270
271
272%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
273% Unefficient domain operations
274%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
275
276
277% mode(+Integer or Handle, ? List of intervals)
278get_domain(Dom, Domain) :-
279  integer(Dom), !,
280  Domain = [Dom].
281get_domain(Dom, Domain) :-
282  ilog_get_domain(Dom, Domain).
283
284
285
286dom_check_in(X, Dom) :-
287  dom_member(X, Dom), !.
288
289
290dom_member(Element, Dom) :-
291  get_domain(Dom, IlogDomain),
292  member(X, IlogDomain),
293  ( integer(X), Element = X
294  ; X = Min..Max,
295    between(Min, Max, 1, Element)
296  ).
297
298dom_compare(Res, Dom1, Dom2) :-
299  get_domain(Dom1, IlogDomain1),
300  get_domain(Dom2, IlogDomain2),
301  ( IlogDomain1 = IlogDomain2 -> Res = (=)
302  ; domain_intersection(IlogDomain1, IlogDomain2, Intersection),
303    ( IlogDomain1 = Intersection -> Res = (<)
304    ; IlogDomain2 = Intersection -> Res = (>)
305    ; fail
306    )
307  ).
308
309dom_intersection(Dom1, Dom2, Intersection, Size) :-
310  get_domain(Dom1, IlogDomain1),
311  get_domain(Dom2, IlogDomain2),
312  domain_intersection(IlogDomain1, IlogDomain2, IlogDomain),
313  flat_domain(IlogDomain, Values),
314  ilog_intvar(Dummy, Values),
315  dvar_domain(Dummy, Intersection),
316  dom_size(Intersection, Size).
317
318dom_union(Dom1, Dom2, Intersection, Size) :-
319  get_domain(Dom1, IlogDomain1),
320  get_domain(Dom2, IlogDomain2),
321  domain_union(IlogDomain1, IlogDomain2, IlogDomain),
322  flat_domain(IlogDomain, Values),
323  ilog_intvar(Dummy, Values),
324  dvar_domain(Dummy, Intersection),
325  dom_size(Intersection, Size).
326
327
328dom_difference(Dom1, Dom2, Intersection, Size) :-
329  get_domain(Dom1, IlogDomain1),
330  get_domain(Dom2, IlogDomain2),
331  domain_difference(IlogDomain1, IlogDomain2, IlogDomain),
332  flat_domain(IlogDomain, Values),
333  ilog_intvar(Dummy, Values),
334  dvar_domain(Dummy, Intersection),
335  dom_size(Intersection, Size).
336
337:- mode(dom_copy(+, -)).
338dom_copy(Dom1, Dom2) :-
339  var_fd(Dummy, Dom1),
340  dvar_domain(Dummy, Dom2).
341
342list_to_dom(Values, Dom) :-
343  ilog_intvar(Dummy, Values),
344  dvar_domain(Dummy, Dom).
345
346
347integer_list_to_dom(Values, Dom) :- list_to_dom(Values, Dom).
348sorted_list_to_dom(Values, Dom) :- list_to_dom(Values, Dom).
349
350var_fd(Var, Dom) :-
351  var(Var),
352  set_ilog_attr(New, IlogId, Attr),
353  ilog_copy_var(Attr, IlogId, Dom),
354  Var = New.
355
356domain_msg(V1, V2, Msg) :-
357  dvar_domain(V1, Dom1), get_domain(Dom1, L1),
358  dvar_domain(V2, Dom2), get_domain(Dom2, L2),
359  domain_union(L1, L2, L, _),
360  flat_domain(L, Values),
361  ilog_intvar(Msg, Values).
362
363
364domain_intersection([], _, []).
365domain_intersection(_, [], []) :- !.
366domain_intersection([X1|Xs1], [X2|Xs2], I) :-
367  ( integer(X1) ->
368      ( integer(X2) ->
369	  ( X1 = X2 -> I = [X1 | I0], domain_intersection(Xs1,Xs2,I0)
370          ; X1 < X2 -> domain_intersection(Xs1, [X2|Xs2], I)
371          ; /* X1 > X2 */ domain_intersection([X1|Xs1], Xs2, I)
372          )
373      ; X2 = Min2..Max2,
374          ( Min2 > Max2 -> domain_intersection([X1|Xs1], Xs2, I)
375          ; X1 < Min2 -> domain_intersection(Xs1, [X2|Xs2], I)
376          ; X1 > Max2 -> domain_intersection([X1|Xs1], Xs2, I)
377          ; X1 = Max2 -> I = [X1 | I0], domain_intersection(Xs1,Xs2,I0)
378          ; /* X1 < Max2, X1>Min2*/
379              I=[X1|I0], domain_intersection(Xs1,[X2|Xs2],I0)
380          )
381      )
382  ; X1 = Min1..Max1,
383    ( Min1 > Max1 -> domain_intersection(Xs1, [X2|Xs2], I)
384    ; integer(X2) ->
385	domain_intersection([X2|Xs2], [X1|Xs1], I)
386    ;
387	X2=Min2..Max2,
388        ( Min2 > Max2 -> domain_intersection([X1|Xs1], Xs2, I)
389        ; Max1 < Min2 -> domain_intersection(Xs1, [X2|Xs2], I)
390        ; Max2 < Min1 -> domain_intersection([X1|Xs1], Xs2, I)
391        ; Min is max(Min1, Min2), Max is min(Max1, Max2),
392          ( Min = Max -> I = [Min | I0]
393          ; Min < Max -> I = [Min..Max| I0]
394          ; I = I0
395          ),
396          Max_1 is Max + 1,
397          domain_intersection([Max_1..Max1|Xs1], [Max_1..Max2|Xs2], I)
398        )
399    )
400  ).
401
402
403domain_union([], Xs2, Xs2).
404domain_union(Xs1, [], Xs1) :- !.
405domain_union([X1|Xs1], [X2|Xs2], U) :-
406  ( integer(X1) ->
407      ( integer(X2) ->
408	  ( X1 = X2 -> I = [X1 | U0], domain_union(Xs1,Xs2,U0)
409          ; X1 < X2 -> I = [X1 | U0], domain_union(Xs1, [X2|Xs2], U0)
410          ; /* X1 > X2 */ I = [X2 | U0], domain_union([X1|Xs1], Xs2, U0)
411          )
412      ; X2 = Min2..Max2,
413          ( X1 < Min2 -> I = [X1 | U0], domain_union(Xs1, [X2|Xs2], U0)
414          ; X1 > Max2 -> I = [X2 | U0], domain_union([X1|Xs1], Xs2, U0)
415          ; /* X1 <= Max2, X1>/Min2*/ domain_union(Xs1,[X2|Xs2],U)
416          )
417      )
418  ; X1 = Min1..Max1,
419    ( integer(X2) ->
420	domain_union([X2|Xs2], [X1|Xs1], U)
421    ;
422	X2=Min2..Max2,
423        ( Max1 < Min2 -> U = [X1|U0], domain_union(Xs1, [X2|Xs2], U0)
424        ; Max2 < Min1 -> U = [X2|U0], domain_union([X1|Xs1], Xs2, U0)
425        ; Min is min(Min1, Min2), Max is max(Max1, Max2),
426          ( Max = Max1 -> domain_union([Min..Max|Xs1], Xs2, U)
427          ; /* Max=Max2 */ domain_union(Xs1, [Min..Max|Xs2], U)
428          )
429        )
430    )
431  ).
432
433
434
435
436
437
438
439
440flat_domain([], []).
441flat_domain([X | Xs], Values) :-
442  ( integer(X) ->
443      Values = [X | OtherValues]
444  ; X = Min..Max,
445    ( for(I, Min, Max), fromto(Values, [I|R], R, OtherValues) do true )
446  ),
447  flat_domain(Xs, OtherValues).
448
449
450:- ilog_init.
451