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) 1994-2006 Cisco Systems, Inc. All Rights Reserved. 18% 19% Contributor(s): ECRC GmbH. 20% 21% END LICENSE BLOCK 22 23%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 24% 25% Labeling 26% 27%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 28 29:- begin_module(grace). 30:- call(lib(fd)). 31 32grace_label :- 33 getval(grace, on), 34 !, 35 all_variables(Vars), 36 grace_label_list(Vars), 37 grace_solution. 38grace_label :- 39 all_variables(Vars), 40 label_nograce(Vars). 41 42all_variables(AllRev) :- 43 labeled_matrices(Matrices), 44 term_variables(Matrices, AllVars), 45 reverse(AllVars, AllRev). % to have them in the original order 46 47active_variables(Vars) :- 48 active_matrices(Matrices), 49 term_variables(Matrices, AllVars), 50 reverse(AllVars, Vars). 51 52grace_label(_) :- 53 getval(grace, off), 54 !. 55grace_label(Var) :- 56 tcl(disable_selections), 57 label_var(Var, Label, noselect), 58 next_label(Var, Label). 59 60next_label(Var, Goal) :- 61 nonvar(Goal), 62 Goal = modify_var(_, _, _), 63 !, 64 call(Goal), 65 grace_label(Var). 66next_label(_, _). 67 68grace_label(_, _) :- 69 getval(grace, off), 70 !. 71grace_label(Var, List) :- 72 tcl(enable_selections), 73 label_var(Var, Label, select), 74 next_label(Label, Var, List). 75 76% If something is manually modified, it is returned in the Label goal. 77% Otherwise we go on with the selection we have 78next_label(V, _, _) :- 79 var(V), 80 !. 81next_label(Goal, Var, List) :- 82 call(Goal), 83 grace_label(Var, List). 84 85grace_label_list(List) :- 86 check_list(List), 87 grace_label_list1(List). 88 89grace_label_list1([]). 90grace_label_list1(List) :- 91 List = [_|_], 92 minimize_bound_check, 93 select_var(List, Var), 94 (getval(grace, on) -> 95 label_var(Var, Label, select) 96 ; 97 true 98 ), 99 next_grace_label_list(Label, Var, List). 100 101next_grace_label_list(G, Var, List) :- 102 var(G), 103 select_value(Var, List, List1), 104 grace_label_list1(List1). 105next_grace_label_list(Goal, _, List) :- 106 nonvar(Goal), 107 call(Goal), 108 grace_label_list1(List). 109 110label_nograce([]). 111label_nograce(List) :- 112 List = [_|_], 113 minimize_bound_check, 114 select_var(List, Var), 115 select_value(Var, List, NewList), 116 label_nograce(NewList). 117 118label_var(V, _, _) :- 119 nonvar(V). 120label_var(Var, Label, Select) :- 121 var(Var), 122 (var_matrix(Var, Name) -> 123 (matrix_option(Name, lookahead, 1) -> 124 lookahead_matrix(Name) 125 ; 126 matrix_option(Name, lookahead_var, 1) -> 127 lookahead_var(Var) 128 ; 129 true 130 ) 131 ; 132 true 133 ), 134 do_label_var(Var, Label, Select). 135 136do_label_var(V, _, _) :- 137 nonvar(V). 138do_label_var(Var, Label, Select) :- 139 var(Var), 140 handle_label_failure, 141 ( true 142 ; 143 getval(backward, 1), 144 decval(choices), 145 fail 146 ), 147 (getval(stop, Stop) -> 148 (Stop = goal(G1) -> 149 getval(goal, G), 150 (G1 = G -> 151 step_mode, 152 (G = 1 -> reset_status; true) 153 ; 154 G1 < G -> 155 setval(mode, retry(goal(G1))), 156 fail 157 ; 158 true 159 ) 160 ; 161 Stop = depth(D), 162 get_depth(D) -> 163 step_mode 164 ; 165 true 166 ) 167 ; 168 true 169 ), 170 get_cut(LastChP), 171 set_last_choice(LastChP), 172 getval(mode, Mode), 173 handle_interface(Var, Mode, Label, Select), 174 inc_depth, 175 inc_goal, 176 setval(backward, 0). 177 178handle_label_failure :- 179 getval(choices, Ch), 180 getval(failures, Bt), 181 getval(goal, G), 182 get_last_choice(ChP), 183 ( 184 true 185 ; 186 getval(mode, Mode), 187 (Mode = retry(Back) -> 188 get_depth(D), 189 (Back = depth(RD), 190 (integer(RD), D =< RD; RD=fail(RDF), D =< RDF) -> 191 setval(backward, 0), 192 setval(choices, Ch), 193 setval(failures, Bt), 194 setval(goal, G), 195 step_mode, 196 integer(RD), 197 display_all_matrices, 198 handle_label_failure, 199 (D = 0 -> reset_status; true) 200 ; 201 Back = goal(G1), 202 G1 >= G -> 203 setval(backward, 0), 204 setval(choices, Ch), 205 setval(failures, Bt), 206 setval(goal, G), 207 setval(stop, Back), 208 run_mode, 209 display_all_matrices, 210 handle_label_failure 211 ; 212 D1 is D - 1, 213 D1 >= 0, 214 cut_to(ChP), 215 tcl_eval(['catch {vs_delete .vs.c ', D1, '}']), 216 fail 217 ) 218 ) 219 ). 220handle_label_failure :- 221 incval(choices), 222 setval(backward, 1), 223 fail. 224 225ppp. 226 227handle_interface(_, run_fast, _, _) :- 228 !. % do nothing in the fast mode 229handle_interface(Var, back_min_max(Mode), Label, Select) :- 230 !, 231 setval(mode, Mode), 232 display_all_matrices, 233 handle_interface(Var, Mode, Label, Select). 234handle_interface(_, step, _, _) :- 235 set_priority(default_prio, 0), 236 fail. 237handle_interface(Var, Mode, Label, Select) :- 238 get_priority(P), 239 get_depth(D), 240 (Mode = run(Prio) -> 241 set_priority(Prio) % it might have been untrailed somewhere 242 ; 243 true 244 ), 245 (P > matrix_prio -> 246 print_status, 247 selected_variable(Var), 248 (Mode = run(Prio) -> 249 true %tcl_eval(update) 250 ; 251 force_displays, 252 (Mode = moddom(step) -> 253 message('Next Step') 254 ; 255 Mode = moddom(run) -> 256 step_mode, 257 message('Next Step') 258 ; 259 true 260 ), 261 end_propagation, 262 (Select = select -> 263 tcl(enable_selections) 264 ; 265 tcl(disable_selections) 266 ), 267 wait_for_events(Var, _, Label) 268 ), 269 /* 270 (single_option(control, print_trace, 1) -> 271 do_print_trace 272 ; 273 do_not_print_trace 274 ), 275 */ 276 restore_selected 277 ; 278 true 279 ), 280 (compound(Label) -> 281 arg(1, Label, VarNew) 282 ; 283 VarNew = Var 284 ), 285 print_selected_varstack(VarNew, D, Mode), 286 %start_stepw_deamon(VarNew), 287 (single_option(varstack, flush, 1) -> 288 tcl_eval(update) 289 ; 290 true 291 ). 292 293% To be used outside labeling or not synchronously 294handle_events :- 295 tk_next_event([Type|Args]), 296 getval(mode, Mode), 297 handle_event(Type, Args, Mode, Cont), 298 (Cont = cont -> 299 true 300 ; 301 Cont = fail -> 302 fail 303 ; 304 Cont = retry_depth -> 305 get_last_choice(ChP), 306 ChP \== 0, 307 cut_to(ChP), 308 get_depth(D), 309 D1 is D - 1, 310 tcl_eval(['catch {vs_delete .vs.c ', D1, '}']), 311 fail 312 ; 313 handle_events 314 ). 315 316 317wait_for_events(_Var, LabIn, LabOut) :- 318 tk_next_event([Type|Args]), 319 getval(mode, Mode), 320 handle_event(Type, Args, Mode, Cont), 321 (Cont = cont -> 322 LabIn = LabOut 323 ; 324 Cont = fail -> 325 LabOut = fail 326 ; 327 Cont = select(N, I, J), 328 select_var(N, I, J, NewVar) -> 329 wait_for_events(NewVar, select_only(NewVar), LabOut) 330 ; 331 Cont = select_step(N, I, J), 332 select_var(N, I, J, NewVar) -> 333 LabOut = select_only(NewVar) 334 ; 335 Cont = modify(N, I, J), 336 modify_var(N, I, J, LabOut) -> 337 true 338 ; 339 Cont = modify_var(_, _, _) -> 340 LabOut = Cont 341 ; 342 Cont \= retry_depth, 343 wait_for_events(_, LabIn, LabOut) 344 ). 345 346var_out(Old, New) :- 347 (New == [] -> 348 true 349 ; 350 New = Old 351 ). 352 353handle_event("step", _, _, cont) :- 354 !. 355 %prolog_step_mode, % already done from Tcl 356 %tcl_eval(step_mode). 357handle_event("run", _, _, cont) :- 358 !, 359 run_mode. 360handle_event("break", _, _, no) :- 361 !, 362 break. 363handle_event("abort", _, _, no) :- 364 !, 365 reset_global_state, 366 abort. 367handle_event("restart", _, _, no) :- 368 !, 369 setval(mode, retry(start)), 370 restore_selected, 371 fail. 372handle_event("exit", _, _, _) :- 373 !, 374 reset_global_state, 375 tcl_eval('destroy .'), 376 tcl_eval(exit), 377 abort. 378handle_event("stop_goal", [N], _, Cont) :- 379 (integer(N), 380 N > 0 -> 381 getval(goal, G), 382 (N > G -> 383 setval(stop, goal(N)), 384 run_mode, 385 Cont = cont 386 ; 387 N < G -> 388 setval(mode, retry(goal(N))), 389 restore_selected, 390 fail 391 ; 392 Cont = no 393 ) 394 ; 395 message('Bad step #'), 396 Cont = no 397 ). 398handle_event("show", [N, I, J, X, Y], _, no) :- 399 !, 400 show_domain(N, I, J, X, Y). 401handle_event("select", [N, I, J], _, select(N, I, J)) :- 402 !. 403handle_event("select_step", [N, I, J], _, select_step(N, I, J)) :- 404 !, 405 prolog_step_mode, 406 tcl_eval(step_mode). 407handle_event("lookahead_cell", [N, I, J], _, Cont) :- 408 !, 409 (lookahead_cell(N, I, J) -> 410 search_size, 411 Cont = no 412 ; 413 Cont = fail 414 ). 415handle_event("propagate_cell", [N, I, J], _, Cont) :- 416 !, 417 (grace_propagate(N, I, J) -> 418 Cont = no 419 ; 420 Cont = fail 421 ). 422handle_event("constraints", [N, I, J], _, no) :- 423 !, 424 list_constraints(N, I, J). 425handle_event("stop", [When, N, I, J], _, no) :- 426 !, 427 add_breakpoint(N, I, J, When). 428handle_event("print", _, _, no) :- 429 !, 430 print_all_matrices. 431handle_event("lookahead", _, _, Cont) :- 432 !, 433 (lookahead_all -> 434 Cont = lookahead, 435 search_size, 436 wake 437 ; 438 Cont = fail 439 ). 440 441handle_event("modify", [N, I, J], _, modify(N, I, J)) :- 442 !. 443handle_event("bind_var", [N, I, J, Val], _, Lab) :- 444 !, 445 matrix_element(N, I, J, Var), 446 % 447 % we should not create a choice point if it fails 448 (dvar_domain(Var, D), 449 dom_check_in(Val, D) -> 450 (nonvar(Var) -> 451 Lab = no 452 ; 453 test_equal(Var, Val) -> 454 Lab = modify_var(Var, "=", [Val]) 455 ; 456 (Var ## Val -> 457 Lab = no 458 ; 459 Lab = fail 460 ) 461 ) 462 ; 463 Lab = no 464 ). 465handle_event("fail", _, _, fail) :- 466 !. 467handle_event("stepd", _, moddom(_), cont) :- 468 !, 469 setval(mode, moddom(step)). 470handle_event("stepd", _, moddomf(_), cont) :- 471 !, 472 setval(mode, moddomf(step)). 473handle_event("stepd", _, _, cont) :- 474 !, 475 tcl_eval('active_matrices', L), 476 (L = "" -> 477 true 478 ; 479 setval(mode, moddom(step)), 480 install_stepd_handlers(L) 481 ). 482handle_event("rund", _, moddomf(_), cont) :- 483 !, 484 setval(mode, moddomf(run)). 485handle_event("rund", _, moddom(_), cont) :- 486 !, 487 setval(mode, moddom(run)). 488handle_event("rund", _, _, cont) :- 489 !, 490 tcl_eval('active_matrices', L), 491 (L = "" -> 492 true 493 ; 494 setval(mode, moddom(run)), 495 install_stepd_handlers(L) 496 ). 497handle_event("stepw", _, _, cont) :- 498 !, 499 setval(mode, stepw), 500 (tcl_eval('set .tc.reg.var', 0) -> 501 reset_propagation_trace 502 ; 503 true 504 ), 505 trace_wake. 506handle_event("retry_depth", [D], _, C) :- 507 !, 508 get_depth(CD), 509 (CD =< D -> 510 C = no 511 ; 512 restore_selected, 513 C = retry_depth, 514 printf("retrying level %d\n%b", [D]), 515 setval(mode, retry(depth(D))) 516 ). 517handle_event("next_depth", [D], _, cont) :- 518 !, 519 D1 is D + 1, 520 setval(stop, depth(D1)), 521 printf("skip to next in level %d\n%b", [D]), 522 run_mode. 523handle_event("fail_depth", [D], _, C) :- 524 !, 525 get_depth(CD), 526 (CD =< D -> 527 C = no 528 ; 529 restore_selected, 530 setval(mode, retry(depth(fail(D)))), 531 printf("fail level %d\n%b", [D]), 532 fail 533 ). 534handle_event("undo", [], _, C) :- 535 !, 536 get_depth(D), 537 D1 is D - 1, 538 (D1 >= 0 -> 539 restore_selected, 540 C = retry_depth, 541 setval(mode, retry(depth(D1))) 542 ; 543 C = no 544 ). 545handle_event("display", [_], _, no) :- 546 !. 547handle_event("graph", [Eager], _, no) :- 548 make_graph(Eager), 549 !. 550handle_event("var_prop", [Id], _, no) :- 551 display_var_updates(Id), 552 !. 553handle_event("set_lookahead", [NameS, I], _, no) :- 554 !, 555 atom_string(Name, NameS), 556 (I = 0 -> 557 grace_option(Name, lookahead, 0), 558 grace_option(Name, lookahead_var, 0) 559 ; 560 I = 1 -> 561 grace_option(Name, lookahead, 1), 562 grace_option(Name, lookahead_var, 0) 563 ; 564 grace_option(Name, lookahead, 0), 565 grace_option(Name, lookahead_var, 1) 566 ). 567handle_event("set_option", [W, N, V], _, no) :- 568 !, 569 atom_string(WA, W), 570 atom_string(NA, N), 571 (string(V) -> 572 atom_string(VA, V) 573 ; 574 VA = V 575 ), 576 grace_option(WA, NA, VA), 577 handle_option(WA, NA, VA). 578handle_event("handle_display", [W], _, no) :- 579 !, 580 tcl("handle_display ##", W). 581 582handle_option(control, print_trace, Val) :- 583 !, 584 (Val = 1 -> 585 do_print_trace 586 ; 587 do_not_print_trace 588 ). 589handle_option(_, _, _). 590 591install_stepd_handlers([]) :- !. 592install_stepd_handlers([Id|L]) :- 593 (string(Id) -> term_string(Name, Id); Name = Id), 594 matrix(Name, Sq), 595 apply_matrix(Sq, Name, stepd), 596 install_stepd_handlers(L). 597install_stepd_handlers(Id) :- 598 atomic(Id), 599 (string(Id) -> term_string(Name, Id); Name = Id), 600 term_string(Name, Id), 601 matrix(Name, Sq), 602 apply_matrix(Sq, Name, stepd). 603 604stepd_handler(Var, W) :- 605 var(Var), 606 el_to_const(Var, D, _), 607 make_suspension(stepd_delay(Var, D, W), 1, Susp), 608 insert_suspension(Var, Susp, constrained of suspend, suspend). 609stepd_handler(Var, _) :- 610 nonvar(Var). 611 612stepd_delay(Var, Old, W) :- 613 getval(mode, Mode), 614 (Mode = moddomf(M) -> 615 setval(mode, moddom(M)), 616 NewMode = moddom(M) 617 ; 618 NewMode = Mode 619 ), 620 (Mode = moddom(_) -> 621 el_to_const(Var, D, _), 622 (Old = D -> 623 true 624 ; 625 tcl_eval(['stepd_changed ', W, ' {', Old, '} {', D, '}']) 626 ), 627 (var(Var) -> 628 make_suspension(stepd_delay(Var, D, W), 1, Susp), 629 insert_suspension(Var, Susp, constrained of suspend, suspend) 630 ; 631 true 632 ), 633 (Old = D -> 634 true 635 ; 636 (Mode = moddom(step) -> 637 handle_events 638 ; 639 true 640 ) 641 ) 642 ; 643 true 644 ). 645stepd_delay(_, Old, W) :- 646 getval(mode, Mode), 647 (Mode = moddom(M) -> 648 setval(mode, moddomf(M)), 649 tcl('stepd_failing ##', [W]), 650 handle_events 651 ; 652 true 653 ), 654 tcl('stepd_restore ## {##}', [W, Old]), 655 fail. 656 657lookahead_matrix(Name) :- 658 get_priority(P), 659 set_priority(5, 1), 660 matrix(Name, M), 661 appnodes(grace_lookahead_var, M), 662 set_priority(P, 1), 663 wake. 664 665lookahead_all :- 666 get_priority(P), 667 set_priority(5, 1), 668 active_matrices(M), 669 appnodes(grace_lookahead_var, M), 670 set_priority(P, 1), 671 wake. 672 673grace_lookahead_var(El) :- 674 var(El), 675 findall(Val, (par_indomain(El), Val = El), L), 676 var_eq(El, L). 677grace_lookahead_var(T) :- 678 nonvar(T). 679 680lookahead_cell(N, I, J) :- 681 matrix_element(N, I, J, El), 682 lookahead_var(El). 683 684lookahead_var(El) :- 685 findall(Val, (par_indomain(El), Val = El), L), 686 var_eq(El, L). 687 688selected_variable(Var) :- 689 (find_variable(Var, N, I, J) -> 690 highlight_selected(Var, N, I, J) 691 ; 692 true 693 ). 694 695highlight_selected(_, N, I, J) :- 696 getval(backward, Back), 697 set_selection(N, I, J, Back), 698 setval(selected, [N, I, J]). 699 700select_var(N, I, J, Var) :- 701 matrix_element(N, I, J, Var), 702 var(Var), 703 restore_selected, 704 highlight_selected(Var, N, I, J). 705 706modify_var(N, I, J, Label) :- 707 matrix_element(N, I, J, Var), 708 var(Var), 709 el_to_const(Var, Dom, Size), 710 concat_string(['modify_var {', Dom, '} ', Size, ' ', x1, ' ', y1], Show), 711 tcl_eval(Show), 712 tcl_eval('set new_value', NewVal), 713 tcl_eval('set modify_mode', Mode), 714 tcl_eval(update), 715 NewVal \== "", 716 Mode \== "", 717 const_to_el(NewVal, List), 718 Label = modify_var(Var, Mode, List). 719 720 721delete_var(Var, [Var|L], R) :- 722 -?-> 723 !, 724 R = L. 725delete_var(Var, [H|L], [H|T]) :- 726 delete_var(Var, L, T). 727 728restore_selected :- 729 tcl_eval(restore_selected). 730 731add_breakpoint(N, I, J, Cond) :- 732 matrix_element(N, I, J, Var), 733 (var(Var) -> 734 ( add_breakpoint(N, I, J, Cond, Var), 735 concat_string(['change_breakpoint ', N, ' ', I, ' ', J, ' ', 0], Cmd), 736 tcl_cut_fail(Cmd) 737 ; 738 printf("removing breakpont", []), 739 remove_breakpoints(Var), 740 fail 741 ) 742 ; 743 true 744 ). 745 746add_breakpoint(N, I, J, "ground", Var) :- 747 !, 748 remove_breakpoints(Var), 749 make_suspension(breakpoint(N, I, J), 4, Susp), 750 insert_suspension(Var, Susp, inst of suspend, suspend), 751 tcl_eval(['change_breakpoint ', N, ' ', I, ' ', J, ' ', 2]). 752add_breakpoint(N, I, J, "modified", Var) :- 753 !, 754 remove_breakpoints(Var), 755 new_breakpoint(Var, N, I, J), 756 tcl_eval(['change_breakpoint ', N, ' ', I, ' ', J, ' ', 1]). 757 758remove_breakpoints(_{suspend: S}) :- 759 -?-> 760 S = suspend with [constrained:C-_, inst:B-_], 761 kill_breakpoints(C), 762 kill_breakpoints(B). 763 764% stop when ground 765breakpoint(N, I, J) :- 766 step_mode, 767 el_label(N, I, J, Lab), 768 concat_string([Lab, ' is ground'], Mod), 769 message(Mod), 770 tcl_eval(['change_breakpoint ', N, ' ', I, ' ', J, ' ', 0]), 771 concat_string(['change_breakpoint ', N, ' ', I, ' ', J, ' ', 2], Cmd), 772 tcl_cut_fail(Cmd). 773 774 775% stop when modified 776breakpoint(Var, N, I, J) :- 777 step_mode, 778 el_label(N, I, J, Lab), 779 concat_string([Lab, ' modified'], Mod), 780 message(Mod), 781 (var(Var) -> 782 new_breakpoint(Var, N, I, J) 783 ; 784 tcl_eval(['change_breakpoint ', N, ' ', I, ' ', J, ' ', 0]), 785 concat_string(['change_breakpoint ', N, ' ', I, ' ', J, ' ', 1], Cmd), 786 tcl_cut_fail(Cmd) 787 ). 788 789kill_breakpoints([]) :- !. % if list free 790kill_breakpoints([S|L]) :- 791 (suspension_to_goal(S, G, _), 792 functor(G, breakpoint, _) -> 793 kill_suspension(S, 0) 794 ; 795 true 796 ), 797 kill_breakpoints(L). 798 799 800new_breakpoint(Var, N, I, J) :- 801 make_suspension(breakpoint(Var, N, I, J), 4, Susp), 802 insert_suspension(Var, Susp, constrained of suspend, suspend). 803 804step_mode :- 805 tcl_eval(step_mode), 806 prolog_step_mode. 807 808prolog_step_mode :- 809 setval(mode, step), 810 setval(stop, 0), 811 % default_wake, % reset when we collect a tree 812 force_displays, 813 !. 814prolog_step_mode. % if wake fails 815 816run_mode :- 817 tcl_eval('set cv_display', Disp), 818 display_priority(Disp, P), 819 set_priority(P, 0), 820 (P =< varstack_prio -> 821 setval(mode, run_fast), 822 message('Running, ^C to stop') 823 ; 824 setval(mode, run(P)), 825 message('Running') 826 ), 827 default_wake, 828 tcl_eval('run_mode; update'). 829 830display_priority("All", 9) :- !. 831display_priority("Expressions", 8) :- !. 832display_priority("Stack", 7) :- !. 833display_priority("None", 6) :- !. 834 835background(N, I, J, Back) :- 836 concat_string(['.', N, '.', I, '.', J, ' configure -bg ', Back], Sel), 837 tcl_eval(Sel). 838 839set_selection(N, I, J, Back) :- 840 concat_string(['set_selection ', N, ' ', I, ' ', J, ' ', Back], Sel), 841 tcl_eval(Sel). 842 843show_domain(N, I, J, X, Y) :- 844 matrix_element(N, I, J, El), 845 X1 is X - 10, 846 Y1 is Y - 30, 847 el_to_const(El, Dom, Size), 848 %concat_string(['show_field {', Dom, '} ', Size, ' ', X1, ' ', Y1], Show), 849 tcl('show_field {##} ## ## ## {##} ## ##', [Dom, Size, X1, Y1, N, I, J]). 850 851message(Text) :- 852 tcl_eval(['status_message {', Text, '}']). 853 854backtracks :- 855 getval(choices, N), 856 set_text(N, ".lbackm"). 857 858depth :- 859 get_depth(N), 860 tcl_eval(['set current_depth ', N]). 861 862goal :- 863 getval(goal, N), 864 tcl_eval(['set goal_entry ', N]). 865 866cost :- 867 (getval(optimize, 1) -> 868 get_cost(C), 869 el_to_const(C, S, _), 870 set_text(S, '.lcostm') 871 ; 872 true 873 ). 874 875solutions :- 876 getval(solutions, N), 877 (N = opt(NO) -> 878 concat_string(["(", NO, ")"], NS) 879 ; 880 NS = N 881 ), 882 set_text(NS, ".lsolsm"). 883 884delayed :- 885 delayed_goals(L), 886 sumlist(user_goals, L, 0, N), 887 set_text(N, ".ldelm"). 888 889user_goals(G, I0, I) :- 890 (our_goal(G) -> 891 I = I0 892 ; 893 I is I0 + 1 894 ). 895 896set_text(Text, Where) :- 897 tcl("## configure -text {##}", [Where, Text]). 898 899print_selected_varstack(Var,D, _) :- 900 (integer(Var) -> Low=Var, High=Var, NewVar=Var 901 ; is_integer_domain(Var) -> 902 get_attribute(Var, grace with [range:Low..High]), 903 (var(Low) -> 904 dvar_domain(Var, Dom), 905 dom_range(Dom, Low, High) 906 ; true 907 ), 908 NewVar=Var 909 ; dom(Var,Dom), 910 length(Dom,Length), 911 NewVar::1..Length, 912 element(NewVar,Dom,Var), 913 Low=1, High=Length 914 ), 915 psv(NewVar,D, Low, High). 916 917psv(Var, D, Low, High) :- 918 (var(Var) -> 919 print_stack_variable(Var, D, Low, High), 920 % we want to be notified about the indomain even if it fails 921 make_suspension(update_stack_variable(Var, D), 1, Susp), 922 insert_suspension(Var, Susp, any of fd, fd) 923 ; 924 % the variable is already instantiated, e.g. by lookahead 925 print_stack_variable(Var, D, Var, Var), 926 tcl_eval(['update_domain .vs.c ', Var, ' ', D]) 927 ). 928 929print_stack_variable(Var, D, Low, High) :- 930 var_domain_list(Var, DList), 931 print_stack_variable(Var, DList, D, Low, High). 932 933print_stack_variable(Var, DList, D, Low, High) :- 934 concat_string(['{'|DList], DS), 935 (find_variable(Var, N, I, J) -> 936 true 937 ; 938 var_id(Var, Id), 939 N = "{}", 940 I = '""', 941 J = Id 942 ), 943 tcl_eval(['vs_display_domain .vs.c ', DS, ' ', Low, ' ', High, ' ', D, 944 ' ', N, ' ', I, ' ', J]). 945print_stack_variable(_, _, D, _, _) :- 946 tcl_eval(['vs_delete .vs.c ', D]), 947 fail. 948 949update_stack_variable(Var, D) :- 950 (D is get_depth - 1 -> 951 dvar_domlist(Var, Val), 952 tcl_eval(['update_domain .vs.c ', Val, ' ', D]) 953 ; 954 % do not change variables which are not on top 955 true 956 ), 957 (var(Var) -> 958 make_suspension(update_stack_variable(Var, D), 1, Susp), 959 insert_suspension(Var, Susp, any of fd, fd) 960 ; 961 true 962 ). 963 964interrupt :- 965 step_mode. 966 967x_handler(_, ["exit"]) :- 968 !, 969 tcl_eval(exit). 970x_handler(N, T) :- 971 error(default(N), T). 972 973search_size :- 974 labeled_matrices(M), 975 term_variables(M, Vars), 976 search_size(Vars, 0.0, SizeLn), 977 tcl_eval(['set_size ', 0, ' ', SizeLn]). 978 979search_size([], S, S). 980search_size([V|L], S0, S) :- 981 dvar_domain(V, DV), 982 dom_size(DV, Size), 983 S1 is S0 + ln(Size), 984 search_size(L, S1, S). 985 986check_list([]). 987check_list([V|L]) :- 988 (compound(V) -> 989 error(5, grace_label_list([V|L])) 990 ; 991 check_list(L) 992 ). 993 994do_print_trace :- 995 trace_wake, 996 set_stream(susp, debug_output). 997 998do_not_print_trace :- 999 default_wake, 1000 set_stream(susp_save, susp), 1001 set_stream(susp, null). 1002 1003stop_printing_trace :- 1004 set_stream(susp_save, susp), 1005 set_stream(susp, null). 1006 1007restore_trace :- 1008 set_stream(susp, susp_save). 1009