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