1 2#include <string.h> 3#include "tcl.h" 4#include <t.h> 5#include <util.h> 6 7/* .................................................. */ 8 9static int t_walkdfspre (Tcl_Interp* interp, TN* tdn, t_walk_function f, 10 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 11 Tcl_Obj* action); 12static int t_walkdfspost (Tcl_Interp* interp, TN* tdn, t_walk_function f, 13 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 14 Tcl_Obj* action); 15static int t_walkdfsin (Tcl_Interp* interp, TN* tdn, t_walk_function f, 16 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 17 Tcl_Obj* action); 18static int t_walkdfsboth (Tcl_Interp* interp, TN* tdn, t_walk_function f, 19 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 20 Tcl_Obj* enter, Tcl_Obj* leave); 21static int t_walkbfspre (Tcl_Interp* interp, TN* tdn, t_walk_function f, 22 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 23 Tcl_Obj* action); 24static int t_walkbfspost (Tcl_Interp* interp, TN* tdn, t_walk_function f, 25 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 26 Tcl_Obj* action); 27static int t_walkbfsboth (Tcl_Interp* interp, TN* tdn, t_walk_function f, 28 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 29 Tcl_Obj* enter, Tcl_Obj* leave); 30 31/* .................................................. */ 32 33int 34t_walkoptions (Tcl_Interp* interp, int n, 35 int objc, Tcl_Obj* CONST* objv, 36 int* type, int* order, int* remainder, 37 char* usage) 38{ 39 int i; 40 Tcl_Obj* otype = NULL; 41 Tcl_Obj* oorder = NULL; 42 43 static CONST char* wtypes [] = { 44 "bfs", "dfs", NULL 45 }; 46 static CONST char* worders [] = { 47 "both", "in", "pre", "post", NULL 48 }; 49 50 for (i = 3; i < objc; ) { 51 ASSERT_BOUNDS (i, objc); 52 if (0 == strcmp ("-type", Tcl_GetString (objv [i]))) { 53 if (objc == (i+1)) { 54 Tcl_AppendResult (interp, 55 "value for \"-type\" missing", 56 NULL); 57 return TCL_ERROR; 58 } 59 60 ASSERT_BOUNDS (i+1, objc); 61 otype = objv [i+1]; 62 i += 2; 63 64 } else if (0 == strcmp ("-order", Tcl_GetString (objv [i]))) { 65 if (objc == (i+1)) { 66 Tcl_AppendResult (interp, 67 "value for \"-order\" missing", 68 NULL); 69 return TCL_ERROR; 70 } 71 72 ASSERT_BOUNDS (i+1, objc); 73 oorder = objv [i+1]; 74 i += 2; 75 76 } else if (0 == strcmp ("--", Tcl_GetString (objv [i]))) { 77 i++; 78 break; 79 } else { 80 break; 81 } 82 } 83 84 if (i == objc) { 85 Tcl_WrongNumArgs (interp, 2, objv, usage); 86 return TCL_ERROR; 87 } 88 89 if ((objc - i) > n) { 90 Tcl_AppendResult (interp, "unknown option \"", NULL); 91 Tcl_AppendResult (interp, Tcl_GetString (objv [i]), NULL); 92 Tcl_AppendResult (interp, "\"", NULL); 93 return TCL_ERROR; 94 } 95 96 if (!otype) { 97 *type = WT_DFS; 98 } else if (Tcl_GetIndexFromObj (interp, otype, wtypes, "search type", 99 0, type) != TCL_OK) { 100 return TCL_ERROR; 101 } 102 103 if (!oorder) { 104 *order = WO_PRE; 105 } else if (Tcl_GetIndexFromObj (interp, oorder, worders, "search order", 106 0, order) != TCL_OK) { 107 return TCL_ERROR; 108 } 109 110 if ((*order == WO_IN) && (*type == WT_BFS)) { 111 Tcl_AppendResult (interp, 112 "unable to do a in-order breadth first walk", 113 NULL); 114 return TCL_ERROR; 115 } 116 117 *remainder = i; 118 return TCL_OK; 119} 120 121/* .................................................. */ 122 123int 124t_walk (Tcl_Interp* interp, TN* tdn, int type, int order, 125 t_walk_function f, Tcl_Obj* cs, 126 Tcl_Obj* avn, Tcl_Obj* nvn) 127{ 128 int res; 129 Tcl_Obj* la = NULL; 130 Tcl_Obj* lb = NULL; 131 132 switch (type) 133 { 134 case WT_DFS: 135 switch (order) 136 { 137 case WO_BOTH: 138 la = Tcl_NewStringObj ("enter",-1); Tcl_IncrRefCount (la); 139 lb = Tcl_NewStringObj ("leave",-1); Tcl_IncrRefCount (lb); 140 141 res = t_walkdfsboth (interp, tdn, f, cs, avn, nvn, la, lb); 142 143 Tcl_DecrRefCount (la); 144 Tcl_DecrRefCount (lb); 145 break; 146 147 case WO_IN: 148 la = Tcl_NewStringObj ("visit",-1); Tcl_IncrRefCount (la); 149 150 res = t_walkdfsin (interp, tdn, f, cs, avn, nvn, la); 151 152 Tcl_DecrRefCount (la); 153 break; 154 155 case WO_PRE: 156 la = Tcl_NewStringObj ("enter",-1); Tcl_IncrRefCount (la); 157 158 res = t_walkdfspre (interp, tdn, f, cs, avn, nvn, la); 159 160 Tcl_DecrRefCount (la); 161 break; 162 163 case WO_POST: 164 la = Tcl_NewStringObj ("leave",-1); Tcl_IncrRefCount (la); 165 166 res = t_walkdfspost (interp, tdn, f, cs, avn, nvn, la); 167 168 Tcl_DecrRefCount (la); 169 break; 170 } 171 break; 172 173 case WT_BFS: 174 switch (order) 175 { 176 case WO_BOTH: 177 la = Tcl_NewStringObj ("enter",-1); Tcl_IncrRefCount (la); 178 lb = Tcl_NewStringObj ("leave",-1); Tcl_IncrRefCount (lb); 179 180 res = t_walkbfsboth (interp, tdn, f, cs, avn, nvn, la, lb); 181 182 Tcl_DecrRefCount (la); 183 Tcl_DecrRefCount (lb); 184 break; 185 186 case WO_PRE: 187 la = Tcl_NewStringObj ("enter",-1); Tcl_IncrRefCount (la); 188 189 res = t_walkbfspre (interp, tdn, f, cs, avn, nvn, la); 190 191 Tcl_DecrRefCount (la); 192 break; 193 194 case WO_POST: 195 la = Tcl_NewStringObj ("leave",-1); Tcl_IncrRefCount (la); 196 197 res = t_walkbfspost (interp, tdn, f, cs, avn, nvn, la); 198 199 Tcl_DecrRefCount (la); 200 break; 201 } 202 break; 203 } 204 205 /* Error and Return are passed unchanged. Everything else is ok */ 206 207 if (res == TCL_ERROR) {return res;} 208 if (res == TCL_RETURN) {return res;} 209 return TCL_OK; 210} 211 212 213/* .................................................. */ 214 215int 216t_walk_invokescript (Tcl_Interp* interp, TN* n, Tcl_Obj* cs, 217 Tcl_Obj* avn, Tcl_Obj* nvn, 218 Tcl_Obj* action) 219{ 220 int res; 221 222 /* Note: Array elements, like 'a(x)', are not possible as iterator variables */ 223 224 if (avn) { 225 Tcl_ObjSetVar2 (interp, avn, NULL, action, 0); 226 } 227 Tcl_ObjSetVar2 (interp, nvn, NULL, n->name, 0); 228 229 res = Tcl_EvalObj(interp, cs); 230 231 return res; 232} 233 234int 235t_walk_invokecmd (Tcl_Interp* interp, TN* n, Tcl_Obj* dummy0, 236 Tcl_Obj* dummy1, Tcl_Obj* dummy2, 237 Tcl_Obj* action) 238{ 239 int res; 240 int cc = (int) dummy0; 241 Tcl_Obj** ev = (Tcl_Obj**) dummy1; /* cc+3 elements */ 242 243 ev [cc] = dummy2; /* Tree */ 244 ev [cc+1] = n->name; /* Node */ 245 ev [cc+2] = action; /* Action */ 246 247 Tcl_IncrRefCount (ev [cc]); 248 Tcl_IncrRefCount (ev [cc+1]); 249 Tcl_IncrRefCount (ev [cc+2]); 250 251 res = Tcl_EvalObjv (interp, cc+3, ev, 0); 252 253 Tcl_DecrRefCount (ev [cc]); 254 Tcl_DecrRefCount (ev [cc+1]); 255 Tcl_DecrRefCount (ev [cc+2]); 256 257 return res; 258} 259 260/* .................................................. */ 261 262static int 263t_walkdfspre (Tcl_Interp* interp, TN* tdn, t_walk_function f, 264 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 265 Tcl_Obj* action) 266{ 267 /* ok - next node 268 * error - abort walking 269 * break - abort walking 270 * continue - next node 271 * return - abort walking 272 * prune /5 - skip children, otherwise ok. 273 */ 274 275 int res; 276 277 /* Parent before children, action is 'enter'. */ 278 279 res = (*f) (interp, tdn, cs, avn, nvn, action); 280 281 if (res == 5) { 282 return TCL_OK; 283 } else if ((res != TCL_OK) && (res != TCL_CONTINUE)) { 284 return res; 285 } 286 287 if (tdn->nchildren) { 288 /* We make a copy of the child array. This emulates the behaviour of 289 * the Tcl implementation, which will walk to a child of this node, 290 * even if the loop body/procedure moved it to a different node before 291 * it was reached by the loop here. If the node it the child is moved 292 * to was already visited nothing else will happen. Ortherwise the 293 * child will be visited multiple times. 294 */ 295 296 int i; 297 int nc = tdn->nchildren; 298 TN** nv = NALLOC (nc,TN*); 299 memcpy (nv, tdn->child, nc*sizeof(TN*)); 300 301 for (i = 0; i < nc; i++) { 302 res = t_walkdfspre (interp, nv [i], f, cs, avn, nvn, action); 303 304 /* prune, continue cannot occur, were transformed into ok 305 * by the child. 306 */ 307 308 if (res != TCL_OK) { 309 ckfree ((char*) nv); 310 return res; 311 } 312 } 313 314 ckfree ((char*) nv); 315 } 316 317 return TCL_OK; 318} 319 320static int 321t_walkdfspost (Tcl_Interp* interp, TN* tdn, t_walk_function f, 322 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 323 Tcl_Obj* action) 324{ 325 int res; 326 327 /* Parent after children, action is 'leave'. */ 328 329 if (tdn->nchildren) { 330 /* We make a copy of the child array. This emulates the behaviour of 331 * the Tcl implementation, which will walk to a child of this node, 332 * even if the loop body/procedure moved it to a different node before 333 * it was reached by the loop here. If the node it the child is moved 334 * to was already visited nothing else will happen. Ortherwise the 335 * child will be visited multiple times. 336 */ 337 338 int i; 339 340 int nc = tdn->nchildren; 341 TN** nv = NALLOC (nc,TN*); 342 memcpy (nv, tdn->child, nc*sizeof(TN*)); 343 344 for (i = 0; i < nc; i++) { 345 res = t_walkdfspost (interp, nv [i], f, cs, avn, nvn, action); 346 347 if ((res == TCL_ERROR) || 348 (res == TCL_BREAK) || 349 (res == TCL_RETURN)) { 350 ckfree ((char*) nv); 351 return res; 352 } 353 } 354 355 ckfree ((char*) nv); 356 } 357 358 res = (*f) (interp, tdn, cs, avn, nvn, action); 359 360 if ((res == TCL_ERROR) || 361 (res == TCL_BREAK) || 362 (res == TCL_RETURN)) { 363 return res; 364 } else if (res == 5) { 365 /* Illegal pruning */ 366 367 Tcl_ResetResult (interp); 368 Tcl_AppendResult (interp, 369 "Illegal attempt to prune post-order walking", NULL); 370 return TCL_ERROR; 371 } 372 373 return TCL_OK; 374} 375 376static int 377t_walkdfsboth (Tcl_Interp* interp, TN* tdn, t_walk_function f, 378 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 379 Tcl_Obj* enter, Tcl_Obj* leave) 380{ 381 /* ok - next node 382 * error - abort walking 383 * break - abort walking 384 * continue - next node 385 * return - abort walking 386 * prune /5 - skip children, otherwise ok. 387 */ 388 389 int res; 390 391 /* Parent before and after Children, action is 'enter' & 'leave'. */ 392 393 res = (*f) (interp, tdn, cs, avn, nvn, enter); 394 395 if (res != 5) { 396 if ((res != TCL_OK) && (res != TCL_CONTINUE)) { 397 return res; 398 } 399 400 if (tdn->nchildren) { 401 int i; 402 int nc = tdn->nchildren; 403 TN** nv = NALLOC (nc,TN*); 404 memcpy (nv, tdn->child, nc*sizeof(TN*)); 405 406 for (i = 0; i < nc; i++) { 407 res = t_walkdfsboth (interp, nv [i], f, cs, avn, nvn, enter, leave); 408 409 /* prune, continue cannot occur, were transformed into ok 410 * by the child. 411 */ 412 413 if (res != TCL_OK) { 414 ckfree ((char*) nv); 415 return res; 416 } 417 } 418 419 ckfree ((char*) nv); 420 } 421 } 422 423 res = (*f) (interp, tdn, cs, avn, nvn, leave); 424 425 if (res == 5) { 426 return TCL_OK; 427 } else if ((res != TCL_OK) && (res != TCL_CONTINUE)) { 428 return res; 429 } 430 431 return TCL_OK; 432} 433 434static int 435t_walkdfsin (Tcl_Interp* interp, TN* tdn, t_walk_function f, 436 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 437 Tcl_Obj* action) 438{ 439 int res; 440 441 /* First child visited first, then parent, then */ 442 /* the remaining children. Action is 'visit'. */ 443 /* This is the correct thing for binary trees. */ 444 /* For #children <= 1 the parent is visited */ 445 /* before the child */ 446 447 if (tdn->nchildren == 0) { 448 res = (*f) (interp, tdn, cs, avn, nvn, action); 449 450 if ((res == TCL_ERROR) || 451 (res == TCL_BREAK) || 452 (res == TCL_RETURN)) { 453 return res; 454 } else if (res == 5) { 455 /* Illegal pruning */ 456 457 Tcl_ResetResult (interp); 458 Tcl_AppendResult (interp, 459 "Illegal attempt to prune in-order walking", NULL); 460 return TCL_ERROR; 461 } 462 463 } else if (tdn->nchildren == 1) { 464 res = (*f) (interp, tdn, cs, avn, nvn, action); 465 466 if ((res == TCL_ERROR) || 467 (res == TCL_BREAK) || 468 (res == TCL_RETURN)) { 469 return res; 470 } else if (res == 5) { 471 /* Illegal pruning */ 472 473 Tcl_ResetResult (interp); 474 Tcl_AppendResult (interp, 475 "Illegal attempt to prune in-order walking", NULL); 476 return TCL_ERROR; 477 } 478 479 return t_walkdfsin (interp, tdn->child [0], f, cs, avn, nvn, action); 480 481 } else { 482 int i; 483 int nc = tdn->nchildren; 484 TN** nv = NALLOC (nc,TN*); 485 memcpy (nv, tdn->child, nc*sizeof(TN*)); 486 487 res = t_walkdfsin (interp, tdn->child [0], f, cs, avn, nvn, action); 488 489 if ((res == TCL_ERROR) || 490 (res == TCL_BREAK) || 491 (res == TCL_RETURN)) { 492 ckfree ((char*) nv); 493 return res; 494 } 495 496 res = (*f) (interp, tdn, cs, avn, nvn, action); 497 498 if ((res == TCL_ERROR) || 499 (res == TCL_BREAK) || 500 (res == TCL_RETURN)) { 501 ckfree ((char*) nv); 502 return res; 503 } else if (res == 5) { 504 /* Illegal pruning */ 505 ckfree ((char*) nv); 506 507 Tcl_ResetResult (interp); 508 Tcl_AppendResult (interp, 509 "Illegal attempt to prune in-order walking", NULL); 510 return TCL_ERROR; 511 } 512 513 for (i = 1; i < nc; i++) { 514 res = t_walkdfsin (interp, nv [i], f, cs, avn, nvn, action); 515 516 if ((res == TCL_ERROR) || 517 (res == TCL_BREAK) || 518 (res == TCL_RETURN)) { 519 ckfree ((char*) nv); 520 return res; 521 } 522 } 523 524 ckfree ((char*) nv); 525 } 526 527 return TCL_OK; 528} 529 530static int 531t_walkbfsboth (Tcl_Interp* interp, TN* tdn, t_walk_function f, 532 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 533 Tcl_Obj* enter, Tcl_Obj* leave) 534{ 535 /* ok - next node 536 * error - abort walking 537 * break - pre: abort walking, skip to post, post: abort walking 538 * continue - next node 539 * return - abort walking 540 * prune /5 - skip children, otherwise ok. 541 */ 542 543 int res; 544 TN* n; 545 NLQ q; 546 NLQ qb; 547 548 nlq_init (&q); 549 nlq_init (&qb); 550 551 nlq_append (&q, tdn); 552 nlq_push (&qb, tdn); 553 554 while (1) { 555 n = nlq_pop (&q); 556 if (!n) break; 557 558 res = (*f) (interp, n, cs, avn, nvn, enter); 559 560 if (res == 5) { 561 continue; 562 } else if (res == TCL_ERROR) { 563 nlq_clear (&q); 564 nlq_clear (&qb); 565 return res; 566 } else if ((res != TCL_OK) && (res != TCL_CONTINUE)) { 567 nlq_clear (&q); 568 569 /* We abort the collection of more nodes, but still run the 570 * backward iteration (post-order phase). 571 */ 572 break; 573 } 574 575 if (n->nchildren) { 576 int i; 577 for (i = 0; i < n->nchildren; i++) { 578 nlq_append (&q, n->child [i]); 579 nlq_push (&qb, n->child [i]); 580 } 581 } 582 } 583 584 /* Backward visit to leave */ 585 586 while (1) { 587 n = nlq_pop (&qb); 588 if (!n) break; 589 590 res = (*f) (interp, n, cs, avn, nvn, leave); 591 592 if (res == 5) { 593 continue; 594 } else if ((res != TCL_OK) && (res != TCL_CONTINUE)) { 595 nlq_clear (&qb); 596 return res; 597 } 598 } 599 600 return TCL_OK; 601} 602 603static int 604t_walkbfspre (Tcl_Interp* interp, TN* tdn, t_walk_function f, 605 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 606 Tcl_Obj* action) 607{ 608 /* ok - next node 609 * error - abort walking 610 * break - abort walking 611 * continue - next node 612 * return - abort walking 613 * prune /5 - skip children, otherwise ok. 614 */ 615 616 int res; 617 TN* n; 618 NLQ q; 619 620 nlq_init (&q); 621 nlq_append (&q, tdn); 622 623 while (1) { 624 n = nlq_pop (&q); 625 if (!n) break; 626 627 res = (*f) (interp, n, cs, avn, nvn, action); 628 629 if (res == 5) { 630 continue; 631 } else if ((res != TCL_OK) && (res != TCL_CONTINUE)) { 632 nlq_clear (&q); 633 return res; 634 } 635 636 if (n->nchildren) { 637 int i; 638 for (i = 0; i < n->nchildren; i++) { 639 nlq_append (&q, n->child [i]); 640 } 641 } 642 } 643 644 return TCL_OK; 645} 646 647static int 648t_walkbfspost (Tcl_Interp* interp, TN* tdn, t_walk_function f, 649 Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn, 650 Tcl_Obj* action) 651{ 652 int res; 653 TN* n; 654 NLQ q; 655 NLQ qb; 656 657 nlq_init (&q); 658 nlq_init (&qb); 659 660 nlq_append (&q, tdn); 661 nlq_push (&qb, tdn); 662 663 while (1) { 664 n = nlq_pop (&q); 665 if (!n) break; 666 667 if (n->nchildren) { 668 int i; 669 for (i = 0; i < n->nchildren; i++) { 670 nlq_append (&q, n->child [i]); 671 nlq_push (&qb, n->child [i]); 672 } 673 } 674 } 675 676 /* Backward visit to leave */ 677 678 while (1) { 679 n = nlq_pop (&qb); 680 if (!n) break; 681 682 res = (*f) (interp, n, cs, avn, nvn, action); 683 684 if ((res == TCL_ERROR) || 685 (res == TCL_BREAK) || 686 (res == TCL_RETURN)) { 687 nlq_clear (&qb); 688 return res; 689 } else if (res == 5) { 690 /* Illegal pruning */ 691 692 nlq_clear (&qb); 693 Tcl_ResetResult (interp); 694 Tcl_AppendResult (interp, 695 "Illegal attempt to prune post-order walking", NULL); 696 return TCL_ERROR; 697 } 698 } 699 700 return TCL_OK; 701} 702 703/* 704 * Local Variables: 705 * mode: c 706 * c-basic-offset: 4 707 * fill-column: 78 708 * End: 709 */ 710