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% Predicates to trace and display 26% the propagation between labeling steps. 27% 28%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 29 30:- begin_module(grace). 31:- call(lib(fd)). 32 33% 34% Deamon on the labelled variable 35% 36start_stepw_deamon(Inst) :- 37 nonvar(Inst). 38start_stepw_deamon(Var) :- 39 (getval(mode, stepw) -> 40 copy_term(Var, CVar), 41 make_suspension(stepw_deamon(Var, CVar), 1, Susp), 42 insert_suspension(Var, Susp, constrained of suspend, suspend) 43 ; 44 true 45 ). 46 47stepw_deamon(Val, Var) :- 48 get_depth(D), 49 record(label, [label(Val, D)|Var]), 50 %trace 51 init_propagation_trace(label(Val, D)). 52 53% 54% Recording the information 55% 56trace_suspension(_, _, _, grace) :- !. 57trace_suspension(Port, Goal, Mark, _) :- 58 %printf("%s %w %GDmVw\n%b", [Port, Mark, Goal]), 59 handle_suspension_trace(Port, Goal, Mark). 60 61handle_suspension_trace('CALL', Goal, Mark) :- 62 copy_term(Goal, Copy), 63 record(call, [Mark|Copy]). 64handle_suspension_trace('EXIT', Goal, Mark) :- 65 copy_term(Goal, Copy), 66 record(exit, [Mark|Copy]). 67handle_suspension_trace('REC_WAKE', Goal, Mark) :- 68 copy_term(Goal, Copy), 69 record(exit, [Mark|Copy]). 70handle_suspension_trace('FAIL', _Goal, Mark) :- 71 (getval(first_fail, 1) -> 72 record(fail, Mark), 73 setval(first_fail, 0) 74 ; 75 true 76 ). 77 78% 79% We can only record goals, no suspensions, because of bug #731, otherwise 80% we would duplicate them 81trace_propagation(Mark, Woken, Delayed, First) :- 82 %printf("+%w (%d) %VDw %VDw\n", [Mark, First, Woken, Delayed]), 83 record_propagation(Mark, Woken, Delayed, First). 84 85record_propagation(Mark, Woken, Delayed, First) :- 86 woken_goals(Woken, First, WokenList), 87 delayed_list(Delayed, 16'7fffffff, DelayedList), % always new 88 (WokenList = [] -> 89 true 90 ; 91 record(wake, [Mark|WokenList]) 92 ), 93 (DelayedList = [] -> 94 true 95 ; 96 record(delay, [Mark|DelayedList]) 97 ). 98 99% 100% filter our local goals and create a list of marks 101% 102woken_goals(L, First, W) :- 103 (woken_goals(L, First, W, -1)). 104 105woken_goals([], _, [], _). 106woken_goals([Susp|S], First, L, Last) :- 107 (suspension_to_goal(Susp, _, grace) -> 108 woken_goals(S, First, L, Last) 109 ; 110 %printf("in woken: %Vw\n", [Susp]), 111 suspension_mark(Susp, First, Mark), 112 Mark > 0, 113 Mark \== Last -> 114 L = [Mark|L1], 115 woken_goals(S, First, L1, Mark) 116 ; 117 woken_goals(S, First, L, Last) 118 ). 119 120% 121% New suspensions. Filter out our goals and mark the rest. 122% 123delayed_list([], _, []). 124delayed_list([Susp|S], New, L) :- 125 suspension_to_goal(Susp, Goal, Module), 126 (Module = grace -> 127 L1 = L 128 ; 129 (suspension_mark(Susp, New, Mark) -> 130 copy_term(Goal, Copy), 131 record(delay_goal, [Mark|Copy]), 132 L = [Mark|L1] 133 ; 134 L1 = L 135 ) 136 ), 137 delayed_list(S, New, L1). 138 139 140init_propagation_trace(Label) :- 141 get_parent(p(_, _, LS, _)), 142 garbage_collect, 143 new_scheduled(LS, Woken), 144 get_suspension_counter(SC), 145 (tcl_eval('set .tc.reg.var', 0) -> 146 % Replace 147 set_first_suspension(SC) 148 ; 149 % Add 150 set_first_suspension(SC) 151 ), 152 %printf("----init: label %w, first counter %d\n%b", [Label, SC]), 153 %printf("\twoken: %Vw\n", [Woken]), 154 %printf("\tlast scheduled: %w\n", [LS]), 155 %trace 156 record_propagation(Label, Woken, [], SC), 157 setval(first_fail, 1), 158 last_scheduled(LS1), 159 last_suspension(LD1), 160 set_parent(p(Label, [], LS1, LD1)). 161 162reset_propagation_trace :- 163 erase_all(call), 164 erase_all(exit), 165 erase_all(fail), 166 erase_all(wake), 167 erase_all(delay), 168 erase_all(delay_goal), 169 erase_all(label), 170 (current_array(goals(_, _), _) -> 171 erase_array(goals/2) 172 ; 173 true 174 ). 175 176:- global pp/0. 177pp :- 178 recorded_list(call, CL), 179 recorded_list(exit, EL), 180 recorded_list(delay, DL), 181 recorded_list(wake, WL), 182 recorded_list(fail, FL), 183 printf("\ncall=", []), 184 print_array(0, CL), 185 printf("\nexit=", []), 186 print_array(1, EL), 187 printf("\ndelay=", []), 188 print_list(DL), 189 printf("\nwake=", []), 190 print_list(WL), 191 printf("\nfail=", []), 192 print_list(FL). 193 194pl(Key) :- 195 recorded_list(Key, L), 196 printf("\n%s=", [Key]), 197 print_list(L). 198 199print_array(I, []) :- 200 current_array(goals(N, _), _), 201 N1 is N - 1, 202 between(0, N1, 1, C), 203 getval(goals(C, I), Goal), 204 (var(Goal) -> 205 true 206 ; 207 printf("%d\t%w\n%b", [C, Goal]) 208 ), 209 fail; true. 210print_array(_, [H|T]) :- 211 print_list([H|T]). 212 213%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 214% 215% Displaying the propagation tree 216% 217%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 218 219% 220% Display the whole propagation. Since we don't have a good graph 221% package, display it as a tree. 222% 223make_graph(1) :- 224 woken_graph(1). 225make_graph(3) :- 226 simple_graph(1). 227 228woken_graph(Eager) :- 229 make_tree('.t', "Propagation Tree", 30, horizontal, Tree, 1), 230 recorded_list(wake, WL), 231 goal_graph(Tree, WL, Eager). 232 233simple_graph(Eager) :- 234 tcl_eval('make_simple_tree .st', Tree), 235 recorded_list(wake, WL), 236 simple_tree(Tree, WL, Eager). 237 238delayed_graph(Eager) :- 239 make_tree('.t', "Propagation Tree", 30, horizontal, Tree, 1), 240 recorded_list(delay, DL), 241 goal_graph(Tree, DL, Eager). 242 243% 244% Display the sequence of updates of a specified variable 245% 246display_var_updates(Id) :- 247 current_array(goals(Max, _), _), 248 make_list_of_var_nodes(0, Max, Id, List), 249 (List = [] -> 250 true 251 ; 252 failed_nodes_list(FL, List), 253 sort(2, =<, FL, FL1), % to get I-fail after I-Node 254 label_nodes_list(LL, FL1, MD), 255 keysort(LL, Sorted), 256 make_tree('.tv', "Variable Updates", 10, vertical, Tree, 0), 257 display_var_nodes(Tree, Sorted, MD), 258 colour_failed_nodes(Tree) 259 ). 260 261make_tree(Top, Title, ParDistance, Layout, Tree, Replace) :- 262 tcl_eval(['make_tree ', Top, ' "', Title, '" ', 263 ParDistance, ' ', Layout, ' ', Replace], Tree). 264 265% 266% Make a list of all nodes which have modified the given variable 267make_list_of_var_nodes(I, Max, Id, List) :- 268 I < Max, 269 !, 270 I1 is I + 1, 271 goal_format(I, Call, Exit), 272 (var_in_term(Id, Call, CVar) -> 273 (var_in_term(Id, Exit, EVar), 274 same_domain(CVar, EVar), 275 not(recorded(fail, I)) -> 276 make_list_of_var_nodes(I1, Max, Id, List) 277 ; 278 % different or not there - must be instantiated 279 getval(goals(I, 2), Order), 280 List = [Order-I|L], 281 make_list_of_var_nodes(I1, Max, Id, L) 282 ) 283 ; 284 make_list_of_var_nodes(I1, Max, Id, List) 285 ). 286make_list_of_var_nodes(_, _, _, []). 287 288failed_nodes_list(List, Link) :- 289 recorded_list(fail, FL), 290 failed_nodes_list(FL, List, Link). 291 292failed_nodes_list([], L, L). 293failed_nodes_list([H|T], [O-fail|List], Link) :- 294 getval(goals(H, 2), O), 295 failed_nodes_list(T, List, Link). 296 297label_nodes_list(List, Link, MD) :- 298 recorded_list(wake, WL), 299 label_nodes_list(WL, List, Link, 0, MD). 300 301label_nodes_list([], L, L, M, M). 302label_nodes_list([[label(_, D), H|_]|T], [O1-l(D)|List], Link, M, MD) :- 303 !, 304 getval(goals(H, 2), O), 305 O1 is O, 306 (D > M -> 307 M1 = D 308 ; 309 M1 = M 310 ), 311 label_nodes_list(T, List, Link, M1, MD). 312label_nodes_list([_|T], List, Link, M, MD) :- 313 label_nodes_list(T, List, Link, M, MD). 314 315display_var_nodes(Tree, [_-P|L], _MD) :- 316 (L = [] -> 317 add_successors(Tree, P, [], 1, 0) 318 ; 319 display_var_nodes(Tree, P, L, []), 320 fail; true 321 ). 322 323display_var_nodes(_, _, [], _). 324display_var_nodes(Tree, P, [_-C|L], Lab) :- 325 (P = fail -> 326 display_var_nodes(Tree, C, L, Lab) 327 ; 328 C = fail -> 329 display_var_nodes(Tree, P, L, Lab) 330 ; 331 C = l(D) -> 332 (find_stack_depth(Lab, D, LN, NewLab) -> 333 display_var_nodes(Tree, C, L, NewLab) 334 ; 335 display_var_nodes(Tree, C, L, [D-P|Lab]) 336 ) 337 ; 338 P = l(D) -> 339 (find_stack_depth(Lab, D, LN, NewLab) -> 340 true 341 ; 342 LN = start, 343 NewLab = [D-start|Lab] 344 ), 345 add_successors(Tree, LN, [C], 0, 0), 346 display_var_nodes(Tree, C, L, NewLab) 347 ; 348 add_successors(Tree, P, [C], 0, 0), 349 display_var_nodes(Tree, C, L, Lab) 350 ). 351 352find_stack_depth(L, D, LN, L) :- 353 L = [D-LN|_], 354 !. 355find_stack_depth([H-_|T], D, LN, L) :- 356 H > D, 357 find_stack_depth(T, D, LN, L). 358 359/* 360display_var_nodes(Tree, [_-P|L]) :- 361 (L = [] -> 362 add_successors(Tree, P, [], 1, 0) 363 ; 364 display_var_nodes(Tree, P, L, 0) 365 ). 366 367display_var_nodes(_, _, [], _). 368display_var_nodes(Tree, P, [_-C|L], Fail) :- 369 (P = fail -> 370 display_var_nodes(Tree, C, L, Fail) 371 ; 372 C = fail -> 373 display_var_nodes(Tree, P, L, 1) 374 ; 375 add_successors(Tree, P, [C], 1, Fail), 376 display_var_nodes(Tree, C, L, 0) 377 ). 378*/ 379 380goal_graph(Tree, [], _) :- 381 colour_failed_nodes(Tree). 382goal_graph(Tree, [[Parent|Woken]|List], Eager) :- 383 sort(Woken, Sorted), 384 add_successors(Tree, Parent, Sorted, Eager, 0), 385 goal_graph(Tree, List, Eager). 386 387add_successors(Tree, Parent, Children, Eager, Fail) :- 388 goals_list(Children, WList), 389 list_to_tcl(WList, TclList), 390 (Parent = label(V, D) -> 391 concat_string(['label(', V, ',', D, ')'], ParT) 392 ; 393 ParT = Parent 394 ), 395 ((integer(Parent); Parent = label(_, _)) -> 396 goal_to_node(Parent, PNode) 397 ; 398 PNode = Parent 399 ), 400 tcl_eval(['add_successors ', Tree, ' ', ParT, ' ', PNode, 401 TclList, Eager, ' ', Fail]). 402 403colour_failed_nodes(Tree) :- 404 recorded_list(fail, FL), 405 list_to_tcl(FL, FTcl), 406 tcl_eval(['tree_failed_nodes ', Tree, ' ', FTcl]). 407 408simple_tree(_, [], _). 409simple_tree(Tree, [[Parent|Woken]|List], Eager) :- 410 sort(Woken, Sorted), 411 add_simple_successors(Tree, Parent, Sorted, Eager, 0), 412 simple_tree(Tree, List, Eager). 413 414add_simple_successors(Tree, Parent, Children, Eager, _Fail) :- 415 simple_goal_list(Children, CL), 416 list_to_tcl(CL, TclList), 417 (Parent = label(V, D) -> 418 concat_string(['label(', V, ',', D, ')'], ParT) 419 ; 420 ParT = Parent 421 ), 422 tcl_eval(['add_simple_successors ', Tree, ' ', ParT, ' ', 423 TclList, Eager]). 424 425simple_goal_list([], []). 426simple_goal_list([G|L], [C|T]) :- 427 (goal_modified(G) -> 428 list_to_tcl([G, red], C) 429 ; 430 list_to_tcl([G, black], C) 431 ), 432 simple_goal_list(L, T). 433 434 435goals_list([], []). 436goals_list([G|T], [W|L]) :- 437 goal_to_node(G, GoalS), 438 !, 439 concat_string(['{', G, GoalS, '}'], W), 440 goals_list(T, L). 441goals_list([_|T], L) :- 442 goals_list(T, L). 443 444% Fake GC to get rid of the long list 445call_number(_) :- 446 recorded_list(call, CList), 447 length(CList, Length), 448 setval(nodes, Length), 449 fail. 450call_number(X) :- 451 getval(nodes, X). 452 453goal_format(label(V, D), Var, V) :- 454 !, 455 recorded(label, [label(V, D)|Var]). 456goal_format(Index, Goal, Exit) :- 457 getval(goals(Index, 0), Goal), 458 getval(goals(Index, 1), Exit), 459 (var(Exit) -> 460 Exit = Goal 461 ; 462 true 463 ). 464 465% 466% Process the recorded data, move records to arrays where direct 467% access is necessary 468% 469end_propagation :- 470 get_suspension_counter(SC), 471 (SC > 1 -> 472 (call_number(CN), 473 CN > 0 -> 474 prop_register(CN, 1), 475 % Move the data from records to arrays, because we need 476 % direct access 477 goals_array(SC), 478 findall((Lab,D)-L, (recorded(delay, [label(Lab, D)|L], Ref), erase(Ref)), DL), 479 prune_delays(DL) 480 ; 481 recorded(wake, _) -> 482 recorded_list(wake, WL), 483 flatten(WL, WLF), 484 sort(WLF, WLFS), 485 length(WLFS, N), 486 prop_register(N, 0) 487 ) 488 ; 489 tcl_eval('tc_register .tc {}') 490 ). 491 492prop_register(CN, Calls) :- 493 (CN = 1 -> G = " goal"; G = " goals"), 494 concat_string([CN, G, " registered"], Text), 495 tcl_eval(['tc_register .tc "', Text, '" ', Calls]). 496 497prune_delays([(Lab,D)-DL|L]) :- 498 filter_delays(DL, CDL), 499 (CDL = [] -> 500 true 501 ; 502 recorda(delay, [label(Lab, D)|CDL]) 503 ), 504 prune_delays(L). 505prune_delays([]). 506 507goals_array(C) :- 508 C1 is C + 1, 509 (current_array(goals(_, _), _) -> 510 erase_array(goals/2) 511 ; 512 true 513 ), 514 make_local_array(goals(C1, 3)), 515 recorded_list(call, CList), 516 insert_calls(CList, 0), 517 erase_all(call), 518 recorded_list(exit, EList), 519 insert_exits(EList), 520 erase_all(exit), 521 recorded_list(delay_goal, DG), 522 insert_delay_goals(DG, 0), 523 erase_all(delay_goal), 524 true. 525 526insert_calls([], _). 527insert_calls([[M|Goal]|List], I) :- 528 setval(goals(M, 0), Goal), 529 setval(goals(M, 2), I), 530 I1 is I + 1, 531 insert_calls(List, I1). 532 533insert_exits([]). 534insert_exits([[M|Goal]|List]) :- 535 setval(goals(M, 1), Goal), 536 insert_exits(List). 537 538insert_delay_goals([], _). 539insert_delay_goals([[M|Goal]|List], I) :- 540 getval(goals(M, I), G), 541 (var(G) -> 542 setval(goals(M, I), Goal) 543 ; 544 true 545 ), 546 insert_delay_goals(List, I). 547 548filter_delays([], []). 549filter_delays([D|DL], [D|CL]) :- 550 recorded(delay, [D|_]), 551 !, 552 filter_delays(DL, CL). 553filter_delays([_|DL], CL) :- 554 filter_delays(DL, CL). 555 556var_in_term(Id, Var{grace:(grace with id:I)}, V) :- 557 -?-> 558 I = Id, 559 !, 560 V = Var. 561var_in_term(Id, Term, Var) :- 562 compound(Term), 563 Term = [_|_], 564 !, 565 var_in_term_list(Id, Term, Var). 566var_in_term(Id, Term, Var) :- 567 compound(Term), 568 Term =.. [_|Args], 569 var_in_term_list(Id, Args, Var). 570 571var_in_term_list(Id, [Term|_], Var) :- 572 var_in_term(Id, Term, Var), 573 !. 574var_in_term_list(Id, [_|L], Var) :- 575 var_in_term_list(Id, L, Var). 576 577same_domain(V1, V2) :- 578 dvar_domain(V1, D), 579 dvar_domain(V2, D). 580