1/* struct::graph - critcl - layer 1 definitions 2 * (c) Graph functions 3 */ 4 5#include <nacommon.h> 6#include <util.h> 7#include <node.h> 8 9/* .................................................. */ 10 11typedef enum NA_MODE { 12 NA_ADJ, NA_EMBEDDING, NA_IN, NA_INNER, 13 NA_OUT, NA_NONE 14} NA_MODE; 15 16typedef struct NA { 17 NA_MODE mode; 18 int nc; 19 Tcl_Obj** nv; 20 Tcl_Obj* key; 21 Tcl_Obj* value; 22 Tcl_Obj* filter; 23} NA; 24 25typedef struct NARES { 26 int c; 27 Tcl_Obj** v; 28} NARES; 29 30/* .................................................. */ 31 32static int filter_setup (NA* na, Tcl_Interp* interp, int oc, Tcl_Obj* const* ov, G* g); 33static int filter_run (NA* na, Tcl_Interp* interp, int nodes, GCC* gx, GN_GET_GC* gf, 34 Tcl_Obj* go, G* g); 35static void filter_none (Tcl_Interp* interp, GCC* gx, NARES* l); 36static void filter_kv (Tcl_Interp* interp, GCC* gx, NARES* l, 37 GN_GET_GC* gf, G*g, Tcl_Obj* k, Tcl_Obj* v); 38static void filter_k (Tcl_Interp* interp, GCC* gx, NARES* l, 39 GN_GET_GC* gf, G* g, Tcl_Obj* k); 40static int filter_cmd (Tcl_Interp* interp, GCC* gx, NARES* l, 41 Tcl_Obj* cmd, Tcl_Obj* g); 42 43static void filter_mode_n (NA_MODE mode, GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g); 44static void filter_mode_n_adj (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g); 45static void filter_mode_n_emb (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g); 46static void filter_mode_n_in (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g); 47static void filter_mode_n_inn (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g); 48static void filter_mode_n_out (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g); 49static void filter_mode_a (NA_MODE mode, GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g); 50static void filter_mode_a_adj (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g); 51static void filter_mode_a_emb (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g); 52static void filter_mode_a_in (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g); 53static void filter_mode_a_inn (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g); 54static void filter_mode_a_out (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g); 55 56/* .................................................. */ 57 58int 59gc_filter (int nodes, Tcl_Interp* interp, 60 int oc, Tcl_Obj* const* ov, 61 GCC* gx, GN_GET_GC* gf, G* g) 62{ 63 NA na; 64 65 if (filter_setup (&na, interp, oc, ov, g) != TCL_OK) { 66 return TCL_ERROR; 67 } 68 69 return filter_run (&na, interp, nodes, gx, gf, ov [0], g); 70} 71 72/* .................................................. */ 73 74static int 75filter_setup (NA* na, Tcl_Interp* interp, int oc, Tcl_Obj* const* ov, G* g) 76{ 77 /* Syntax: graph arcs | all arcs 78 * graph arcs -adj NODE... | arcs start|end in node in list 79 * graph arcs -embedding NODE... | arcs start^end in node in list 80 * graph arcs -filter CMDPREFIX | arcs for which CMD returns True. 81 * graph arcs -in NODE... | arcs end in node in list 82 * graph arcs -inner NODE... | arcs start&end in node in list 83 * graph arcs -key KEY | arcs have attribute KEY 84 * graph arcs -out NODE... | arcs start in node in list 85 * graph arcs -value VALUE | arcs have KEY and VALUE 86 * [0] [1] [2] [3] 87 */ 88 89 static const char* restr [] = { 90 "-adj", "-embedding", "-filter", "-in", 91 "-inner", "-key", "-out", "-value", 92 NULL 93 }; 94 enum restr { 95 R_ADJ, R_EMB, R_CMD, R_IN, 96 R_INNER, R_KEY, R_OUT, R_VAL 97 }; 98 static const int mode [] = { 99 NA_ADJ, NA_EMBEDDING, -1, NA_IN, 100 NA_INNER, -1, NA_OUT, -1 101 }; 102 103 int ac = oc; 104 Tcl_Obj* const* av = ov; 105 int r; 106 107 na->mode = NA_NONE; 108 na->nc = 0; 109 na->nv = NALLOC (oc, Tcl_Obj*); 110 na->key = NULL; 111 na->value = NULL; 112 na->filter = NULL; 113 114 oc -= 2; /* Skip 'graph arcs' */ 115 ov += 2; 116 117 while (oc) { 118 if ('-' == Tcl_GetString (ov[0])[0]) { 119 if (Tcl_GetIndexFromObj (interp, ov [0], restr, 120 "restriction", 0, &r) != TCL_OK) { 121 goto abort; 122 } 123 switch (r) { 124 case R_ADJ: 125 case R_EMB: 126 case R_IN: 127 case R_INNER: 128 case R_OUT: 129 if (na->mode != NA_NONE) { 130 Tcl_SetObjResult (interp, 131 Tcl_NewStringObj ("invalid restriction: illegal multiple use of \"-in\"|\"-out\"|\"-adj\"|\"-inner\"|\"-embedding\"", -1)); 132 goto abort; 133 } 134 na->mode = mode [r]; 135 break; 136 case R_CMD: 137 if (oc < 2) goto wrongargs; 138 if (na->filter) { 139 Tcl_SetObjResult (interp, 140 Tcl_NewStringObj ("invalid restriction: illegal multiple use of \"-filter\"", -1)); 141 goto abort; 142 } 143 na->filter = ov [1]; 144 oc --; 145 ov ++; 146 break; 147 case R_KEY: 148 if (oc < 2) goto wrongargs; 149 if (na->key) { 150 Tcl_SetObjResult (interp, 151 Tcl_NewStringObj ("invalid restriction: illegal multiple use of \"-key\"", -1)); 152 goto abort; 153 } 154 na->key = ov [1]; 155 oc --; 156 ov ++; 157 break; 158 case R_VAL: 159 if (oc < 2) goto wrongargs; 160 if (na->value) { 161 Tcl_SetObjResult (interp, 162 Tcl_NewStringObj ("invalid restriction: illegal multiple use of \"-value\"", -1)); 163 goto abort; 164 } 165 na->value = ov [1]; 166 oc --; 167 ov ++; 168 break; 169 } 170 oc --; 171 ov ++; 172 } else { 173 /* Save non-options for the list of nodes */ 174 ASSERT_BOUNDS (na->nc, ac); 175 na->nv [na->nc] = ov[0]; 176 na->nc ++; 177 oc --; 178 ov ++; 179 } 180 } 181 182 if (na->value && !na->key) { 183 Tcl_SetObjResult (interp, 184 Tcl_NewStringObj ("invalid restriction: use of \"-value\" without \"-key\"", -1)); 185 goto abort; 186 } 187 188 if ((na->mode != NA_NONE) && !na->nc) { 189 wrongargs: 190 Tcl_WrongNumArgs (interp, 2, av, 191 "?-key key? ?-value value? ?-filter cmd? ?-in|-out|-adj|-inner|-embedding node node...?"); 192 goto abort; 193 } 194 195 if (!na->nc) { 196 ckfree((char*) na->nv); 197 na->nv = NULL; 198 } else { 199 /* Check that the nodes exist, and 200 * remove duplicates in the same pass 201 */ 202 203 int i, j, new; 204 Tcl_HashTable cn; 205 GN* n; 206 207 Tcl_InitHashTable (&cn, TCL_ONE_WORD_KEYS); 208 209 j=0; 210 for (i=0; i < na->nc; i++) { 211 ASSERT_BOUNDS(i, na->nc); 212 n = gn_get_node (g, na->nv[i], interp, av[0]); 213 if (!n) { 214 Tcl_DeleteHashTable(&cn); 215 goto abort; 216 } 217 if (Tcl_FindHashEntry (&cn, (char*) n)) continue; 218 ASSERT_BOUNDS(j, na->nc); 219 Tcl_CreateHashEntry (&cn, (char*) n, &new); 220 if (j < i) { na->nv[j] = na->nv[i]; } 221 j ++; 222 } 223 224 Tcl_DeleteHashTable(&cn); 225 na->nc = j; 226 } 227 return TCL_OK; 228 229 abort: 230 ckfree((char*) na->nv); 231 return TCL_ERROR; 232} 233 234/* .................................................. */ 235 236static int 237filter_run (NA* na, Tcl_Interp* interp, int nodes, GCC* gx, GN_GET_GC* gf, Tcl_Obj* go, G* g) 238{ 239 NARES l; 240 241 if (!gx->n) { 242 /* Nothing to filter, ignore the filters */ 243 244 Tcl_SetObjResult (interp, Tcl_NewListObj (0, NULL)); 245 return TCL_OK; 246 } 247 248 l.c = -1; 249 l.v = NALLOC (gx->n, Tcl_Obj*); 250 251 if (!na->key && 252 !na->filter && 253 (na->mode == NA_NONE)) { 254 filter_none (interp, gx, &l); 255 } else { 256 if (na->mode != NA_NONE) { 257 if (nodes) { 258 filter_mode_n (na->mode, gx, &l, na->nc, na->nv, g); 259 } else { 260 filter_mode_a (na->mode, gx, &l, na->nc, na->nv, g); 261 } 262 } 263 if (na->key && na->value) { 264 filter_kv (interp, gx, &l, gf, g, na->key, na->value); 265 } else if (na->key) { 266 filter_k (interp, gx, &l, gf, g, na->key); 267 } 268 if (na->filter) { 269 if (filter_cmd (interp, gx, &l, na->filter, go) != TCL_OK) { 270 ckfree ((char*) l.v); 271 return TCL_ERROR; 272 } 273 } 274 } 275 276 ASSERT(l.c > -1, "No filters applied"); 277 Tcl_SetObjResult (interp, Tcl_NewListObj (l.c, l.v)); 278 ckfree ((char*) l.v); 279 return TCL_OK; 280} 281 282/* .................................................. */ 283 284static void 285filter_none (Tcl_Interp* interp, GCC* gx, NARES* l) 286{ 287 int i; 288 GC* iter; 289 290 for (i = 0, iter = gx->first; 291 iter != NULL; 292 iter = iter->next, i++) { 293 ASSERT_BOUNDS (i, gx->n); 294 l->v [i] = iter->name; 295 } 296 297 ASSERT (i == gx->n, "Bad list of nodes"); 298 l->c = i; 299} 300 301/* .................................................. */ 302 303static void 304filter_mode_a (NA_MODE mode, GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g) 305{ 306 /* 307 * NS = {node ...}, a set of nodes 308 * 309 * ARC/in (NS) := { a | target(a) in NS } "Arcs going into the node set" 310 * ARC/out (NS) := { a | source(a) in NS } "Arcs coming from the node set" 311 * ARC/adj (NS) := ARC/in (NS) + ARC/out (NS) "Arcs touching the node set" 312 * ARC/inn (NS) := ARC/in (NS) * ARC/out (NS) "Arcs connecting nodes in the set" 313 * ARC/emb (NS) := ARC/adj (NS) - ARC/inn (NS) "Arcs touching, yet not connecting" 314 * = ARC/in (NS) / ARc/out (NS) 'symmetric difference' 315 * 316 * Note: None of the iterations has to be concerned about space. It is 317 * bounded by the number of arcs in the graph, and the list has enough 318 * slots. 319 */ 320 321 switch (mode) { 322 case NA_ADJ: filter_mode_a_adj (gx, l, nc, nv, g); break; 323 case NA_EMBEDDING: filter_mode_a_emb (gx, l, nc, nv, g); break; 324 case NA_IN: filter_mode_a_in (gx, l, nc, nv, g); break; 325 case NA_INNER: filter_mode_a_inn (gx, l, nc, nv, g); break; 326 case NA_OUT: filter_mode_a_out (gx, l, nc, nv, g); break; 327 } 328} 329 330/* .................................................. */ 331 332static void 333filter_mode_a_adj (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g) 334{ 335 /* ARC/adj (NS) := ARC/in (NS) + ARC/out (NS) 336 * "Arcs touching the node set" 337 */ 338 339 /* Iterate over the nodes and collect all incoming and outgoing arcs. We 340 * use a hash table to prevent us from entering arcs twice. If we find 341 * that all arcs are in the result we stop immediately. 342 */ 343 344 int i, j, new; 345 GL* il; 346 Tcl_HashTable ht; 347 GN* n; 348 349 Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS); 350 351 j = 0; 352 for (i=0; i < nc; i++) { 353 ASSERT_BOUNDS(i, nc); 354 n = gn_get_node (g, nv[i], NULL, NULL); 355 for (il = n->in.first; il != NULL; il = il->next) { 356 ASSERT_BOUNDS(j, gx->n); 357 Tcl_CreateHashEntry (&ht, (char*) il->a, &new); 358 l->v[j] = il->a->base.name; 359 j ++; 360 } 361 } 362 363 ASSERT(j <= gx->n, "Overrun"); 364 365 if (j < gx->n) { 366 for (i=0; i < nc; i++) { 367 ASSERT_BOUNDS(i, nc); 368 n = gn_get_node (g, nv[i], NULL, NULL); 369 for (il = n->out.first; il != NULL; il = il->next) { 370 /* Skip if already present - union */ 371 if (Tcl_FindHashEntry (&ht, (char*) il->a)) continue; 372 ASSERT_BOUNDS(j, gx->n); 373 Tcl_CreateHashEntry (&ht, (char*) il->a, &new); 374 l->v[j] = il->a->base.name; 375 j ++; 376 } 377 if (j == gx->n) break; 378 } 379 } 380 381 ASSERT(j <= gx->n, "Overrun"); 382 l->c = j; 383 384 Tcl_DeleteHashTable(&ht); 385} 386 387/* .................................................. */ 388 389static void 390filter_mode_a_emb (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g) 391{ 392 /* ARC/emb (NS) := ARC/adj (NS) - ARC/inn (NS) 393 * = ARC/in (NS) / ARc/out (NS) 394 * "Arcs touching, yet not connecting" 395 */ 396 397 /* For the embedding we have to iterate several times. First to collect 398 * the relevant arcs in hashtables, then a last time using the hashtables 399 * to weed out the inner arcs, i.e the intersection, and collect the 400 * others. 401 */ 402 403 int i, j, new; 404 GL* il; 405 Tcl_HashTable hti; 406 Tcl_HashTable hto; 407 GN* n; 408 409 Tcl_InitHashTable (&hti, TCL_ONE_WORD_KEYS); 410 Tcl_InitHashTable (&hto, TCL_ONE_WORD_KEYS); 411 412 for (i=0; i < nc; i++) { 413 ASSERT_BOUNDS(i, nc); 414 n = gn_get_node (g, nv[i], NULL, NULL); 415 for (il = n->in.first; il != NULL; il = il->next) { 416 Tcl_CreateHashEntry (&hti, (char*) il->a, &new); 417 } 418 } 419 for (i=0; i < nc; i++) { 420 ASSERT_BOUNDS(i, nc); 421 n = gn_get_node (g, nv[i], NULL, NULL); 422 for (il = n->out.first; il != NULL; il = il->next) { 423 Tcl_CreateHashEntry (&hto, (char*) il->a, &new); 424 } 425 } 426 427 j = 0; 428 for (i=0; i < nc; i++) { 429 ASSERT_BOUNDS(i, nc); 430 n = gn_get_node (g, nv[i], NULL, NULL); 431 for (il = n->in.first; il != NULL; il = il->next) { 432 /* Incoming arcs, skip if also outgoing */ 433 if (Tcl_FindHashEntry (&hto, (char*) il->a)) continue; 434 ASSERT_BOUNDS(j, gx->n); 435 l->v[j] = il->a->base.name; 436 j ++; 437 } 438 } 439 for (i=0; i < nc; i++) { 440 ASSERT_BOUNDS(i, nc); 441 n = gn_get_node (g, nv[i], NULL, NULL); 442 for (il = n->out.first; il != NULL; il = il->next) { 443 /* Outgoing arcs, skip if also incoming */ 444 if (Tcl_FindHashEntry (&hti, (char*) il->a)) continue; 445 ASSERT_BOUNDS(j, gx->n); 446 l->v[j] = il->a->base.name; 447 j ++; 448 } 449 } 450 451 ASSERT(j <= gx->n,"Overrun"); 452 l->c = j; 453 454 Tcl_DeleteHashTable(&hti); 455 Tcl_DeleteHashTable(&hto); 456} 457 458/* .................................................. */ 459 460static void 461filter_mode_a_in (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g) 462{ 463 /* ARC/in (NS) := { a | target(a) in NS } 464 * "Arcs going into the node set" 465 */ 466 467 /* Iterate over the nodes and collect all incoming arcs. */ 468 469 int i, j; 470 GL* il; 471 GN* n; 472 473 j = 0; 474 for (i=0; i < nc; i++) { 475 ASSERT_BOUNDS(i, nc); 476 n = gn_get_node (g, nv[i], NULL, NULL); 477 for (il = n->in.first; il != NULL; il = il->next) { 478 ASSERT_BOUNDS(j, gx->n); 479 l->v[j] = il->a->base.name; 480 j ++; 481 } 482 } 483 484 ASSERT(j <= gx->n,"Overrun"); 485 l->c = j; 486} 487 488/* .................................................. */ 489 490static void 491filter_mode_a_inn (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g) 492{ 493 /* ARC/inn (NS) := ARC/in (NS) * ARC/out (NS) 494 * "Arcs connecting nodes in the set" 495 */ 496 497 /* Iterate over the nodes and collect all incoming arcs first, in a 498 * hashtable. Then iterate a second time to find all outgoing arcs which 499 * are also incoming. We skip the second iteration if the first one found all 500 * arcs, because then the intersection will remove nothing. 501 */ 502 503 int i, j, new; 504 GL* il; 505 Tcl_HashTable ht; 506 GN* n; 507 508 Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS); 509 510 for (i=0; i < nc; i++) { 511 ASSERT_BOUNDS(i, nc); 512 n = gn_get_node (g, nv[i], NULL, NULL); 513 for (il = n->in.first; il != NULL; il = il->next) { 514 Tcl_CreateHashEntry (&ht, (char*) il->a, &new); 515 } 516 } 517 518 j = 0; 519 for (i=0; i < nc; i++) { 520 ASSERT_BOUNDS(i, nc); 521 n = gn_get_node (g, nv[i], NULL, NULL); 522 for (il = n->out.first; il != NULL; il = il->next) { 523 /* Note the !. This is the intersect */ 524 if (!Tcl_FindHashEntry (&ht, (char*) il->a)) continue; 525 ASSERT_BOUNDS(j, gx->n); 526 Tcl_CreateHashEntry (&ht, (char*) il->a, &new); 527 l->v[j] = il->a->base.name; 528 j ++; 529 } 530 } 531 532 ASSERT(j <= gx->n,"Overrun"); 533 l->c = j; 534 535 Tcl_DeleteHashTable(&ht); 536} 537 538/* .................................................. */ 539 540static void 541filter_mode_a_out (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g) 542{ 543 /* ARC/out (NS) := { a | source(a) in NS } 544 * "Arcs coming from the node set" 545 */ 546 547 /* Iterate over the nodes and collect all outcoming arcs. */ 548 549 int i, j; 550 GL* il; 551 GN* n; 552 553 j = 0; 554 for (i=0; i < nc; i++) { 555 ASSERT_BOUNDS(i, nc); 556 n = gn_get_node (g, nv[i], NULL, NULL); 557 for (il = n->out.first; il != NULL; il = il->next) { 558 ASSERT_BOUNDS(j, gx->n); 559 l->v[j] = il->a->base.name; 560 j ++; 561 } 562 } 563 564 ASSERT(j <= gx->n,"Overrun"); 565 l->c = j; 566} 567 568/* .................................................. */ 569 570static void 571filter_mode_n (NA_MODE mode, GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g) 572{ 573 /* 574 * NODES/in (NS) = { source(a) | a in ARC/in (NS) } 575 * NODES/out (NS) = { target(a) | a in ARC/out (NS) } 576 * NODES/adj (NS) = NODES/in (NS) + NODES/out (NS) 577 * NODES/inn (NS) = NODES/adj (NS) * NS 578 * NODES/emb (NS) = NODES/adj (NS) - NS 579 */ 580 581 switch (mode) { 582 case NA_ADJ: filter_mode_n_adj (gx, l, nc, nv, g); break; 583 case NA_EMBEDDING: filter_mode_n_emb (gx, l, nc, nv, g); break; 584 case NA_IN: filter_mode_n_in (gx, l, nc, nv, g); break; 585 case NA_INNER: filter_mode_n_inn (gx, l, nc, nv, g); break; 586 case NA_OUT: filter_mode_n_out (gx, l, nc, nv, g); break; 587 } 588} 589 590/* .................................................. */ 591 592static void 593filter_mode_n_adj (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g) 594{ 595 /* 596 * NODES/adj (NS) = NODES/in (NS) + NODES/out (NS) 597 * 598 * using: 599 * NODES/in (NS) = { source(a) | a in ARC/in (NS) } 600 * NODES/out (NS) = { target(a) | a in ARC/out (NS) } 601 */ 602 603 /* Iterate over the nodes and collect all incoming and outgoing nodes. We 604 * use a hash table to prevent us from entering nodes twice. Should we 605 * find that all nodes are in the result during the iteration we stop 606 * immediately, it cannot get better. 607 */ 608 609 int i, j, new; 610 GL* il; 611 Tcl_HashTable ht; 612 GN* n; 613 614 Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS); 615 616 j = 0; 617 for (i=0; i < nc; i++) { 618 ASSERT_BOUNDS(i, nc); 619 n = gn_get_node (g, nv[i], NULL, NULL); 620 /* foreach n in cn */ 621 622 for (il = n->in.first; il != NULL; il = il->next) { 623 /* foreach a in ARC/in (n) */ 624 /* il->a in ARC/in (NS) => il->a->start->n in NODES/in (NS) */ 625 626 if (Tcl_FindHashEntry (&ht, (char*) il->a->start->n)) continue; 627 ASSERT_BOUNDS(j, gx->n); 628 Tcl_CreateHashEntry (&ht, (char*) il->a->start->n, &new); 629 l->v[j] = il->a->start->n->base.name; 630 j ++; 631 } 632 if (j == gx->n) break; 633 for (il = n->out.first; il != NULL; il = il->next) { 634 /* foreach a in ARC/out (n) */ 635 /* il->a in ARC/out (NS) => il->a->end->n in NODES/out (NS) */ 636 637 if (Tcl_FindHashEntry (&ht, (char*) il->a->end->n)) continue; 638 ASSERT_BOUNDS(j, gx->n); 639 Tcl_CreateHashEntry (&ht, (char*) il->a->end->n, &new); 640 l->v[j] = il->a->end->n->base.name; 641 j ++; 642 } 643 if (j == gx->n) break; 644 } 645 646 ASSERT(j <= gx->n, "Overrun"); 647 l->c = j; 648 649 Tcl_DeleteHashTable(&ht); 650} 651 652/* .................................................. */ 653 654static void 655filter_mode_n_emb (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g) 656{ 657 /* 658 * NODES/emb (NS) = NODES/adj (NS) - NS 659 * 660 * using: 661 * NODES/adj (NS) = NODES/in (NS) + NODES/out (NS) 662 * 663 * using: 664 * NODES/in (NS) = { source(a) | a in ARC/in (NS) } 665 * NODES/out (NS) = { target(a) | a in ARC/out (NS) } 666 */ 667 668 /* Iterate over the nodes and collect all incoming and outgoing nodes. We 669 * use a hash table to prevent us from entering nodes twice. A second hash 670 * table is used to skip over the nodes in the set itself. 671 */ 672 673 int i, j, new; 674 GL* il; 675 Tcl_HashTable ht; 676 Tcl_HashTable cn; 677 GN* n; 678 679 Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS); 680 Tcl_InitHashTable (&cn, TCL_ONE_WORD_KEYS); 681 682 for (i=0; i < nc; i++) { 683 ASSERT_BOUNDS(i, nc); 684 n = gn_get_node (g, nv[i], NULL, NULL); 685 /* foreach n in cn */ 686 Tcl_CreateHashEntry (&cn, (char*) n, &new); 687 } 688 689 j = 0; 690 for (i=0; i < nc; i++) { 691 ASSERT_BOUNDS(i, nc); 692 n = gn_get_node (g, nv[i], NULL, NULL); 693 /* foreach n in cn */ 694 695 for (il = n->in.first; il != NULL; il = il->next) { 696 /* foreach a in ARC/in (n) */ 697 /* il->a in ARC/in (NS) => il->a->start->n in NODES/in (NS) */ 698 /* - NS */ 699 700 if (Tcl_FindHashEntry (&cn, (char*) il->a->start->n)) continue; 701 if (Tcl_FindHashEntry (&ht, (char*) il->a->start->n)) continue; 702 ASSERT_BOUNDS(j, gx->n); 703 Tcl_CreateHashEntry (&ht, (char*) il->a->start->n, &new); 704 l->v[j] = il->a->start->n->base.name; 705 j ++; 706 } 707 if (j == gx->n) break; 708 for (il = n->out.first; il != NULL; il = il->next) { 709 /* foreach a in ARC/out (n) */ 710 /* il->a in ARC/out (NS) => il->a->end->n in NODES/out (NS) */ 711 /* - NS */ 712 713 if (Tcl_FindHashEntry (&cn, (char*) il->a->end->n)) continue; 714 if (Tcl_FindHashEntry (&ht, (char*) il->a->end->n)) continue; 715 ASSERT_BOUNDS(j, gx->n); 716 Tcl_CreateHashEntry (&ht, (char*) il->a->end->n, &new); 717 l->v[j] = il->a->end->n->base.name; 718 j ++; 719 } 720 if (j == gx->n) break; 721 } 722 723 ASSERT(j <= gx->n, "Overrun"); 724 l->c = j; 725 726 Tcl_DeleteHashTable(&ht); 727 Tcl_DeleteHashTable(&cn); 728} 729 730/* .................................................. */ 731 732static void 733filter_mode_n_in (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g) 734{ 735 /* 736 * NODES/in (NS) = { source(a) | a in ARC/in (NS) } 737 */ 738 739 int i, j, new; 740 GL* il; 741 GN* n; 742 Tcl_HashTable ht; 743 744 Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS); 745 746 j = 0; 747 for (i=0; i < nc; i++) { 748 ASSERT_BOUNDS(i, nc); 749 n = gn_get_node (g, nv[i], NULL, NULL); 750 for (il = n->in.first; il != NULL; il = il->next) { 751 /* il->a in INa (NS) => il->a->start in INn (NS), 752 * modulo already recorded 753 */ 754 if (Tcl_FindHashEntry (&ht, (char*) il->a->start->n)) continue; 755 ASSERT_BOUNDS(j, gx->n); 756 Tcl_CreateHashEntry (&ht, (char*) il->a->start->n, &new); 757 l->v[j] = il->a->start->n->base.name; 758 j ++; 759 } 760 } 761 762 ASSERT(j <= gx->n,"Overrun"); 763 l->c = j; 764 765 Tcl_DeleteHashTable(&ht); 766} 767 768/* .................................................. */ 769 770static void 771filter_mode_n_inn (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g) 772{ 773 /* 774 * NODES/inn (NS) = NODES/adj (NS) * NS 775 * 776 * using: 777 * NODES/adj (NS) = NODES/in (NS) + NODES/out (NS) 778 * 779 * using: 780 * NODES/in (NS) = { source(a) | a in ARC/in (NS) } 781 * NODES/out (NS) = { target(a) | a in ARC/out (NS) } 782 */ 783 784 /* Iterate over the nodes and collect all incoming and outgoing nodes. We 785 * use a hash table to prevent us from entering nodes twice. A second hash 786 * table is used to skip over the nodes _not_ in the set itself. 787 */ 788 789 int i, j, new; 790 GL* il; 791 Tcl_HashTable ht; 792 Tcl_HashTable cn; 793 GN* n; 794 795 Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS); 796 Tcl_InitHashTable (&cn, TCL_ONE_WORD_KEYS); 797 798 for (i=0; i < nc; i++) { 799 ASSERT_BOUNDS(i, nc); 800 n = gn_get_node (g, nv[i], NULL, NULL); 801 /* foreach n in cn */ 802 Tcl_CreateHashEntry (&cn, (char*) n, &new); 803 } 804 805 j = 0; 806 for (i=0; i < nc; i++) { 807 ASSERT_BOUNDS(i, nc); 808 n = gn_get_node (g, nv[i], NULL, NULL); 809 /* foreach n in cn */ 810 811 for (il = n->in.first; il != NULL; il = il->next) { 812 /* foreach a in ARC/in (n) */ 813 /* il->a in ARC/in (NS) => il->a->start->n in NODES/in (NS) */ 814 /* * NS */ 815 816 if (!Tcl_FindHashEntry (&cn, (char*) il->a->start->n)) continue; 817 if (Tcl_FindHashEntry (&ht, (char*) il->a->start->n)) continue; 818 ASSERT_BOUNDS(j, gx->n); 819 Tcl_CreateHashEntry (&ht, (char*) il->a->start->n, &new); 820 l->v[j] = il->a->start->n->base.name; 821 j ++; 822 } 823 if (j == gx->n) break; 824 for (il = n->out.first; il != NULL; il = il->next) { 825 /* foreach a in ARC/out (n) */ 826 /* il->a in ARC/out (NS) => il->a->end->n in NODES/out (NS) */ 827 /* * NS */ 828 829 if (!Tcl_FindHashEntry (&cn, (char*) il->a->end->n)) continue; 830 if (Tcl_FindHashEntry (&ht, (char*) il->a->end->n)) continue; 831 ASSERT_BOUNDS(j, gx->n); 832 Tcl_CreateHashEntry (&ht, (char*) il->a->end->n, &new); 833 l->v[j] = il->a->end->n->base.name; 834 j ++; 835 } 836 if (j == gx->n) break; 837 } 838 839 ASSERT(j <= gx->n, "Overrun"); 840 l->c = j; 841 842 Tcl_DeleteHashTable(&ht); 843 Tcl_DeleteHashTable(&cn); 844} 845 846/* .................................................. */ 847 848static void 849filter_mode_n_out (GCC* gx, NARES* l, int nc, Tcl_Obj* const* nv, G* g) 850{ 851 /* 852 * NODES/out (NS) = { target(a) | a in ARC/out (NS) } 853 */ 854 855 int i, j, new; 856 GL* il; 857 GN* n; 858 Tcl_HashTable ht; 859 860 Tcl_InitHashTable (&ht, TCL_ONE_WORD_KEYS); 861 862 j = 0; 863 for (i=0; i < nc; i++) { 864 ASSERT_BOUNDS(i, nc); 865 n = gn_get_node (g, nv[i], NULL, NULL); 866 for (il = n->out.first; il != NULL; il = il->next) { 867 /* il->a in OUTa (NS) => il->a->end in OUTn (NS), 868 * modulo already recorded 869 */ 870 if (Tcl_FindHashEntry (&ht, (char*) il->a->end->n)) continue; 871 ASSERT_BOUNDS(j, gx->n); 872 Tcl_CreateHashEntry (&ht, (char*) il->a->end->n, &new); 873 l->v[j] = il->a->end->n->base.name; 874 j ++; 875 } 876 } 877 878 ASSERT(j <= gx->n,"Overrun"); 879 l->c = j; 880 881 Tcl_DeleteHashTable (&ht); 882} 883 884/* .................................................. */ 885 886static void 887filter_kv (Tcl_Interp* interp, GCC* gx, NARES* l, GN_GET_GC* gf, G* g, Tcl_Obj* k, Tcl_Obj* v) 888{ 889 /* 2 modes: 890 * (a) l->c == -1 => Fill with matching entities 891 * (b) l->c == 0 => Nothing to do. 892 * (c) otherwise => Filter found entities 893 */ 894 895 Tcl_HashEntry* he; 896 const char* key; 897 const char* value; 898 int vlen; 899 const char* cmp; 900 int clen; 901 902 /* Skip the step if there is nothing which can be filtered. */ 903 if (l->c == 0) return; 904 905 key = Tcl_GetString (k); 906 value = Tcl_GetStringFromObj (v, &vlen); 907 908 if (l->c > 0) { 909 /* Filter an existing set of nodes/arcs down to the set of nodes/arcs 910 * passing the filter. 911 */ 912 913 int src, dst; 914 GC* c; 915 916 for (src = 0, dst = 0; src < l->c; src++) { 917 c = gf (g, l->v [src], NULL, NULL); 918 919 if (!c->attr) continue; 920 if (!c->attr->numEntries) continue; 921 he = Tcl_FindHashEntry (c->attr, key); 922 if (!he) continue; 923 cmp = Tcl_GetStringFromObj ((Tcl_Obj*) Tcl_GetHashValue(he), &clen); 924 if ((vlen != clen) || 925 (strcmp(value, cmp) != 0)) continue; 926 927 ASSERT_BOUNDS (dst, l->c); 928 ASSERT_BOUNDS (src, l->c); 929 930 l->v [dst] = l->v [src]; 931 dst++; 932 } 933 934 ASSERT (dst <= l->c, "Overrun"); 935 l->c = dst; 936 937 } else { 938 /* There is no set, iterate over nodes/arcs and fill the result with 939 * all nodes/arcs passing the filter. 940 */ 941 942 int i; 943 GC* iter; 944 945 for (i = 0, iter = gx->first; 946 iter != NULL; 947 iter = iter->next) { 948 ASSERT_BOUNDS (i, gx->n); 949 950 if (!iter->attr) continue; 951 if (!iter->attr->numEntries) continue; 952 he = Tcl_FindHashEntry (iter->attr, key); 953 if (!he) continue; 954 cmp = Tcl_GetStringFromObj ((Tcl_Obj*) Tcl_GetHashValue(he), &clen); 955 if ((vlen != clen) || 956 (strcmp(value, cmp) != 0)) continue; 957 958 ASSERT_BOUNDS (i, gx->n); 959 l->v [i] = iter->name; 960 i++; 961 } 962 963 ASSERT (i <= gx->n, "Overrun"); 964 l->c = i; 965 } 966} 967 968/* .................................................. */ 969 970static void 971filter_k (Tcl_Interp* interp, GCC* gx, NARES* l, GN_GET_GC* gf, G* g, Tcl_Obj* k) 972{ 973 /* 2 modes: 974 * (a) l->c == -1 => Fill with matching entities 975 * (b) l->c == 0 => Nothing to do. 976 * (c) otherwise => Filter found entities 977 */ 978 979 Tcl_HashEntry* he; 980 const char* key; 981 982 /* Skip the step if there is nothing which can be filtered. */ 983 if (l->c == 0) return; 984 985 key = Tcl_GetString (k); 986 987 if (l->c > 0) { 988 /* Filter an existing set of nodes/arcs down to the set of nodes/arcs 989 * passing the filter. 990 */ 991 992 int src, dst; 993 GC* c; 994 995 for (src = 0, dst = 0; src < l->c; src++) { 996 c = gf (g, l->v [src], NULL, NULL); 997 998 if (!c->attr) continue; 999 if (!c->attr->numEntries) continue; 1000 he = Tcl_FindHashEntry (c->attr, key); 1001 if (!he) continue; 1002 1003 ASSERT_BOUNDS (dst, l->c); 1004 ASSERT_BOUNDS (src, l->c); 1005 1006 l->v [dst] = l->v [src]; 1007 dst++; 1008 } 1009 1010 ASSERT (dst <= l->c, "Overrun"); 1011 l->c = dst; 1012 1013 } else { 1014 /* There is no set, iterate over nodes/arcs and fill the result with 1015 * all nodes/arcs passing the filter. 1016 */ 1017 1018 int i; 1019 GC* iter; 1020 1021 for (i = 0, iter = gx->first; 1022 iter != NULL; 1023 iter = iter->next) { 1024 ASSERT_BOUNDS (i, gx->n); 1025 1026 if (!iter->attr) continue; 1027 if (!iter->attr->numEntries) continue; 1028 he = Tcl_FindHashEntry (iter->attr, key); 1029 if (!he) continue; 1030 1031 ASSERT_BOUNDS (i, gx->n); 1032 l->v [i] = iter->name; 1033 i++; 1034 } 1035 1036 ASSERT (i <= gx->n, "Overrun"); 1037 l->c = i; 1038 } 1039} 1040 1041/* .................................................. */ 1042 1043static int 1044filter_cmd (Tcl_Interp* interp, GCC* gx, NARES* l, Tcl_Obj* cmd, Tcl_Obj* g) 1045{ 1046 /* 2 modes: 1047 * (a) l->c == -1 => Fill with matching entities 1048 * (b) l->c == 0 => Nothing to do. 1049 * (c) otherwise => Filter found entities 1050 */ 1051 1052 int cmdc; 1053 Tcl_Obj** cmdv; 1054 int code = TCL_ERROR; 1055 int ec; 1056 Tcl_Obj** ev; 1057 int flag; 1058 int res; 1059 int i; 1060 1061 if (Tcl_ListObjGetElements (interp, cmd, &cmdc, &cmdv) != TCL_OK) { 1062 return TCL_ERROR; 1063 } 1064 1065 /* Skip the step if there is nothing which can be filtered. */ 1066 if (l->c == 0) return; 1067 1068 /* -------------------- */ 1069 /* Set up the command vector for the callback. Two placeholders for graph 1070 * and node/arc arguments. 1071 */ 1072 1073 ec = cmdc + 2; 1074 ev = NALLOC (ec, Tcl_Obj*); 1075 1076 for (i = 0; i < cmdc; i++) { 1077 ASSERT_BOUNDS (i, ec); 1078 ev [i] = cmdv [i]; 1079 Tcl_IncrRefCount (ev [i]); 1080 } 1081 1082 ASSERT_BOUNDS (cmdc, ec); 1083 ev [cmdc] = g; /* Graph */ 1084 Tcl_IncrRefCount (ev [cmdc]); 1085 1086 /* -------------------- */ 1087 1088 if (l->c > 0) { 1089 /* Filter an existing set of nodes/arcs down to the set of nodes/arcs 1090 * passing the filter. 1091 */ 1092 1093 int src, dst; 1094 1095 for (src = 0, dst = 0; src < l->c; src++) { 1096 /* Fill the placeholders */ 1097 1098 ASSERT_BOUNDS (cmdc+1, ec); 1099 ASSERT_BOUNDS (src, l->c); 1100 ev [cmdc+1] = l->v [src]; /* Node/Arc */ 1101 1102 /* Run the callback */ 1103 Tcl_IncrRefCount (ev [cmdc+1]); 1104 res = Tcl_EvalObjv (interp, ec, ev, 0); 1105 Tcl_DecrRefCount (ev [cmdc+1]); 1106 1107 /* Process the result */ 1108 if (res != TCL_OK) { 1109 goto abort; 1110 } 1111 if (Tcl_GetBooleanFromObj (interp, 1112 Tcl_GetObjResult (interp), 1113 &flag) != TCL_OK) { 1114 goto abort; 1115 } 1116 1117 /* Result is valid, use this to decide retain/write over */ 1118 if (!flag) continue; 1119 1120 ASSERT_BOUNDS (dst, l->c); 1121 ASSERT_BOUNDS (src, l->c); 1122 1123 l->v [dst] = l->v [src]; 1124 dst++; 1125 } 1126 1127 ASSERT (dst <= l->c, "Overrun"); 1128 l->c = dst; 1129 1130 } else { 1131 /* There is no set, iterate over nodes/arcs and fill the result with 1132 * all nodes/arcs passing the filter. 1133 */ 1134 1135 int i; 1136 GC* iter; 1137 1138 for (i = 0, iter = gx->first; 1139 iter != NULL; 1140 iter = iter->next) { 1141 ASSERT_BOUNDS (i, gx->n); 1142 1143 /* Fill the placeholders */ 1144 1145 ASSERT_BOUNDS (cmdc+1, ec); 1146 ev [cmdc+1] = iter->name; /* Node/Arc */ 1147 1148 /* Run the callback */ 1149 Tcl_IncrRefCount (ev [cmdc+1]); 1150 res = Tcl_EvalObjv (interp, ec, ev, 0); 1151 Tcl_DecrRefCount (ev [cmdc+1]); 1152 1153 /* Process the result */ 1154 if (res != TCL_OK) { 1155 goto abort; 1156 } 1157 if (Tcl_GetBooleanFromObj (interp, 1158 Tcl_GetObjResult (interp), 1159 &flag) != TCL_OK) { 1160 goto abort; 1161 } 1162 1163 /* Result is valid, use this to decide retain/write over */ 1164 if (!flag) continue; 1165 1166 ASSERT_BOUNDS (i, gx->n); 1167 l->v [i] = iter->name; 1168 i++; 1169 } 1170 1171 ASSERT (i <= gx->n, "Overrun"); 1172 l->c = i; 1173 } 1174 1175 /* -------------------- */ 1176 /* Cleanup state */ 1177 1178 Tcl_ResetResult (interp); 1179 code = TCL_OK; 1180 1181 abort: 1182 /* We do not reset the interp result. It either contains the non-boolean 1183 * result, or the error message. 1184 */ 1185 1186 for (i = 0; i < cmdc; i++) { 1187 ASSERT_BOUNDS (i, ec); 1188 Tcl_DecrRefCount (ev [i]); 1189 } 1190 1191 ASSERT_BOUNDS (cmdc, ec); 1192 Tcl_DecrRefCount (ev [cmdc]); /* Graph */ 1193 ckfree ((char*) ev); 1194 1195 /* -------------------- */ 1196 return code; 1197} 1198 1199/* .................................................. */ 1200 1201/* 1202 * Local Variables: 1203 * mode: c 1204 * c-basic-offset: 4 1205 * fill-column: 78 1206 * End: 1207 */ 1208