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% Display Constraints
26%
27%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
28
29:- begin_module(grace).
30:- call(lib(fd)).
31
32list_constraints(N, I, J) :-
33    matrix_element(N, I, J, Var),
34    setval(listed, listed(N, I, J)),
35    delayed_goals(Var, DG),
36    sort(DG, DGS),
37    goals_to_tcl(DGS, List),
38    option(constraints, geometry, CG),
39    tcl('list_constraints .cl ## ##', [CG, List]),
40    tk_next_event(E),
41    % we don't pass the DG list because then the garbage collector could
42    %  not get rid of it
43    process_constraints(Var, E).
44
45process_constraints(_, ["quit_constraints"]) :-
46    !.
47process_constraints(Var, ["add_constraint", I]) :-
48    !,
49    delayed_goals(Var, DG),
50    sort(DG, DGS),
51    find_goal(DGS, I, Goal),
52    display_expression(Goal),
53    tk_next_event(E),
54    process_constraints(Var, E).
55process_constraints(_, ["constraints", N, I, J]) :-
56    !,
57    list_constraints(N, I, J).
58process_constraints(Var, _) :-			% we ignore everything else
59    !,
60    tk_next_event(E),
61    process_constraints(Var, E).
62
63find_goal([G|L], I, Goal) :-
64    our_goal(G),
65    !,
66    find_goal(L, I, Goal).
67find_goal([Goal|_], 0, Goal) :-
68    !.
69find_goal([_|L], I, Goal) :-
70    I1 is I - 1,
71    find_goal(L, I1, Goal).
72
73display_expression(element(A, B, C, _, _)) :-
74    !,
75    qg_display_value(element(A, B, C), fd).
76display_expression(fd_eq(L)) :-
77    !,
78    display_lin_value(L, "0 #=").
79display_expression(fd_ge(L)) :-
80    !,
81    display_lin_value(L, "0 #>=").
82display_expression(gec(X, K, Y, C)) :-
83    !,
84    qg_display_value(X + K*Y + C, "0 #<=").
85display_expression(fd_ineq(L)) :-
86    !,
87    display_lin_value(L, "0 ##").
88display_expression(Goal) :-
89    Goal = gec_ent(_, _, _, _, _),
90    !,
91    qg_display_value(Goal, "#>=").
92display_expression(Goal) :-
93    functor(Goal, Name, _),
94    qg_display_value(Goal, Name).
95
96our_goal(print_delay(_, _, _, _)).
97our_goal(stepd_delay(_, _, _)).
98our_goal(breakpoint(_, _, _)).
99our_goal(update_stack_variable(_, _)).
100our_goal(display_inst(_, _, _)).
101our_goal(constrain_max_index(_, _)).
102
103%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
104%
105% Print Expressions
106%
107%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
108
109qg_display_value(_, _) :-
110    getval(grace, off),
111    !.
112qg_display_value(Expr, Name) :-
113    init_de(Name, W),
114    (nonvar(Expr), term_to_linear(Expr, List) ->
115	display_list(List, 1, W)
116    ;
117	display_expression(Expr, W)
118    ).
119
120display_lin_value(List, Name) :-
121    init_de(Name, W),
122    display_list(List, 0, W).
123
124init_de(Name, W) :-
125    getval(de_count, DC),
126    incval(de_count),
127    concat_string(['.de.', DC], W),
128    tcl_eval(['de_init ', W, ' {', Name, '}']).
129
130display_list([K*Var|L], J, W) :-
131    !,
132    (K = 1 ->
133	Cf = "+"
134    ;
135    K > 0 ->
136	concat_string([+, K, *], Cf)
137    ;
138    K = -1 ->
139	Cf = "-"
140    ;
141	concat_string([K, *], Cf)
142    ),
143    var_link(Var, W, J, VarId, Link),
144    el_to_const(Var, DomS, _),
145    tcl_eval(['de_append_str ', W, ' ', J, ' {', Cf, '}']),
146    tcl_eval(['de_append_var ', W, ' ', J, ' {', DomS, '} ', Link]),
147    print_delay(Var, DomS, VarId, display_prio),
148    make_suspension(display_inst(Var, W, J), display_prio, Susp),
149    insert_suspension(Var, Susp, inst of suspend, suspend),
150    J1 is J + 1,
151    display_list(L, J1, W).
152display_list([K|L], J, W) :-
153    integer(K),
154    tcl_eval(['de_update_inst ', W, ' ', K]),
155    display_list(L, J, W).
156display_list([], _, W) :-
157    tcl_eval(['de_check_inst ', W]).
158
159display_inst(Var, W, J) :-
160    (tcl_eval(['de_var_inst_save ', W, ' ', J], [IntVal, Before]) ->
161	update_de_inst(Var, W, J, IntVal, Before)
162    ;
163	true
164    ).
165
166update_de_inst(Var, W, J, Val, _) :-
167    tcl_eval(['catch {de_var_inst ', W, ' ', J, ' ', Var, ' ', Val, '}']).
168update_de_inst(_, W, J, Val, Before) :-
169    tcl_eval(['catch {de_var_restore ', W, ' ', J, ' ', Val, ' ', Before, '}']),
170    fail.
171
172display_expression(Expr, W) :-
173    decompose_expr(Expr, List, _),
174    display_expression_list(List, 1, 1, W).
175
176display_expression_list([], _, _, W) :-
177    tcl_eval(['de_check_inst ', W]).
178display_expression_list([H|T], Jv, Ji, W) :-
179    (var(H) ->
180	var_link(H, W, Jv, VarId, Link),
181	el_to_const(H, DomS, _),
182	tcl_eval(['de_append_var ', W, ' ', Jv, ' {', DomS, '} ', Link]),
183	print_delay(H, DomS, VarId, display_prio),
184	Jv1 is Jv + 1,
185	Ji1 = Ji
186    ;
187	tcl_eval(['de_append_str ', W, ' ', Ji, ' {', H, '}']),
188	Ji1 is Ji + 1,
189	Jv1 = Jv
190    ),
191    display_expression_list(T, Jv1, Ji1, W).
192
193var_link(Var, W, J, VarId, Link) :-
194    concat_string([W, ., 'v', J], VarId),
195    (find_variable(Var, Type, X, Y) ->
196	concat_string([., Type, ., X, ., Y], Link),
197	get_attribute(Var, grace with [id:Link])
198    ;
199	(get_attribute(Var, grace with [id:Link]) ->
200	    (nonvar(Link) ->
201		true
202	    ;
203		VarId = Link
204	    )
205	;
206	    VarId = Link,
207	    add_attribute(Var, grace with [id:Link], grace)
208	)
209    ).
210
211