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