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% Graphical interface to Constraints Problems in ECLiPSe
26%
27% Primitives:
28%	grace_start(Title)
29%		called at the beginning, after creating the matrices
30%		If the program fails over it, 'no solutions' is assumed
31%
32%	grace_add_matrix(Matrix)
33%		called at the beginning, after creating the matrices
34%		If the program fails over it, 'no solutions' is assumed
35%		Matrices are in the format [Vars, Name, Xnames, Ynames]
36%
37%	grace_label
38%		label all registered variables together
39%
40%	grace_label(Var)
41%		label the variable Var, no selection is possible
42%
43%	grace_label(Var, Rest)
44%		label the variable Var, but allow for manual
45%		selections as well
46%
47%	grace_label_list(List)
48%		Ask Grace to label the whole List using default
49%		or manually selected routines.
50%
51%	grace_solution
52%		called after a solution has been found
53%
54%	qg_display_value(Expr, Name)
55%		trace the value of the expressions Expr
56%
57%	grace_stop(Message)
58%		stops the execution and prints the message,
59%		useful to set permanent breakpoints etc.
60%
61% Priorities:
62%	4: breakpoints
63%	5: no display mode
64%	6: varstack print daemons
65%	7: display print daemons
66%	8: matrices print daemons
67%	9: default - display all
68
69:- module_interface(grace).
70
71:- export
72    grace/0,
73    grace_label/0,		% label all matrices
74    grace_label/1,		% label one variable (no manual)
75    grace_label/2,		% label one variable (plus manual)
76    grace_label_list/1,		% label a list, also when nograce
77    grace_lookahead_var/1,
78    grace_minimize/1,
79    grace_minimize/2,
80    grace_option/3,
81    grace_propagate/3,
82    grace_solution/0,
83    grace_register_var/1,
84    grace_start/1,
85    grace_stop/1,
86    nograce/0.
87
88:- use_module(matrix_util).
89
90:- begin_module(grace).
91
92:- export
93    get_parent/1,
94    set_parent/1,
95    trace_propagation/4,
96    trace_suspension/4.
97
98:- external(tcl_cut_fail/1).
99
100:- lib(util).
101
102:- set_flag(gc_interval, 100000).
103
104:- import
105	cut_to/1,
106	dom_range/3,
107	get_cut/1,
108	get_flag_body/4,
109	get_priority/1,
110	is_predicate_/2,
111	kill_suspension/2,
112	last_suspension/1,
113	last_scheduled/1,
114	new_scheduled/2,
115	set_default_error_handler/2,
116	set_priority/1,
117	set_priority/2,
118	setarg/3,
119	symbol_address/2,
120	unify_attributes/2
121    from sepia_kernel.
122
123:- lib(tk).
124:- call(lib(fd)).
125:- call(lib(structures)).
126:- lib(apply_macros).
127
128:- pragma(expand).
129
130:- tcl_source.
131
132:- is_predicate(add_attribute/3) -> true;
133	import add_attribute/3 from sepia_kernel.
134
135:- get_flag(version, Ver), Ver @< '3.5' ->
136	import
137	    get_global_variable/2,
138	    set_global_variable/2
139	from sepia_kernel
140    ;
141	(current_array(grace_data, _) ->
142	    true
143	;
144	    make_local_array(grace_data, global_reference)
145	)
146    .
147
148
149
150:- local
151	interrupt/0.
152
153% Our attribute, It is used only to attach some data to the variable
154:- meta_attribute(grace, [copy_term:copy_term_grace/2]).
155:- call(define_struct(grace(range, id, matrix))).
156
157copy_term_grace(X{AttrX}, Copy) :-
158    -?->
159    copy_term_grace(X, Copy, AttrX).
160
161copy_term_grace(Var, Copy, grace with id:Id) :-
162    (var(Id) ->
163	var_id(Var, Id)
164    ;
165	true
166    ),
167    add_attribute(Copy, grace with [range:0, id:Id], grace).
168
169tr_const(no_macro_expansion(default_prio), 9).
170tr_const(no_macro_expansion(matrix_prio), 8).
171tr_const(no_macro_expansion(display_prio), 7).
172tr_const(no_macro_expansion(varstack_prio), 6).
173tr_const(no_macro_expansion(run_prio), 6).
174
175:-  call((
176    define_macro(no_macro_expansion(default_prio), tr_const/2, []),
177    define_macro(no_macro_expansion(matrix_prio), tr_const/2, []),
178    define_macro(no_macro_expansion(display_prio), tr_const/2, []),
179    define_macro(no_macro_expansion(varstack_prio), tr_const/2, []),
180    define_macro(no_macro_expansion(run_prio), tr_const/2, []))).
181
182% no 'ensure_loaded' because it is the same module
183:- use_module(wake).
184:- compile(matrices).
185:- compile(label).
186:- compile(expr).
187:- compile(tkint).
188:- compile(toolbox).
189%:- compile(prop).
190:- compile(options).
191
192% The execution mode, one of:
193%	step -	stop on every labeling call (when selecting a variable)
194%	stepd -	step over every matrix domain update
195%	run(P) - stop only on breakpoints, run with prio P
196%	run_fast - stop only on breakpoints, no updates
197:- make_local_array(mode).
198
199:- make_local_array(solutions).
200:- make_local_array(choices).
201:- make_local_array(failures).
202:- make_local_array(stop).
203:- make_local_array(backward).
204:- make_local_array(selected).
205:- make_local_array(size).
206:- make_local_array(goal).
207:- make_local_array(de_count).
208:- make_local_array(grace).
209:- make_local_array(var_id).
210:- make_local_array(first_fail).
211:- make_local_array(cputime).
212:- make_local_array(print_size), setval(print_size, 8).
213:- make_local_array(optimize).
214:- make_local_array(module).
215:- make_local_array(startup).
216
217:- local_record(call).
218:- local_record(exit).
219:- local_record(fail).
220:- local_record(wake).
221:- local_record(delay).
222:- local_record(delay_goal).
223:- local_record(label).		% to display the label node
224
225:- set_flag(syntax_option, dense_output).
226:- setval(grace, on).
227
228:- op(700, xfx, [#=, ##, #\=, #>, #<, #>=, #<=, ::]).
229:- op(600, xfx, ..).
230:- op(100, fx, trace).		% for internal selective tracing
231
232
233% We must redefine the unification handler to take our wake/0 when necessary
234unify_handler([]) :-
235    wake.
236unify_handler([[Term|Attr]|List]) :-
237    -?->
238    unify_attributes(Term, Attr),
239    unify_handler(List).
240
241grace :-
242    setval(grace, on),
243    notrace.
244
245nograce :-
246    setval(grace, off),
247    reset_global_state.
248
249reset_global_state :-
250    default_wake,
251    reset_interrupt_handler(2).
252
253status_init :-
254    setval(mode, step),
255    setval(solutions, 0),
256    setval(choices, 0),
257    setval(failures,0),
258    setval(stop, 0),
259    setval(backward, 0),
260    setval(selected, 0),
261    setval(goal, 1),
262    setval(de_count, 0),
263    setval(var_id, 1),
264    setval(optimize, 0),
265    setval(startup, 0).
266
267
268%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
269%
270% Initialization
271%
272%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
273
274:- tool(grace_start/1, grace_start_body/2).
275
276grace_start_body(Title, Module) :-
277    getval(grace, off),
278    !,
279    set_data(d([], 0, 0, 0, 0)),
280    setval(module, Module),
281    default_options(Title).
282grace_start_body(Title, Module) :-
283    set_data(d([], 0, 0, 0, 0)),
284    set_default_error_handler(11, unify_handler/1),
285    set_error_handler(11, unify_handler/1),
286    default_wake,
287    block(start(Title, Module, cold), Tag, catch_exit(Tag, Title, Module)).
288
289catch_exit(Tag, _, _) :-
290    reset_global_state,
291    printf("Resetting...\n", []),
292    exit_block(Tag).
293
294start(Title, Module, _When) :-
295    status_init,
296    reset_propagation_trace,
297    set_suspension_counter(1),
298    set_first_suspension(1),
299    set_depth(0),
300    (tcl_eval('wm title .', ["Grace"|_]) ->
301	NewStart = fail
302    ;
303	check_protcl,
304	NewStart = true,
305	(tcl_eval('') ->
306	    true
307	;
308	    tk([])
309	),
310	tcl_source(control),
311	tcl_source(matrix),
312	tcl_source(varstack),
313	tcl_source(var),
314	%tcl_source(display),
315	tcl_source(constr),
316	tcl_source(add_menu),
317	%tcl_source(tree_ctr),
318	%tcl_source(tree),
319	%tcl_source(tree_smp),
320	tcl_source(request),
321	default_options(Title),
322	init_options(Module),
323	option(tk, init, InitS),
324	tcl(InitS)
325    ),
326    (process_options ->
327	true
328    ;
329	error(1, grace_start(Title))
330    ),
331    init_display(Title),
332    set_priority(default_prio, 0),
333    tcl_eval(['set grace_module ', Module]),
334    setval(module, Module),
335    message('Initializing...'),
336    set_interrupt_handler(2, interrupt/0),
337    reset_status,
338    reset_optimization,
339    print_status,
340    last_scheduled(LS),
341    last_suspension(LD),
342    set_parent(p(label(start, 0), [], LS, LD)),
343    step_mode,
344    tcl_eval(update),
345    message("Stopped").
346start(Title, Module, _) :-
347    getval(mode, M),
348    step_mode,
349    getval(solutions, Sol),
350    (M = retry(start) ->
351        message('Restarting'),
352        Wait = nowait
353    ;
354    (Sol = 0; Sol = opt(0)) ->
355	setval(solutions, 0),
356	message('No solutions'),
357	Wait = wait
358    ;
359	message('All solutions found'),
360	Wait = wait
361    ),
362    print_status,
363    tcl_eval(update),
364    end_propagation,
365    end_loop(Title, Wait, Module).
366
367end_loop(Title, Wait, Module) :-
368    (Wait = wait, handle_events -> true; true),
369    (option(control, restart, "restart") ->
370        Res = 1
371    ;
372	tcl_eval('request_user cv_restart "Restart" "Cancel" {Do you want to restart the program?}', Res)
373    ),
374    (Res = 1 ->
375	start(Title, Module, restart)
376    ;
377	end_loop(Title, Wait, Module)
378    ).
379
380init_display(Title) :-
381    option(control, geometry, CG),
382    option(varstack, geometry, VG),
383    tcl('grace_init {##} ## ##', [Title, CG, VG], New),
384    tcl(enable_selections),
385    tcl(stepd_reset),
386    (New = 1 ->
387	cold_init,
388	selection_init,
389	true
390    ;
391	true
392    ).
393
394cold_init :-
395    option(control, display, DM),
396    tcl('set cv_display ##', DM),
397    (option(control, print_trace, 1) ->
398	TM = 1,
399	do_print_trace
400    ;
401	TM = 0,
402	set_stream(susp, null),
403	do_not_print_trace
404    ).
405
406print_status :-
407    depth,
408    backtracks,
409    solutions,
410    goal,
411    delayed,
412    cost,
413    search_size,
414    print_time.
415
416% As long as we don't store them for each level
417reset_status :-
418    setval(solutions, 0),
419    statistics(times, [T|_]),
420    setval(cputime, T).
421
422reset_optimization :-
423    tcl('pack forget .lcost .lcostm'),
424    setval(optimize, 0).
425
426print_time :-
427    statistics(times, [T|_]),
428    Time is T - getval(cputime),
429    tcl_eval(['.ltimem configure -text [format "%.2f" ', Time, ']']).
430
431force_displays :-
432    get_priority(P),
433    set_priority(default_prio, 0),
434    wake,
435    true,
436    set_priority(P, 0).
437
438%
439% Storing and accessing data in the global descriptor
440%
441store_matrices(M) :-
442    set_data(1, M).
443
444get_matrices(M) :-
445    get_data(1, M).
446
447set_depth(M) :-
448    set_data(2, M).
449
450get_depth(M) :-
451    get_data(2, M).
452
453set_parent(M) :-
454    set_data(3, M).
455
456get_parent(M) :-
457    get_data(Stored),
458    (functor(Stored, d, 4) ->
459	arg(3, Stored, M)
460    ;
461	default_wake,
462	printf(error,
463	    "GRACE: resetting the waking routine, please restart.\n%b", []),
464	abort
465    ).
466
467get_last_choice(M) :-
468    get_data(4, M).
469
470set_last_choice(M) :-
471    set_data(4, M).
472
473set_cost(C) :-
474    set_data(5, C).
475
476get_cost(C) :-
477    get_data(5, C).
478
479set_data(N, Data) :-
480    get_data(Stored),
481    setarg(N, Stored, Data).
482
483get_data(N, Data) :-
484    get_data(Stored),
485    arg(N, Stored, Data).
486
487:- get_flag(version, Ver), Ver @< '3.5' ->
488	compile_term([
489
490get_data(Data) :-
491    get_global_variable(5, Data),
492
493set_data(Data) :-
494    set_global_variable(5, Stored)
495	])
496    ;
497	compile_term([
498get_data(Data) :-
499    getval(grace_data, Data),
500
501set_data(Data) :-
502    setval(grace_data, Data)
503	]).
504
505store_matrix(M) :-
506    get_matrices(L),
507    store_matrices([M|L]).
508
509inc_goal :-
510    incval(goal).
511
512inc_depth :-
513    get_depth(M),
514    M1 is M + 1,
515    set_depth(M1).
516    /*
517    (M1 < 6 ->
518	trace_depth(M1)
519    ;
520	true
521    ).
522    */
523
524inc_solutions :-
525    getval(solutions, S),
526    (integer(S) ->
527    	incval(solutions)
528    ;
529    	S =.. [F, N],
530    	N1 is N + 1,
531    	S1 =.. [F, N1],
532    	setval(solutions, S1)
533    ).
534
535split_list(List, N, ListOfLists) :-
536    split_list(List, 1, N, ListOfLists, L, L).
537
538split_list([V|List], N, N, [Row|LoL], Row, [V]) :-
539    !,
540    split_list(List, 1, N, LoL, L, L).
541split_list([V|List], I, N, LoL, Row, [V|L]) :-
542    I =< N,
543    !,
544    I1 is I + 1,
545    split_list(List, I1, N, LoL, Row, L).
546split_list([], _, _, [], [], []) :-
547    !.
548split_list([], _, _, [Row], Row, []).
549
550bell :-
551    tcl_eval(bell).
552
553check_protcl :-
554   is_predicate_(protcl_version/1, tk),
555   call(protcl_version(V), tk),
556   V @>= '2.2',
557   !.
558check_protcl :-
559    printf(error, "You need ProTcXl 2.2 or newer to run Grace\n%b", []),
560    abort.
561
562%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
563%
564%	Optimisation
565%
566%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
567
568grace_minimize(Expression) :-
569    do_minimize(all, Expression).
570
571grace_minimize(Vars, Expression) :-
572    do_minimize(Vars, Expression).
573
574do_minimize(V, Expression) :-
575    setval(optimize, 1),
576    set_text('', '.lcostm'),
577    tcl('pack .lcostm .lcost -in .ft -side right'),
578    getval(solutions, Sol),
579    setval(solutions, opt(0)),
580    term_to_linear(Expression, List),
581    linear_term_range(List, Min, Max),
582    Cost :: Min..Max,
583    Cost #= Expression,
584    set_cost(Cost),
585    grace_stop("Starting optimization"),
586    option(control, percent, Perc),
587    option(control, branch_and_bound, BB),
588    (V = all ->
589    	all_variables(Vars)
590    ;
591    	Vars = V
592    ),
593    %tcl('.options.menu.optimize entryconfigure all -state disabled'),
594    (BB = "continue" ->
595	minimize((grace_label_list(Vars), grace_solution), Cost, Min, Max, Perc)
596    ;
597	min_max((display_all_matrices, grace_label_list(Vars), grace_solution), Cost, Min, Max, Perc)
598    ),
599    reset_optimization,
600    setval(optimize, 2),
601    setval(solutions, Sol),
602    grace_solution.
603
604dummy(_).
605
606%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
607%
608%	Explicit Propagation
609%
610%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
611
612% Default definition which is usually overriden by a user-defined one
613% which is too constly to be applied on every step.
614grace_propagate(_, _, _).
615
616%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
617%
618%	Solution
619%
620%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
621
622grace_solution :-
623    getval(grace, off),
624    !.
625grace_solution :-
626    getval(optimize, Opt),
627    getval(mode, M),
628    (M = retry(start) ->
629        setval(optimize, 0),
630        fail
631    ;
632    Opt = 0 ->
633	Mess = 'Found a solution'
634    ;
635    	get_cost(Cost),
636	(var(Cost) ->
637	    dvar_domain(Cost, DC),
638	    dom_range(DC, Cost, _)
639	;
640	    % Fix the problem with minimize
641	    minimize_bound_check
642	),
643	(Opt = 1 ->
644	    concat_string(['Solution with cost ', Cost], Mess),
645	    set_text(Cost, '.lcostm')
646	;
647	    concat_string(['Optimal solution with cost ', Cost], Mess)
648	)
649    ),
650    inc_solutions,
651    single_option(control, display_solutions, Displ),
652    (Displ = 1 ->
653	force_displays,
654	print_time,
655	print_status
656    ;
657	solutions
658    ),
659    (
660	(M = step		% stop always in step mode
661	;
662	getval(stop, 0),	% stop in pure run mode unless all solls
663	option(control, all_solutions, 0)
664	;
665	Opt = 2)		% stop always on minimal solution
666    ->
667	display_all_matrices,
668	step_mode,
669	message(Mess),
670	end_propagation,
671	(Opt = 2 ->
672	    setval(optimize, 0)
673	;
674	    true
675	),
676	handle_events
677    ;
678	message(Mess)
679    ),
680    (Displ = _ ->
681	tcl_eval(update)
682    ;
683	true
684    ),
685    inc_goal,
686    Opt == 1,
687    (option(control, branch_and_bound, "restart") ->
688	% and now reset everything because we lose our choice points
689	getval(mode, Mode),
690	setval(mode, back_min_max(Mode)),
691	reset_varstack
692    ;
693    	true
694    ).
695
696%
697% Default procedure to check some particular property of the solution
698%
699check_matrices.
700
701grace_register_var(X) :-
702    add_attributes(X, "", "").
703
704%
705% All predicates that process the grace attribute
706%
707get_attribute(_{X}, Attr) :-
708    -?->
709    Attr = X.
710
711var_id(_{Attr}, Id) :-
712    -?->
713    Attr = with(grace, [id:Id]),
714    (var(Id) ->
715	getval(var_id, Id),
716	incval(var_id)
717    ;
718	true
719    ).
720
721var_matrix(_{Attr}, Name) :-
722    -?->
723    Attr = grace with [matrix:Name],
724    nonvar(Name).
725
726reset_var(_{grace with [range: Low..High]}, N, I, J) :-
727    -?->
728    concat_string([Low, .., High], S),
729    display_element(N, I, J, S).
730reset_var(V, _, _, _) :-
731    nonvar(V).
732
733add_attributes(X, Name, Id) :-
734    var(X),
735    (is_domain(X) ->
736	my_dom_range(X, Min, Max),      %MGW
737	add_attribute(X, grace with [range: Min..Max, id:Id, matrix:Name], grace)
738    ;
739    	% A free vriable; suppose this is a dummy variable that should
740    	% not be displayed. We ground it for convenience
741    	X = dummy_var,
742	tcl('m_ignore_var ##', Id)
743    ).
744add_attributes(X, _, _) :-
745    nonvar(X).
746
747my_dom_range(X,Min,Max) :-
748      is_integer_domain(X), !,
749      dvar_domain(X,Dom),
750      dom_range(Dom,Min,Max).
751my_dom_range(X,Min,Max) :-
752      dom(X,Dom),
753      sort(Dom,SDom),
754      firstel(SDom,Min),
755      lastel(SDom,Max).
756
757firstel([H|_],H).
758
759lastel([Last],Last) :- !.
760lastel([_|T],Last) :- lastel(T,Last).
761
762reset_varstack :-
763    get_depth(D),
764    tcl_eval(['reset_varstack .vs.c ', D]).
765
766reset_displays :-
767    tcl_eval(['reset_displays .de']).
768
769debug_handler_p(_, _) :- get_priority(P), writeln(P).
770:- global debug_handler_p/2.
771
772%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
773%
774% Stop
775%
776%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
777
778grace_stop(_) :-
779    getval(grace, off),
780    !.
781grace_stop(Mess) :-
782    end_propagation,
783    step_mode,
784    print_status,
785    message(Mess),
786    handle_events.
787
788
789%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
790%
791% Variable and Value Selection
792%
793%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
794selection_init :-
795    tcl('.varsel.menu delete 0 last'),
796    option(control, var_selections, VarList),
797    add_var_selections(VarList),
798    option(control, var_selection, VarSelect),
799    set_var_selection(VarSelect),
800
801    tcl('.valsel.menu delete 0 last'),
802    option(control, value_selections, ValList),
803    add_value_selections(ValList),
804    option(control, value_selection, ValSelect),
805    set_value_selection(ValSelect).
806
807add_var_selections([]).
808add_var_selections([[_, N]|L]) :-
809    (tcl('add_var_selection {##}', [N]) -> true; true),
810    add_var_selections(L).
811
812set_var_selection(Index) :-
813    single_option(control, var_selections, List),
814    memberchk([Pred, Index], List),
815    (Pred = M:N/2 ->
816        Goal =.. [N, L, V],
817        Call = call_explicit(Goal, M)
818    ;
819    	Pred = N/2,
820    	Call =.. [N, L, V]
821    ),
822    compile_term(select_var(L, V) :- Call),
823    (tcl('set var_selection {##}', Index) -> true; true).
824
825add_value_selections([]).
826add_value_selections([[_, N]|L]) :-
827    (tcl('add_value_selection {##}', [N]) -> true; true),
828    add_value_selections(L).
829
830set_value_selection(Index) :-
831    single_option(control, value_selections, List),
832    memberchk([Pred, Index], List),
833    (Pred = M:N/3 ->
834        Goal =.. [N, V, L, L1],
835        Call = call_explicit(Goal, M)
836    ;
837    	Pred = N/3,
838    	Call =.. [N, V, L, L1]
839    ),
840    compile_term(select_value(V, L, L1) :- Call),
841    (tcl('set var_selection {##}', Index) -> true; true).
842
843%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
844% File initialisation
845%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
846
847:- status_init.
848
849:- call_explicit(set_error_handler(333, x_handler/2), sepia_kernel).
850
851%
852% Default stuff until propagation included
853%
854
855init_propagation_trace.
856reset_propagation_trace.
857end_propagation.
858
859trace_suspension(_, _, _, grace) :- !.
860trace_suspension(_, Goal, _, _) :-
861    our_goal(Goal),
862    !.
863trace_suspension(Port, Goal, _Mark, _) :-
864    printf(susp, "%s %GDmw\n%b", [Port, Goal]).
865
866