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) 1996 - 2006 Cisco Systems, Inc. All Rights Reserved. 18% 19% Contributor(s): Hani El-Sakkout, Stefano Novello and Joachim Schimpf, IC-Parc 20% 21% END LICENSE BLOCK 22% ---------------------------------------------------------------------- 23% 24% CLP Repair Library 25% 26% System: ECLiPSe Constraint Logic Programming System 27% Author/s: Hani El-Sakkout, Stefano Novello, Joachim Schimpf, IC-Parc 28% Version: $Id: repair.pl,v 1.4 2012/10/25 13:14:34 jschimpf Exp $ 29% 30% 31% EXTENSIONS 32% We consider variables with variable tentative value tenable. That's 33% because intially when the problem is being set up we don't want to 34% see constraints that are in conflict just because the tentative 35% value hasn't been set yet. 36% 37% Later, we may want to consider these constraints as being in conflict 38% since they have to be fixed either by labelling of by giving tentative 39% values. 40% 41% 42% CHANGES 43% Allowed constraints where not all variables have a tentative value 44% Such variables are considered tenable. 45% It means that tentative_ground may not ground completely if such 46% variables are present. 47% when testing, call such an almost ground constraint inside a not not 48% so that it does no binding. 49% this may cause unncessary propagations though. 50% 51% ---------------------------------------------------------------------- 52 53:- module(repair). 54 55% The repair handler should execute after the others, since it 56% wants to know the new domain of a variable to determine tenablity 57% at that point. This is useful in var var unification to choose 58% which tentative value to throw away, but not essential. 59% lib(repair) should occur first to achieve this ! 60 61:- meta_attribute(repair,[ 62 unify:repair_unify_handler/2, 63 print:print_repair/2, 64 suspensions:repair_suspensions_handler/3 65 ]). 66 67:- export op(900,xf,r). 68:- export op(900,xf,r_no_prop). 69:- export op(900,xf,r_prop). 70:- export op(900,xfx,(r_conflict)). 71:- export op(900,xfx,(r_conflict_prop)). 72:- export op(700,xfx,[tent_set,tent_get,tent_is]). 73 74:- export 75 (tent_set)/2, 76 (tent_get)/2, 77 (tent_call)/3,(tent_call)/4, 78 (tent_is)/2,(tent_is)/3, 79 tenable/1, 80 (r)/1, 81 (r_no_prop)/1, 82 (r_prop)/1, 83 (r_conflict)/2, 84 (r_conflict_prop)/2, 85 poss_conflict_vars/1, 86 conflict_constraints/1, 87 poss_conflict_vars/2, 88 conflict_constraints/2, 89 conflict_vars/1, 90 tentative_ground/2, 91 tr_monitors/2, 92 call_satisfied_constraints/0, 93 repair_stat/1. 94 95 96% Attribute 97 98:- export struct(repair( 99 tent, % tentative value 100 mon, % set element with suspension of monitor_tenable goal 101% to_unten, % suspensions to wake on becoming untenable 102 ga_chg % suspensions to wake on global asignment changes 103 )). 104 105% global_assignent(Term) = if var(Term) tentative_value(Term) else Term 106% conflict_vars = monitor_tenable suspensions of untenable vars 107% conflict_constraints = suspensions of repair constraints in conflict 108% satisfied = suspension of satisfied repair constraints. 109 110 111:- local struct(repair_state( 112 conflict_vars, 113 conflict_hash_constraints, 114 conflict_constraints)). 115:- local struct(monitor_conflict(constraint,annotation,conflict,prop,module)). 116:- local struct(tent_is_conflict(expr,annotation,sum,outsum,conflict,susp,module)). 117 118 119:- export portray(monitor_tenable/3, tr_monitors/2, [goal]). 120:- export portray(monitor_conflict/(property(arity) of monitor_conflict), tr_monitors/2, [goal]). 121 122tr_monitors(monitor_tenable(V,_,T), monitor_tenable(V,T)). 123tr_monitors(monitor_conflict{constraint:C}, monitor_conflict(C)). 124 125 126:- comment(categories, ["Constraints","Techniques"]). 127:- comment(summary, "Repair library: support for local search via tentative assignments and repair constraints"). 128:- comment(author, "Hani El-Sakkout, Stefano Novello, Joachim Schimpf"). 129:- comment(copyright, "Cisco Systems, Inc."). 130:- comment(date, "$Date: 2012/10/25 13:14:34 $"). 131 132:- comment(desc, html("\ 133The repair library provides a framework for the integration of repair-based 134search with the constraint consistency checking techniques of ECLiPSe. It 135allows the implementation of classical local search methods within a CLP 136environment. 137 138It provides two facilities: 139 140<UL> 141 142<LI> The maintenance of tentative values for problem variables. These 143 tentative values may together form a partial or even inconsistent 144 tentative assignment. Modifications to, or extensions of this 145 assignment may be applied until a correct solution is found. 146 147<LI> The monitoring of constraints (the so called repair constraints) 148 for being either satisfied or violated under the current tentative 149 assignment. Search algorithms can then access the set of 150 constraints that are violated at any point in the search, 151 and perform repairs by changing the tentative assignment 152 of the problem variables. 153 154</UL><P> 155Normally, the repair library communicates with another solver (such as fd or 156ria) to check for constraint violations.</P> 157<P> 158Tentative values can be visualised using the ECLiPSe visualisations tools. 159To do so, set up a viewable using viewable:viewable_create/3,4 and specify 160changeable(repair,Type) as its element type. 161</P> 162")). 163 164:- comment(index, ["local search", "tentative assignments"]). 165 166:- comment((r)/1, [ 167see_also: [(r_conflict)/2, (r_conflict_prop)/2], 168summary: "Obsolete: use r_conflict/2 and r_conflict_prop/2 instead." 169]). 170:- comment((r_no_prop)/1, [ 171see_also: [(r_conflict)/2, (r_conflict_prop)/2], 172summary: "Obsolete: use r_conflict/2 and r_conflict_prop/2 instead." 173]). 174:- comment((r_prop)/1, [ 175see_also: [(r_conflict)/2, (r_conflict_prop)/2], 176summary: "Obsolete: use r_conflict/2 and r_conflict_prop/2 instead." 177]). 178:- comment(conflict_constraints/1, [ 179see_also: [conflict_constraints/2], 180summary: "Obsolete: use conflict_constraints/2 instead." 181]). 182 183 184% ---------------------------------------------------------------------- 185 186:- pragma(nodebug). 187 188:- use_module(library(linearize)). 189:- use_module(library(hash)). 190 191:- import copy_term/3 from sepia_kernel. 192 193% DEBUG ------------------------------------------------------- 194 195 'ASSERT'(_). 196% 'ASSERT'(G) :- call(G). 197 198% Attribute ------------------------------------------------------- 199 200% :- meta_attribute(...) see above 201 202print_repair(X, TVal) :- 203 get_repair_attr(X, repair{tent:TVal}), 204 nonvar(TVal). 205 206repair_suspensions_handler(_{Attr}, Susps, Susps0) ?- 207 ( var(Attr) -> 208 Susps=Susps0 209 ; 210 Attr = repair{ga_chg:S}, 211 Susps = [S|Susps0] 212 ). 213 214 215repair_unify_handler(_, Attr) :- 216 var(Attr). 217 218repair_unify_handler(Term, Attr) :- 219 compound(Attr), 220 repair_unify_handler1(Term, Attr). 221 222repair_unify_handler1(Var{Attr1}, Attr2) :- 223 -?-> 224 !, 225 ( var(Attr1) -> 226 Attr1 = Attr2 % transfer the whole attribute 227 ; 228 Attr1 = repair{tent:TV1,mon:M1}, 229 Attr2 = repair{tent:TV2,mon:M2}, 230 'ASSERT'(writeln(unify_var_var(TV1,TV2))), 231 inc(var_var_unify), 232 ( TV1 == TV2 -> 233 kill_monitor(M2) 234 ; not_unify(Var , TV2) -> 235 % TV2 is untenable 236 kill_monitor(M2), 237 schedule_suspensions(ga_chg of repair,Attr2) 238 ; 239 ( not_unify(Var , TV1) -> 240 kill_monitor(M1), 241 setarg(tent of repair, Attr1, TV2), 242 setarg(mon of repair, Attr1, M2), 243 schedule_suspensions(ga_chg of repair,Attr1) 244 ; 245 kill_monitor(M2), 246 schedule_suspensions(ga_chg of repair,Attr2) 247 ) 248 ), 249% merge_suspension_lists(to_unten of repair,Attr2,to_unten of repair,Attr1), 250 merge_suspension_lists(ga_chg of repair,Attr2,ga_chg of repair,Attr1) 251 ). 252repair_unify_handler1(Nonvar, Attr) :- 253 Attr = repair{tent:TVal,mon:M}, 254 'ASSERT'(writeln(unify_nonvar_var(Nonvar,TVal))), 255 inc(nonvar_var_unify), 256 (var(TVal) -> 257 schedule_suspensions(ga_chg of repair,Attr) 258 ; 259 kill_monitor(M), 260 ( Nonvar == TVal -> 261 true 262 ; 263 % instantiated but not to tentative value 264 schedule_suspensions(ga_chg of repair,Attr) 265 ) 266 ). 267 268kill_monitor(EM) :- 269 elem_term(EM,M), 270 elem_del(EM), 271 kill_suspension(M). 272 273% Global state ------------------------------------------------------- 274 275% The conflict vars set is those variables that are untenable. All of these 276% must get labelled. 277% 278% The conflict constraints set contains constraints that are untenable. 279% All these must be fixed, by moving at least one variable of each 280% constraint into the conflict vars set. 281% an untenable constraint is one which is violated if all its 282% variables are set to their tentative values. 283% The global value conflict_constraints is a free variable. It is ensured 284% that its delayed goals list is exactly the conflict constraint set. 285 286:- local reference(repair_state). 287 288get_repair_state(S) :- 289 getval(repair_state, RepairState), 290 ( compound(RepairState) -> 291 S = RepairState 292 ; % needs initialisation 293 S = repair_state{ 294 conflict_vars:CVs, 295 conflict_constraints:CCs, 296 conflict_hash_constraints:H 297 }, 298 set_new(CVs), 299 set_new(CCs), 300 hash_create(H), 301 setval(repair_state, S) 302 ). 303 304get_repair_state(Field, F) :- 305 get_repair_state(S), 306 arg(Field, S, F). 307 308get_hashed_set(Key,Set) :- 309 ( var(Key) -> 310 set_new(Set), Key = Set 311 ; atom(Key) -> 312 get_repair_state(conflict_hash_constraints of repair_state, H), 313 ( hash_find(H,Key,Set) -> 314 true 315 ; 316 set_new(Set), 317 hash_add(H,Key,Set) 318 ) 319 ; 320 Key = Set 321 ). 322 323% ---------------------------------------------------------------------- 324% The general repair annotation: 325% 326% Goal r_conflict SetName 327% Goal r_conflict SetName-ConflictInfo 328% 329% Goal r_conflict_prop SetName 330% Goal r_conflict_prop SetName-ConflictInfo 331% like r_conflict but calls Goal when it goes into conflict 332% 333% Backward compatibility: 334% Goal r_no_prop 335% like r_conflict but using a global, unnamed conflict set 336% Goal r 337% like r_no_prop but calls Goal when it goes into conflict 338% Goal r_prop 339% like r_no_prop but eagerly calls Goal 340% ---------------------------------------------------------------------- 341 342% PRIORITIES 343% Make this low so that propagation comes first 344% make the almost ground check at a priority just higher than 345% monitor 346% Highest is tenability monitor since it is cheap and others 347% use the tenability flag that it sets. 348% Lower than propagation to avoid redoing it unnecessarily. 349% 350% All monitor_conflict does is collect the possible untenable variables 351% used for labelling so it can be done last. 352% 353% The disjunct needs a priority inbetween. 354% 355 356 357:- comment((r_conflict)/2, [ 358amode: r_conflict(+,?), 359template: "+Constraint r_conflict ?ConflictSet", 360args: ["Constraint":"Constraint to be monitored for conflict (Goal)", 361"ConflictSet": "Handle for the conflict set (atom or varibale) 362 argument can alternatively be ConflictSet-ConflictData" 363 ], 364summary: "Annotate Constraint as a repair constraint and monitor it for conflicts.", 365see_also: [conflict_constraints/2, (r_conflict_prop)/2], 366resat: no, 367eg: "\ 368% lib(fd) is loaded 369[eclipse 17]: A #= B r_conflict c , B tent_set 11, A tent_set 5, conflict_constraints(c, X). 370 371B = B{11} 372A = A{5} 373X = [A{5} #= B{11}] % the constraint is in conflict due to tentative values 374 375[eclipse 18]: A #= B r_conflict c , B = 11, A = 5, conflict_constraints(c, X). 376 377B = 11 378A = 5 379X = [5#=11] % the constraint is in conflict due to the values of the variables 380 381 A #= B r_conflict c, B tent_set 11, conflict_constraints(c, X). 382 383A = A 384B = B{11} 385X = [] % the constraint is not in conflict 386 387 A::[1..10], A #= B r_conflict c, B tent_set 11, conflict_constraints(c, X). 388 389A = A{[1..10]} 390B = B{11} 391X = [A{[1..10]} #= B{11}] 392 393[eclipse 26]: A::[1..10], A #= B r_conflict c, A #= B, B = 11, conflict_constraints(c, X). 394 395no (more) solution. 396% fails because A #= B is also set up as a normal constraint 397 398[eclipse 23]: A::[1..10], A #= B r_conflict c, A #= B, B tent_set 11, conflict_constraints(c, X). 399 400A = A{fd:[1..10], repair:11} 401B = A{fd:[1..10], repair:11} 402X = [A{fd:[1..10], repair:11} #= A] 403% does not fail because the normal A #= B does not consider tenative values 404", 405 406desc: html("\ 407<P> 408Repair constraints are constraints that are monitored by the repair library 409for conflicts caused by the tentative values of variables in the constraints. 410r_conflict/2 annotates a constraint to be a repair constraint, and performs 411the simplest form of monitoring for violation: the repair constraint is 412passive in that it simply waits for constraint to become violated due to 413bindings to its variables or their tentative values. In such a case, the 414constraint will show up in the ConflictSet, from where it can be 415retrieved using conflict_constraints/2. 416 417</P><P> 418Note that setting up a repair constraint does <EM>not</EM> propagate the 419constraint as a normal constraint as well. Call the constraint again 420without the annotation to propagate the constraint. 421 422</P><P> 423Constraint can be any goal that works logically, it should be useable 424as a ground check, and work on any instantiation pattern. Typically, 425it will be a constraint from some solver library. 426 427</P><P> 428ConflictSet can be a user-defined name (an atom) or it can be 429a variable in which case the system returns a conflict set handle that can 430later be passed to conflict_constraints/2. 431 432</P><P> 433Note that using different conflict sets for different groups of constraints 434will often make the search algorithm easier and more efficient. 435A second allowed form of the r_conflict annotation is 436Constraint r_conflict ConflictSet-ConflictData. 437If this is used, \bf ConflictData will appear in the conflict 438set instead of the Constraint itself. 439This feature can be used to pass additional information to the 440search algorithm. 441</P>") 442]). 443 444:- comment((r_conflict_prop)/2, [ 445amode: r_conflict_prop(+,?), 446template: "+Constraint r_conflict_prop ?ConflictSet", 447args: ["Constraint":"Constraint to be monitored for conflict (Goal)", 448"ConflictSet": "Handle for the conflict set (atom or varibale) 449 argument can alternatively be ConflictSet-ConflictData" 450 ], 451summary: "Annotate Constraint as a repair constraint and monitor it for conflicts. It is propagated when it goes into conflict.", 452see_also: [conflict_constraints/2, (r_conflict)/2], 453resat: no, 454eg: "\ 455 A #= B r_conflict_prop c, A = 5, writeln(1), B = 11, write(2), conflict_constraints(c, X). 456 4571 458 459no (more) solution. 460% fails because A #= B was propagated when a conflict was detected 461", 462desc: html("\ 463<P> 464Repair constraints are constraints that are monitored by the repair library 465for conflicts caused by the tentative values of variables in the constraints. 466r_conflict_prop/2 annotates a constraint to be a repair constraint, and 467as with r_conflict/2, monitors the constraint for conflicts. The difference 468is that when a violation is first detected and the Constraint enters the 469ConflictSet, it is actually propagated at that point by calling the constraint. 470 471</P><P> 472Note that if you want constraint propagation from the very beginning, 473you should simply write the constraint twice, once without and once 474with annotation. 475 476</P><P> 477Constraint can be any goal that works logically, it should be useable 478as a ground check, and work on any instantiation pattern. Typically, 479it will be a constraint from some solver library. 480 481</P><P> 482ConflictSet can be a user-defined name (an atom) or it can be 483a variable in which case the system returns a conflict set handle that can 484later be passed to conflict_constraints/2. 485 486</P><P> 487Note that using different conflict sets for different groups of constraints 488will often make the search algorithm easier and more efficient. 489A second allowed form of the r_conflict annotation is 490Constraint r_conflict ConflictSet-ConflictData. 491If this is used, \bf ConflictData will appear in the conflict 492set instead of the Constraint itself. 493This feature can be used to pass additional information to the 494search algorithm. 495</P>") 496]). 497 498 499:- tool((r_conflict)/2, (r_conflict)/3). 500r_conflict(Constraint,SetName-Annotation,Module) ?- !, 501 get_hashed_set(SetName,Set), 502 r_conflict(Constraint,Set,Annotation,1,Module). 503r_conflict(Constraint,SetName,Module) :- 504 get_hashed_set(SetName,Set), 505 r_conflict(Constraint,Set,Constraint,1,Module). 506 507:- tool((r_conflict_prop)/2, (r_conflict_prop)/3). 508r_conflict_prop(Constraint,SetName-Annotation,Module) ?- !, 509 get_hashed_set(SetName,Set), 510 r_conflict(Constraint,Set,Annotation,0,Module). 511r_conflict_prop(Constraint,SetName,Module) :- 512 get_hashed_set(SetName,Set), 513 r_conflict(Constraint,Set,Constraint,0,Module). 514 515 516% We treat the arithmetic constraints specially, using tent_is/2 to 517% evaluate the arithmetic expressions efficiently. Note that the auxiliary 518% result variable of the tent_is cannot be accessed by the user and can 519% therefore be assumed to remain a variable. 520 521%r_conflict((Val #:= Expr),Set,Annotation,Prop,Module) ?- 522% !, 523% tent_is_(Set,Val,Expr,Annotation,Module). 524%r_conflict(#?(Goal,B),Set,Annotation,Prop,Module) ?- 525% !, 526% tent_call(Goal,B,#?(Goal,B),Module). 527% tent_isd_(Set,B,Goal,Annotation,Module). 528r_conflict(Goal, Set, Annotation, Prop, Module) :- 529 arith_constraint(Goal, LeftExpr, RightExpr, NewGoal, Left, Right), 530 !, 531 tent_is(Left,LeftExpr,Module), 532 unify_to_tent_if_ground_args(Left, LeftExpr), 533 tent_is(Right,RightExpr,Module), 534 unify_to_tent_if_ground_args(Right, RightExpr), 535 setup_conflict_monitor(Set,NewGoal,Annotation,Prop,Module). 536r_conflict(Goal,Set,Annotation,Prop,Module) :- 537 setup_conflict_monitor(Set,Goal,Annotation,Prop,Module). 538 539 :- mode arith_constraint(?,-,-,-,-,-). 540 arith_constraint(Cstr, _, _, _, _, _) :- var(Cstr), !, fail. 541 arith_constraint(X < Y, X, Y, suspend:(X1 < Y1), X1, Y1) :- !. 542 arith_constraint(X > Y, X, Y, suspend:(X1 > Y1), X1, Y1) :- !. 543 arith_constraint(X =< Y, X, Y, suspend:(X1 =< Y1), X1, Y1) :- !. 544 arith_constraint(X >= Y, X, Y, suspend:(X1 >= Y1), X1, Y1) :- !. 545 arith_constraint(X =:= Y, X, Y, suspend:(X1 =:= Y1), X1, Y1) :- !. 546 arith_constraint(X =\= Y, X, Y, suspend:(X1 =\= Y1), X1, Y1) :- !. 547 arith_constraint(M : Goal, X, Y, M : Goal1, X1, Y1) :- !, 548 arith_constraint1(Goal, X, Y, Goal1, X1, Y1). 549 arith_constraint(Goal, X, Y, Goal1, X1, Y1) :- 550 arith_constraint1(Goal, X, Y, Goal1, X1, Y1). 551 552 :- mode arith_constraint1(?,-,-,-,-,-). 553 arith_constraint1(Cstr, _, _, _, _, _) :- var(Cstr), !, fail. 554 arith_constraint1(X < Y, X, Y, X1 < Y1, X1, Y1). 555 arith_constraint1(X > Y, X, Y, X1 > Y1, X1, Y1). 556 arith_constraint1(X =< Y, X, Y, X1 =< Y1, X1, Y1). 557 arith_constraint1(X >= Y, X, Y, X1 >= Y1, X1, Y1). 558 arith_constraint1(X =:= Y, X, Y, X1 =:= Y1, X1, Y1). 559 arith_constraint1(X =\= Y, X, Y, X1 =\= Y1, X1, Y1). 560 arith_constraint1(<(X,Y,B), X, Y, <(X1,Y1,B), X1, Y1). 561 arith_constraint1(>(X,Y,B), X, Y, >(X1,Y1,B), X1, Y1). 562 arith_constraint1(=<(X,Y,B), X, Y, =<(X1,Y1,B), X1, Y1). 563 arith_constraint1(>=(X,Y,B), X, Y, >=(X1,Y1,B), X1, Y1). 564 arith_constraint1(=:=(X,Y,B), X, Y, =:=(X1,Y1,B), X1, Y1). 565 arith_constraint1(=\=(X,Y,B), X, Y, =\=(X1,Y1,B), X1, Y1). 566 arith_constraint1($<(X,Y), X, Y, $<(X1,Y1), X1, Y1). 567 arith_constraint1($>(X,Y), X, Y, $>(X1,Y1), X1, Y1). 568 arith_constraint1($=<(X,Y), X, Y, $=<(X1,Y1), X1, Y1). 569 arith_constraint1($>=(X,Y), X, Y, $>=(X1,Y1), X1, Y1). 570 arith_constraint1($=(X,Y), X, Y, $=(X1,Y1), X1, Y1). 571 arith_constraint1($\=(X,Y), X, Y, $\=(X1,Y1), X1, Y1). 572 arith_constraint1($<(X,Y,B), X, Y, $<(X1,Y1,B), X1, Y1). 573 arith_constraint1($>(X,Y,B), X, Y, $>(X1,Y1,B), X1, Y1). 574 arith_constraint1($=<(X,Y,B), X, Y, $=<(X1,Y1,B), X1, Y1). 575 arith_constraint1($>=(X,Y,B), X, Y, $>=(X1,Y1,B), X1, Y1). 576 arith_constraint1($=(X,Y,B), X, Y, $=(X1,Y1,B), X1, Y1). 577 arith_constraint1($\=(X,Y,B), X, Y, $\=(X1,Y1,B), X1, Y1). 578 arith_constraint1(X #< Y, X, Y, X1 #< Y1, X1, Y1). 579 arith_constraint1(X #> Y, X, Y, X1 #> Y1, X1, Y1). 580 arith_constraint1(X #=< Y, X, Y, X1 #=< Y1, X1, Y1). 581 arith_constraint1(X #<= Y, X, Y, X1 #<= Y1, X1, Y1). 582 arith_constraint1(X #>= Y, X, Y, X1 #>= Y1, X1, Y1). 583 arith_constraint1(X #= Y, X, Y, X1 #= Y1, X1, Y1). 584 arith_constraint1(X #\= Y, X, Y, X1 #\= Y1, X1, Y1). 585 arith_constraint1(#<(X,Y,B), X, Y, #<(X1,Y1,B), X1, Y1). 586 arith_constraint1(#>(X,Y,B), X, Y, #>(X1,Y1,B), X1, Y1). 587 arith_constraint1(#=<(X,Y,B), X, Y, #=<(X1,Y1,B), X1, Y1). 588 arith_constraint1(#<=(X,Y,B), X, Y, #<=(X1,Y1,B), X1, Y1). 589 arith_constraint1(#>=(X,Y,B), X, Y, #>=(X1,Y1,B), X1, Y1). 590 arith_constraint1(#=(X,Y,B), X, Y, #=(X1,Y1,B), X1, Y1). 591 arith_constraint1(#\=(X,Y,B), X, Y, #\=(X1,Y1,B), X1, Y1). 592 593 594:- tool((r)/1, (r)/2). 595r(Constraint,Module) :- 596 get_repair_state(conflict_constraints of repair_state,ConfSet), 597 setup_conflict_monitor(ConfSet,Constraint,Constraint,0,Module). 598 599:- tool((r_no_prop)/1, (r_no_prop)/2). 600r_no_prop(Constraint,Module) :- 601 get_repair_state(conflict_constraints of repair_state,ConfSet), 602 setup_conflict_monitor(ConfSet,Constraint,Constraint,1,Module). 603 604:- tool((r_prop)/1, (r_prop)/2). 605r_prop(Constraint,Module) :- 606 get_repair_state(conflict_constraints of repair_state,ConfSet), 607 call(Constraint)@Module, 608 setup_conflict_monitor(ConfSet,Constraint,Constraint,1,Module). 609 610 611setup_conflict_monitor(ConfSet,Constraint,Annotation,PropFlag,Module) :- 612 term_variables(Constraint,Vars), 613 add_repair_attrs(Vars), 614 elem_new(Susp,ConfSet,ConfElem), 615 suspend( 616 monitor_conflict{ 617 constraint:Constraint, 618 annotation:Annotation, 619 conflict:ConfElem, 620 prop:PropFlag, 621 module:Module}, 622 8, 623 [Vars->constrained, Vars->ga_chg], 624 Susp), 625 schedule_woken([Susp]), 626 wake. 627 628% monitor_conflict/? keeps testing whether the constraint would be satisfied 629% when using the tentative values of its variables. It can be in three states: 630% - satisfied 631% - unsatisfied \ conflict 632% - unknown (contains untenable vars) / constraints 633% When the constraint is unsatisfied or unknown, it goes into the conflict 634% constraint set. Otherwise it goes into the satisfied constraint set. 635% A constraint can make many transitions between these states: 636% sat -untenable instantiation-> unsat 637% sat -untenability-> unknown 638% sat -tentative val change-> unsat/unknown 639% unsat -instantiation-> sat 640% unsat -untenability-> unknown 641% unsat -tentative val change-> sat/unknown 642% unknown -instantiation-> sat/unsat 643% unknown -tentative val change-> sat/unsat 644% 645 646:- demon(property(functor) of monitor_conflict). 647monitor_conflict{constraint:C,annotation:_Annotation, 648 conflict:ConfElem,prop:PropFlag,module:Module} :- 649 ( tentative_ground(C ,AlmostGroundConstraint,Vars), 650 not not call(AlmostGroundConstraint)@Module -> 651 elem_del(ConfElem), 652 ( novars == Vars -> 653 inc(wake_ground), 654 'ASSERT'(writeln(ground(C,PropFlag))), 655 % the constraint is ground so remove it 656 propagate(PropFlag,C,Module,ConfElem), 657 elem_term(ConfElem,Susp), 658 kill_suspension(Susp) 659 ; % ground check succeeds 660 inc(wake_satisfied), 661 'ASSERT'(writeln(satisfied(C,PropFlag))) 662 ) 663 ; 664 % ground check failed or no pssible global assignment 665 % the first time it finds a constraint is unsatisfiable 666 % it asserts the constraint. 667 inc(wake_conflict), 668 'ASSERT'(writeln(conflict(C,PropFlag))), 669 elem_add(ConfElem), 670 propagate(PropFlag,C,Module,ConfElem) 671 ). 672 673 674propagate(1,_,_,_). 675propagate(0,C,M,Elem):- 676 inc(propagate), 677 call(C)@M, 678 elem_term(Elem,Susp), 679 get_suspension_data(Susp, goal, Rep), 680 setarg(prop of monitor_conflict,Rep,1). 681 682 683% WasTenable = { yes,no } 684% keeps tracking the tenability of a variable. If a variable 685% becomes untenable it wakes the goals waiting for this 686% condition. 687 688% a suspension on a global ref is used get the untenable 689% variables 690 691% this may get killed it's 692% variable is unified with another variable. 693 694% the goal is only created for variables with a ground tentative value 695 696:- demon(monitor_tenable/3). 697monitor_tenable(Var, Attr, S) :- 698 S=s(WasTenable), 699 Attr = repair{tent:TVal,mon:EM}, 700 'ASSERT'((var(Var),writeln(mon(Var,TVal,WasTenable)))), 701 ( not_unify(Var , TVal) -> 702 ( WasTenable == yes -> 703 elem_add(EM), 704 setarg(1,S,no), 705 inc(monitor_to_untenable), 706 schedule_suspensions(ga_chg of repair,Attr), 707% schedule_suspensions(to_unten of repair,Attr), 708 wake 709 ; 710 inc(monitor_no_change) 711 ) 712 ; 713 (WasTenable == no -> 714 elem_del(EM), 715 inc(monitor_to_tenable), 716 setarg(1,S,yes) 717 ; 718 inc(monitor_no_change) 719 ) 720 ). 721 722 :- mode extract_variables(+,?). 723 extract_variables([],[]). 724 extract_variables([Susp|Susps],[V|Vs]) :- 725 get_suspension_data(Susp, goal, monitor_tenable(V,_,_)), 726 extract_variables(Susps,Vs). 727 728:- comment(tenable/1, [ 729amode: tenable(?), 730summary: "Check if Var is tenable.", 731args: ["Var":"Term"], 732fail_if: "Fails if Var is non-tenable.", 733see_also: [(tent_set)/2, conflict_vars/1], 734resat: no, 735eg: "\ 736% lib(fd) is loaded 737 738[eclipse 3]: X::1..5, X tent_set 3, tenable(X). % suceeds 739 740[eclipse 3]: X::1..5, X tent_set 7, tenable(X). % fails 741 742", 743 744desc: html("\ 745<P> 746Succeeds if Term is tenable. A Term is tenable if it does not contain any 747variables with tentative values which are inconsistent with any constraints 748involving thevariable. Note that variables with no tentative values are 749considered tenable.</P>") 750]). 751 752tenable(X{repair{tent:TVal}}) :- 753 -?-> 754 !, 755 not not_unify(X , TVal). 756tenable(_). 757 758% this construct the global assignment for Original in Copy. 759% AllVars = all variables in term 760% NoTenVars = all variables in term with no tentative value 761% Untenable = an untenable variable or [] 762% In the case that Untenable is a variable, no global assignment 763% was constructed and the Copy AllVars and NoTenVars parameters are 764% invalid. 765:- mode tentative_ground(?,?,-). 766tentative_ground(Original,Copy,Vars) :- 767 copy_term(Original,Copy,Pairs), 768 tentative_ground_pairs(Pairs,Vars). 769 770 :- mode tentative_ground_pairs(+,-). 771 tentative_ground_pairs([],novars). 772 tentative_ground_pairs([[Original|Copy]|Pairs],vars) :- 773 get_repair_attr(Original, Attr), 774 Attr = repair{tent:TVal}, 775 ( var(TVal) -> 776 copy_term(Original,Copy) 777 ; not_unify(Original , TVal) -> 778 fail 779 ; 780 TVal=Copy 781 ), 782 tentative_ground_pairs(Pairs,_). 783 784% This finds the global assignment for Term. If due to the 785% presence of a non-tenable variable there was no global assignment 786% it fails. 787% The global assignment is : 788% Replace tenable variables with their tentative values 789% Rename variables that have no tentative value (i.e. they keep their 790% domains and any important properties but are new variables with no 791% attached goals. 792tentative_ground(Term,GlobalAssignment) :- 793 tentative_ground(Term,GlobalAssignment,_). 794 795% tent_get/2 is like tentative_ground/2 but will not fail in the case of 796% presence of an untenable variable. Useful to know the tentative value 797% of untenable variables. 798:- comment((tent_get)/2, [ 799amode: tent_get(?,?), 800template: "?Vars tent_get ?Values", 801summary: "Query the tentative values of variables in Vars.", 802args: ["Vars": "Term typically with variables with tentative values", 803 "Values": "Term to receive tentative values of Vars." 804 ], 805fail_if: "Values does not unify with Vars with the tentative values filled in.", 806resat: no, 807see_also: [(tent_set)/2], 808desc: html("\ 809<P> 810Values is a copy of the term Vars with the tentative values filled in 811place of the variables. If a variable has no tentative value 812a variable is returned in its place. 813</P> 814<P> 815CAUTION: If a variable has no tentative value, it is not possible to 816give it a tentative value by binding that returned variable. 817tent_set/2 must be used instead. 818</P>") 819]). 820 821 822Var tent_get TVal :- 823 var(Var), 824 !, 825 get_repair_attr(Var,repair{tent:TVal0}), 826 ( var(TVal0) -> 827 true 828 ; 829 TVal = TVal0 830 ). 831 832Term tent_get TValTerm :- 833 compound(Term), 834 !, 835 functor(Term,F,A), 836 functor(TValTerm,F,A), 837 ( for(I,1,A), 838 param(Term,TValTerm) 839 do 840 arg(I,Term,Termi), 841 arg(I,TValTerm,TValTermi), 842 Termi tent_get TValTermi 843 ). 844Atomic tent_get Atomic. 845 846:- comment((tent_set)/2, [ 847amode: tent_set(?,++), 848template: "?Vars tent_set ++Values", 849args: ["Vars":"Term with variables (non-ground term)", 850 "Values":"Tentative values for variables in Vars (ground term)" 851 ], 852summary: "Assigns tentative values for the variables in a term.", 853see_also: [(tent_get)/2, tenable/1 854 ], 855fail_if: "Vars is non-unifiable with Values", 856resat: no, 857eg: " 858% lib(fd) is loaded 859 860[eclipse 3]: X::1..5, X tent_set 3. 861X = X{fd:[1..5], repair:3} % X is tenable 862 863[eclipse 3]: X::1..5, X tent_set 7. 864X = X{fd:[1..5], repair:7} % X is non-tenable 865", 866 867desc: html("\ 868<P> 869Associate tentative values with variables. Vars can be any non-ground term, 870and Values the corresponding ground term. The tentative values of the 871variables are set to the ground values in Values. Typically Var is a 872variable or a list of variables. 873 874</P></P> 875A tentative value is generally used to record preferred or previous 876assigments to this variable. It does not actually bind the variable to the 877value. It can be changed through later calls to tent_set. Together with 878other tentative values and actual values for the problem variables in a 879program, they can form a tentative assignment which may be a partial or 880inconsistent solution to the problem. Variables with inconsistent tentative 881values are known as non-tenable. 882</P> 883") 884]). 885 886 887% Set the tentative values in the left hand side term. Rhs must be ground. 888% enclose in call_priority to limit unnecessary work while doing a large 889% tent_set/2 with several variables 890 891Term tent_set GroundTerm :- 892 nonground(GroundTerm), !, 893 error(4, Term tent_set GroundTerm). 894Term tent_set GroundTerm :- 895 call_priority(was0(Term, GroundTerm),1). 896 897 was0(Var, NewTVal) :- 898 var(Var), 899 % nonvar(NewTVal), is guaranteed by calling via tent_set/2. 900 !, 901 get_repair_attr(Var, Attr), 902 Attr = repair{tent:OldTVal,mon:Mon}, 903 ( var(OldTVal) -> 904 'ASSERT'(var(Mon)), 905 NewTVal = OldTVal, 906 get_repair_state(conflict_vars of repair_state, ConfSet), 907 elem_new(MonSusp,ConfSet,Mon), 908 % no tenable value treated as if it had been tenable 909 suspend( 910 monitor_tenable(Var,Attr,s(WasTenable)), 911 6, 912 Var->constrained, 913 MonSusp), 914 ( not_unify(Var , NewTVal) -> 915 WasTenable=no, 916 elem_add(Mon) 917% , schedule_suspensions(to_unten of repair,Attr) 918 ; 919 WasTenable=yes 920 ), 921 schedule_suspensions(ga_chg of repair,Attr), 922 wake 923 ; OldTVal == NewTVal -> 924 true 925 ; % change the tentative value 926 setarg(tent of repair,Attr,NewTVal), 927 ( not_unify(Var , OldTVal) -> 928 ( not_unify(Var , NewTVal) -> 929 true 930 ; 931 elem_del(Mon), 932 modify_tent(Mon,yes) 933 ) 934 ; 935 ( not_unify(Var , NewTVal) -> 936 elem_add(Mon), 937 modify_tent(Mon,no) 938% , schedule_suspensions(to_unten of repair,Attr) 939 ; 940 true 941 ) 942 ), 943 schedule_suspensions(ga_chg of repair,Attr), 944 wake 945 ). 946 was0(C,G) :- 947 compound(C), 948 !, 949 functor(C,F,A), 950 functor(G,F,A), 951 ( for(I,1,A), 952 param(C,G) 953 do 954 arg(I,C,Ci), 955 arg(I,G,Gi), 956 was0(Ci,Gi) 957 ). 958 was0(C,C). 959 960 modify_tent(Elem,WasTenable) :- 961 elem_term(Elem,Susp), 962 get_suspension_data(Susp, goal, Goal), 963 Goal = monitor_tenable(_,_,S), 964 setarg(1,S,WasTenable). 965 966add_repair_attrs([]). 967add_repair_attrs([X|Xs]) :- 968 get_repair_attr(X, _), % will actually add if not there yet 969 add_repair_attrs(Xs). 970 971 972get_repair_attr(X{A}, Attr) :- % access attribute, create if none 973 -?-> 974 get_repair_attr1(X, Attr, A). 975get_repair_attr(X, Attr) :- 976 free(X), 977 new_repair_attr(X, Attr). 978 979 get_repair_attr1(X, Attr, A) :- 980 var(A), new_repair_attr(X, Attr). 981 get_repair_attr1(_, Attr, A) :- 982 nonvar(A), Attr=A. 983 984 new_repair_attr(X, Attr) :- % make a new repair-variable 985 Attr = repair{}, 986% init_suspension_list(to_unten of repair,Attr), 987 init_suspension_list(ga_chg of repair,Attr), 988 add_attribute(X, Attr). 989 990 991% ---------------------------------------------------------------------- 992% Invariants 993% ---------------------------------------------------------------------- 994 995% Precondition: Val is a variable (otherwise it can fail in tent_set) 996 997:- comment((tent_is)/2, [ 998amode: tent_is(-,+), 999template: "-Result tent_is +Expression", 1000args: ["Result":"Variable", "Expression":"Arithematic Expression"], 1001summary: "Eagerly evaulate Expression using tentative assignments.", 1002see_also: [is/2, (tent_set)/2, tent_call/3], 1003desc: html("\ 1004<P> 1005This is similar to the normal arithmetic <TT>is/2</TT> predicate, but 1006evaluates the expression based on the tentative 1007assignment of its variables. The result is delivered as (an update to) 1008the tentative value of the Result variable. 1009Once initiated, tent_is will stay active and keep updating Result's 1010tentative value eagerly whenever the tentative assignment of any 1011variable in Expression changes. 1012</P> 1013") 1014]). 1015 1016:- tool((tent_is)/2, (tent_is)/3). 1017tent_is(Val,Expr,_Module) :- var(Expr), !, 1018 Val = Expr, 1019 get_repair_attr(Expr, _). % will actually add if not there yet 1020tent_is(Val,Expr,_Module) :- number(Expr), !, 1021 Val = Expr. 1022tent_is(Sum, Expr, Module) :- 1023 linearize(Expr, [Cst*1 | Terms], NonLin), 1024 ( 1025 foreach(C*V, Terms), 1026 fromto(Cst, In, Out, TentSum), 1027 param(Sum) 1028 do 1029 get_repair_attr(V, repair{tent:TV}), % or make attr 1030 ( var(TV) -> T=0 ; T=TV ), % no tent value treated as zero 1031 Out is In + T * C, 1032 suspend(sum_update(C*V,T,Sum,Susp), 2, [V->inst,V->ga_chg], Susp) 1033 ), 1034 Sum tent_set TentSum, 1035 1036 % treat the nonlinear components 1037 ( foreach(V = NonLinExpr, NonLin), param(Module) do 1038 update_expr(V, NonLinExpr,Module) 1039 ). 1040 1041 1042% Out is guaranteed to be a var. 1043update_expr(Out, Expr, Module) :- 1044 term_variables(Expr, In), 1045 tent_call(In, Out, Out is Expr, Module). 1046 1047 1048:- comment(tent_call/3, [ 1049amode: tent_call(+,+,+), 1050args: ["In":"List of variables (subset of variables in Goal)", 1051 "Out":"List of variables (subset of variables in Goal)", 1052 "Goal": "Goal to be called" 1053 ], 1054see_also: [(tent_set)/2, (tent_is)/2], 1055summary: "Eagerly call Goal whenever tentative values of variables in In changes.", 1056desc: html("\ 1057<P> 1058This is a completely general meta-predicate to support computations 1059with tentative values. Goal is a general goal, and In and Out are 1060lists (or other terms) containing subsets of Goal's variables. 1061A copy of Goal is called, with the In-variables replaced by their 1062tentative values and the Out-variables replaced by fresh variables. 1063Goal is expected to return values for the Out variables. These values 1064are then used to update the tentative values of the original Out variables. 1065This process repeats whenever the tentative value of any In-variable 1066changes. 1067</P> 1068") 1069]). 1070 1071 1072% Out is guaranteed to be a var. 1073:- tool(tent_call/3, tent_call/4). 1074tent_call(In, Out, Goal, Module) :- % General predicate 1075 tent_call(In, Out, Goal, Module, _Susp). 1076 1077:- demon tent_call/5. 1078tent_call(In, Out, Goal, Module, Susp) :- 1079 % tent_ground without Out being grounded 1080 copy_term((In, Goal, Out), (In0, Goal0, Out0)), 1081 In tent_get In0, 1082 once(Goal0)@Module, 1083 Out tent_set Out0, 1084 ( nonground(In) -> 1085 ( var(Susp) -> 1086 suspend(tent_call(In, Out, Goal, Module, Susp), 1087 2, [In->ga_chg], Susp) 1088 ; 1089 true 1090 ) 1091 ; 1092 kill_suspension(Susp) 1093 ). 1094 1095 1096% priority has to be less than that of sum_update and tent_call 1097unify_to_tent_if_ground_args(X, Args) :- 1098 ( nonground(Args, SomeVar) -> 1099 suspend(unify_to_tent_if_ground_args(X, Args), 3, SomeVar->inst) 1100 ; 1101 X tent_get X 1102 ). 1103 1104% Sum is guaranteed to be a var. 1105:- demon sum_update/4. 1106sum_update(CV, Previous, Sum, Susp) :- 1107 CV = C*V, 1108 V tent_get Current, 1109 Sum tent_get PreviousSum, 1110 CurrentSum is PreviousSum + (Current - Previous) * C, 1111 ( var(V) -> 1112 get_suspension_data(Susp,goal,Goal), setarg(2,Goal,Current) 1113 ; 1114 kill_suspension(Susp) 1115 ), 1116 Sum tent_set CurrentSum. 1117 1118 1119/*** 1120tent_is_conflict(ConfSet,Annotation,Sum,OutSum,Expr,Module) :- 1121 elem_new(Susp,ConfSet,Elem), 1122 suspend(tent_is_conflict(Expr,Annotation,Sum,OutSum,Elem,Susp,Module), 1123 7, 1124 [OutSum->constrained,OutSum-Sum->ga_chg], 1125 Susp), 1126 schedule_woken([Susp]), 1127 wake. 1128 1129:- demon tent_is_conflict/7. 1130% Sum generated by invariant code. 1131% groundness signals invariant also ground. 1132% Outsum is user variable. 1133tent_is_conflict(_Expr,_Annotation,Sum,OutSum,Elem,Susp,_Module) :- 1134 ( nonvar(Sum) -> 1135 kill_suspension(Susp), 1136 elem_del(Elem), 1137 Sum = OutSum 1138 ; 1139 Sum tent_get TentSum, 1140 ( var(OutSum) -> 1141 OutSum tent_set TentSum, 1142 ( tenable(Outsum) -> 1143 elem_del(Elem) 1144 ; 1145 elem_add(Elem) 1146 ) 1147 ; OutSum == TentSum -> 1148 elem_del(Elem) 1149 ; 1150 elem_add(Elem) 1151 ) 1152 ). 1153 1154% ---------------------------------------------------------------------- 1155% #?/2 1156% #?(Goal,B) 1157% ---------------------------------------------------------------------- 1158tent_isd_(ConfSet,Bool,Goal,Annotation,Module) :- 1159 term_variables(Bool-Goal,Vars), 1160 add_repair_attrs(Vars), 1161 elem_new(Susp,ConfSet,ConfElem), 1162 suspend( 1163 repair_isd(Goal,Annotation,ConfElem,Bool,Module), 1164 7, 1165 [ Vars->ga_chg], 1166 Susp), 1167 schedule_woken([Susp]), 1168 wake. 1169 1170:- demon repair_isd/5. 1171repair_isd(Goal,_Annotation,ConfElem,Bool,Module) :- 1172 ( tentative_ground(Goal, G1,Vars) -> 1173 ( novars == Vars -> 1174 elem_term(ConfElem,Susp), 1175 kill_suspension(Susp), 1176 ( call(Goal)@Module -> Bool = 1 ; Bool = 0 ) 1177 ; not not call(G1)@Module -> 1178 TentBool = 1 1179 ; 1180 TentBool = 0 1181 ), 1182 ( var(Bool) -> 1183 Bool tent_set TentBool, 1184 elem_del(ConfElem) 1185 ; Bool == TentBool -> 1186 elem_del(ConfElem) 1187 ; 1188 elem_add(ConfElem) 1189 ) 1190 ; 1191 elem_add(ConfElem) 1192 ). 1193***/ 1194 1195% ---------------------------------------------------------------------- 1196% Labeling interface 1197% ---------------------------------------------------------------------- 1198 1199:- comment(conflict_constraints/2, [ 1200amode:conflict_constraints(+,-), 1201args: ["ConflictSet":"name or handle of a conflict set", 1202 "Constraints":"List of conflicting constraints in ConflictSet (variable)" 1203 ], 1204summary: "Retreive the set of conflicting constraints monitored in ConflictSet.", 1205resat: no, 1206desc: html("\ 1207<P> 1208When a repair constraint goes into conflict (i.e. when it does not satisfy 1209the tentative assignment of its variables), it appears in a conflict set, 1210once it satisfies the tentative assignment, it disappears. 1211This primitive returns the list of all current conflict constraints 1212in the given conflict set. 1213 1214</P><P> 1215ConflictSet is the conflict set name (or handle) which has 1216been used in the corresponding constraint annotation. For example 1217 1218<TT> 1219conflict_constraints(cap_cstr, Conflicts) 1220</TT> 1221 1222would retrieve all constraints that were annotated with <TT>cap_cstr</TT> 1223and are currently in conflict. 1224</P>") 1225]). 1226 1227 1228conflict_constraints(Cs) :- 1229 get_repair_state(conflict_constraints of repair_state,Set), 1230 conflict_constraints(Set,Cs). 1231 1232conflict_constraints(SetName, Cs) :- 1233 var(SetName), !, 1234 error(4, conflict_constraints(SetName, Cs)). 1235conflict_constraints(SetName, Cs) :- 1236 conflict_constraints1(SetName, Cs). 1237 1238 conflict_constraints1(SetName,[]) ?- !, % make this case more efficient 1239 get_hashed_set(SetName,Set), 1240 set_empty(Set). 1241 conflict_constraints1(SetName,Cs) :- 1242 get_hashed_set(SetName,Set), 1243 set_list(Set,List), 1244 extract_annotations(List,Cs). 1245 1246:- mode extract_annotations(+,?). 1247extract_annotations([],[]). 1248extract_annotations([Susp|Susps],[A|As]) :- 1249 get_suspension_data(Susp, goal, Goal), 1250 Goal = monitor_conflict{annotation:A}, 1251 extract_annotations(Susps,As). 1252 1253:- comment(poss_conflict_vars/2, [ 1254amode: poss_conflict_vars(+,-), 1255args: ["ConflictSet":"name or handle of a conflict set", 1256 "Vars": "Variables within conflict constraints" 1257 ], 1258summary: "Returns the set of variables within the conflict constraints in ConflictSet.", 1259desc: "\ 1260The set of variables within the conflict constraints. 1261This is generally a mixture of tenable and untenable variables." 1262]). 1263 1264 1265poss_conflict_vars(Vs) :- 1266 get_repair_state(conflict_constraints of repair_state,Set), 1267 poss_conflict_vars(Set,Vs). 1268 1269poss_conflict_vars(SetName,Vs) :- 1270 conflict_constraints(SetName,Cs), 1271 term_variables(Cs,Vs). 1272 1273:- comment(conflict_vars/1, [ 1274amode: conflict_vars(-), 1275args:["Vars":"List of variables that are currently non-tenable"], 1276summary: "Returns the list of variables which are currently non-tenable.", 1277see_also: [tenable/1, (tent_set)/2], 1278desc: html("\ 1279<P> 1280When a variable becomes untenable, it appears in the set of conflict 1281variable, when it becomes tenable, is disappears. 1282This primitive returns the list of all currently untenable variables. 1283Note that all these variables must be reassigned in any solution 1284(there is no other way to repair untenability). 1285Variable reassignment can be achieved 1286by changing the variable's tentative value with tent_set/2, 1287or by instantiating the variable. 1288Care should be taken whilst implementing repairs through tentative 1289value changes since this is a non-monotonic operation: conflicting repairs 1290may lead to cycles and the computation may not terminate. 1291</P> 1292") 1293]). 1294 1295conflict_vars(Vs) :- 1296 get_repair_state(conflict_vars of repair_state,ConfSet), 1297 set_list(ConfSet,ConfList), 1298 extract_variables(ConfList,Vs). 1299 1300call_satisfied_constraints :- 1301 suspensions(Susps), 1302 call_satisfied_suspensions(Susps). 1303 1304 call_satisfied_suspensions([]). 1305 call_satisfied_suspensions([S|Ss]):- 1306 ( get_suspension_data(S, goal, G), 1307 G = monitor_conflict{constraint:Constraint,prop:0,module:Module} -> 1308 call(Constraint)@Module, 1309 setarg(prop of monitor_conflict,G,1) % set flag to say goal called 1310 ; 1311 true 1312 ), 1313 call_satisfied_suspensions(Ss). 1314 1315kill_monitor_conflict :- 1316 suspensions(Susps), 1317 kill_suspensions(Susps). 1318 1319 kill_suspensions([]). 1320 kill_suspensions([S|Ss]):- 1321 ( get_suspension_data(S, goal, G), 1322 G = monitor_conflict{constraint:Constraint,prop:PropFlag,module:Module} -> 1323 ( PropFlag == 0 -> 1324 call(Constraint)@Module 1325 ; 1326 true 1327 ), 1328 kill_suspension(S) 1329 ; 1330 true 1331 ), 1332 kill_suspensions(Ss). 1333 1334 1335% Statistics ----------------------------------------------------------- 1336 1337repair_counter(wake_satisfied). 1338repair_counter(wake_ground). 1339repair_counter(wake_conflict). 1340repair_counter(var_var_unify). 1341repair_counter(monitor_no_change). 1342repair_counter(monitor_to_tenable). 1343repair_counter(monitor_to_untenable). 1344repair_counter(nonvar_var_unify). 1345repair_counter(propagate). 1346 1347 1348inc_code_off(inc(_Counter)). 1349 1350inc_code_on(( 1351 inc(Counter) :- 1352 incval(Counter) 1353)). 1354 1355repair_stat(Stats):- 1356 var(Stats), 1357 !, 1358 bagof(Counter=Value, 1359 (repair_counter(Counter), 1360 getval(Counter,Value)), 1361 Stats). 1362repair_stat(on) :- 1363 inc_code_on(Code), 1364 compile_term(Code). 1365repair_stat(off) :- 1366 inc_code_off(Code), 1367 compile_term(Code). 1368repair_stat(reset) :- 1369 not(( 1370 repair_counter(Counter), 1371 setval(Counter,0), 1372 fail 1373 )). 1374 1375:- repair_stat(reset),repair_stat(off). 1376 1377% Constant time sets ---------------------------------------------------- 1378% elem(Term,InSet,OnList,Set). 1379% The list s([...]) maintains elements possibly in the set. 1380% it is flushed on readiing with set_list/2 1381% elements maintain whether they are in the list and whether they are 1382% in the set. If you are in the set you are guaranteed to be in the list 1383% but you may remove yourself from the set, but not have been flushed out 1384% of the list yet. 1385 1386elem_in(elem(_,1,_,_)) :- 1387 -?-> true. 1388 1389elem_new(Term,Set,elem(Term,0,0,Set)). 1390 1391elem_term(elem(Term,_,_,_),Term). 1392 1393elem_add(Elem):- 1394 Elem=elem(_,In,OnList,Set), 1395 (In == 0 -> 1396 setarg(2,Elem,1), 1397 (OnList == 0 -> 1398 Set=s(Elems), 1399 setarg(1,Set,[Elem|Elems]), 1400 setarg(3,Elem,1) 1401 ; 1402 true 1403 ) 1404 ; 1405 true 1406 ). 1407 1408elem_del(Elem) :- 1409 Elem=elem(_,In,_,_), 1410 (In == 1 -> 1411 setarg(2,Elem,0) 1412 ; 1413 true 1414 ). 1415 1416 1417set_new(s([])). 1418 1419set_list(Set,Terms) :- 1420 Set=s(Elems0), 1421 set_list_(Elems0,Elems,Terms), 1422 setarg(1,Set,Elems). 1423 1424 :- mode set_list_(+,-,-). 1425 set_list_([],[],[]). 1426 set_list_([Elem|Elems0],Elems,Terms) :- 1427 Elem=elem(Term,In,_,_), 1428 set_list_(In,Term,Elem,Elems0,Elems,Terms). 1429 1430 :- mode set_list_(++,?,?,?,-,-). 1431 set_list_(0,_,Elem,Elems0,Elems,Terms) :- 1432 setarg(3,Elem,0), 1433 set_list_(Elems0,Elems,Terms). 1434 set_list_(1,Term,Elem,Elems0,[Elem|Elems],[Term|Terms]) :- 1435 set_list_(Elems0,Elems,Terms). 1436 1437set_empty(Set) :- 1438 Set=s(Elems0), 1439 set_empty_(Elems0,Elems), 1440 setarg(1,Set,Elems). 1441 1442 :- mode set_empty_(+,-). 1443 set_empty_([],[]). 1444 set_empty_([Elem|Elems0],Elems) :- 1445 Elem=elem(_,0,_,_), % fail here if not empty 1446 setarg(3,Elem,0), 1447 set_empty_(Elems0,Elems). 1448 1449 1450 1451%---------------------------------------------------------------------- 1452% Changeable value interface for Visualisation 1453%---------------------------------------------------------------------- 1454 1455:- export suspend_on_change/2. 1456suspend_on_change(X, Susp) :- 1457 insert_suspension(X, Susp, ga_chg of repair). 1458 1459:- export get_changeable_value/2. 1460get_changeable_value(X, V) :- 1461 tent_get(X, V). 1462 1463