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