#include "tcl.h"
#include <graph.h>
#include <util.h>
#include <walk.h>
/* .................................................. */
static int walkdfspre (Tcl_Interp* interp, GN* n, int dir,
Tcl_HashTable* v, int cc, Tcl_Obj** ev,
Tcl_Obj* action);
static int walkdfspost (Tcl_Interp* interp, GN* n, int dir,
Tcl_HashTable* v, int cc, Tcl_Obj** ev,
Tcl_Obj* action);
static int walkdfsboth (Tcl_Interp* interp, GN* n, int dir,
Tcl_HashTable* v, int cc, Tcl_Obj** ev,
Tcl_Obj* enter, Tcl_Obj* leave);
static int walkbfspre (Tcl_Interp* interp, GN* n, int dir,
Tcl_HashTable* v, int cc, Tcl_Obj** ev,
Tcl_Obj* action);
static int walk_invoke (Tcl_Interp* interp, GN* n,
int cc, Tcl_Obj** ev, Tcl_Obj* action);
static int walk_neighbours (GN* n, Tcl_HashTable* v, int dir,
int* nc, GN*** nv);
/* .................................................. */
int
g_walkoptions (Tcl_Interp* interp,
int objc, Tcl_Obj* const* objv,
int* type, int* order, int* dir,
int* cc, Tcl_Obj*** cv)
{
int xcc, xtype, xorder, xdir, i;
Tcl_Obj** xcv;
Tcl_Obj* wtype = NULL;
Tcl_Obj* worder = NULL;
Tcl_Obj* wdir = NULL;
Tcl_Obj* wcmd = NULL;
static CONST char* wtypes [] = {
"bfs", "dfs", NULL
};
static CONST char* worders [] = {
"both", "pre", "post", NULL
};
static CONST char* wdirs [] = {
"backward", "forward", NULL
};
for (i = 3; i < objc; ) {
ASSERT_BOUNDS (i, objc);
if (0 == strcmp ("-type", Tcl_GetString (objv [i]))) {
if (objc == (i+1)) {
wrongargs:
Tcl_AppendResult (interp,
"value for \"", Tcl_GetString (objv[i]),
"\" missing, should be \"",
Tcl_GetString (objv [0]), " walk ",
W_USAGE, "\"", NULL);
return TCL_ERROR;
}
ASSERT_BOUNDS (i+1, objc);
wtype = objv [i+1];
i += 2;
} else if (0 == strcmp ("-order", Tcl_GetString (objv [i]))) {
if (objc == (i+1)) goto wrongargs;
ASSERT_BOUNDS (i+1, objc);
worder = objv [i+1];
i += 2;
} else if (0 == strcmp ("-dir", Tcl_GetString (objv [i]))) {
if (objc == (i+1)) goto wrongargs;
ASSERT_BOUNDS (i+1, objc);
wdir = objv [i+1];
i += 2;
} else if (0 == strcmp ("-command", Tcl_GetString (objv [i]))) {
if (objc == (i+1)) goto wrongargs;
ASSERT_BOUNDS (i+1, objc);
wcmd = objv [i+1];
i += 2;
} else {
Tcl_AppendResult (interp, "unknown option \"",
Tcl_GetString (objv [i]), "\": should be \"",
Tcl_GetString (objv [0]), " walk ",
W_USAGE, "\"", NULL);
return TCL_ERROR;
break;
}
}
if (i < objc) {
Tcl_WrongNumArgs (interp, 2, objv, W_USAGE);
return TCL_ERROR;
}
if (!wcmd) {
no_command:
Tcl_AppendResult (interp,
"no command specified: should be \"",
Tcl_GetString (objv [0]), " walk ",
W_USAGE, "\"", NULL);
return TCL_ERROR;
} else if (Tcl_ListObjGetElements (interp, wcmd, &xcc, &xcv) != TCL_OK) {
return TCL_ERROR;
} else if (xcc == 0) {
goto no_command;
}
xtype = WG_DFS;
xorder = WO_PRE;
xdir = WD_FORWARD;
if (wtype &&
(Tcl_GetIndexFromObj (interp, wtype, wtypes,
"search type", 0, &xtype) != TCL_OK)) {
return TCL_ERROR;
}
if (worder &&
(Tcl_GetIndexFromObj (interp, worder, worders,
"search order", 0, &xorder) != TCL_OK)) {
return TCL_ERROR;
}
if (wdir &&
(Tcl_GetIndexFromObj (interp, wdir, wdirs,
"search direction", 0, &xdir) != TCL_OK)) {
return TCL_ERROR;
}
if (xtype == WG_BFS) {
if (xorder == WO_BOTH) {
Tcl_AppendResult (interp,
"unable to do a both-order breadth first walk",
NULL);
return TCL_ERROR;
}
if (xorder == WO_POST) {
Tcl_AppendResult (interp,
"unable to do a post-order breadth first walk",
NULL);
return TCL_ERROR;
}
}
*type = xtype;
*order = xorder;
*dir = xdir;
*cc = xcc;
*cv = xcv;
return TCL_OK;
}
/* .................................................. */
int
g_walk (Tcl_Interp* interp, Tcl_Obj* go, GN* n,
int type, int order, int dir,
int cc, Tcl_Obj** cv)
{
int ec, res, i;
Tcl_Obj** ev;
Tcl_Obj* la = NULL;
Tcl_Obj* lb = NULL;
Tcl_HashTable v;
/* Area to remember which nodes have been visited already */
Tcl_InitHashTable (&v, TCL_ONE_WORD_KEYS);
ec = cc + 3;
ev = NALLOC (ec, Tcl_Obj*);
for (i=0;i<cc;i++) {
ev [i] = cv [i];
Tcl_IncrRefCount (ev [i]);
}
/* cc+0 action
* cc+1 graph **
* cc+2 node
*/
ev [cc+1] = go;
Tcl_IncrRefCount (ev [cc+1]);
switch (type) {
case WG_DFS:
switch (order) {
case WO_BOTH:
la = Tcl_NewStringObj ("enter",-1); Tcl_IncrRefCount (la);
lb = Tcl_NewStringObj ("leave",-1); Tcl_IncrRefCount (lb);
res = walkdfsboth (interp, n, dir, &v, cc, ev, la, lb);
Tcl_DecrRefCount (la);
Tcl_DecrRefCount (lb);
break;
case WO_PRE:
la = Tcl_NewStringObj ("enter",-1); Tcl_IncrRefCount (la);
res = walkdfspre (interp, n, dir, &v, cc, ev, la);
Tcl_DecrRefCount (la);
break;
case WO_POST:
la = Tcl_NewStringObj ("leave",-1); Tcl_IncrRefCount (la);
res = walkdfspost (interp, n, dir, &v, cc, ev, la);
Tcl_DecrRefCount (la);
break;
}
break;
case WG_BFS:
switch (order) {
case WO_BOTH:
case WO_POST: Tcl_Panic ("impossible combination bfs/(both|post)"); break;
case WO_PRE:
la = Tcl_NewStringObj ("enter",-1); Tcl_IncrRefCount (la);
res = walkbfspre (interp, n, dir, &v, cc, ev, la);
Tcl_DecrRefCount (la);
break;
}
break;
}
for (i=0; i<cc; i++) {
Tcl_DecrRefCount (ev [i]);
}
Tcl_DecrRefCount (ev [cc+1]);
ckfree ((char*) ev);
Tcl_DeleteHashTable (&v);
/* Error and Return are passed unchanged. Everything else is ok */
if (res == TCL_ERROR) {return res;}
if (res == TCL_RETURN) {return res;}
return TCL_OK;
}
/* .................................................. */
int
walk_invoke (Tcl_Interp* interp, GN* n,
int cc, Tcl_Obj** ev, Tcl_Obj* action)
{
int res;
/* cc+0 action **
* cc+1 graph
* cc+2 node **
*/
ev [cc+0] = action; /* enter/leave */
ev [cc+2] = n->base.name ; /* node */
/* ec = cc+3 */
Tcl_IncrRefCount (ev [cc+0]);
Tcl_IncrRefCount (ev [cc+2]);
res = Tcl_EvalObjv (interp, cc+3, ev, 0);
Tcl_DecrRefCount (ev [cc+0]);
Tcl_DecrRefCount (ev [cc+2]);
return res;
}
/* .................................................. */
static int
walk_neighbours (GN* n, Tcl_HashTable* vn, int dir,
int* nc, GN*** nv)
{
GLA* neigh;
GL* il;
int c, i;
GN** v;
if (dir == WD_BACKWARD) {
neigh = &n->in;
} else {
neigh = &n->out;
}
c = 0;
v = NULL;
if (neigh->n) {
/* We make a copy of the neighbours. This emulates the behaviour of
* the Tcl implementation, which will walk to a neighbour of this
* node, even if the command moved it to a different node before it
* was reached by the loop here. If the node the neighbours is moved
* to was already visited nothing else will happen. Ortherwise the
* neighbours will be visited multiple times.
*/
c = neigh->n;
v = NALLOC (c, GN*);
if (dir == WD_BACKWARD) {
for (i=0, il = neigh->first;
il != NULL;
il = il->next) {
if (Tcl_FindHashEntry (vn, (char*) il->a->start->n)) continue;
ASSERT_BOUNDS (i, c);
v [i] = il->a->start->n;
i++;
}
} else {
for (i=0, il = neigh->first;
il != NULL;
il = il->next) {
if (Tcl_FindHashEntry (vn, (char*) il->a->end->n)) continue;
ASSERT_BOUNDS (i, c);
v [i] = il->a->end->n;
i++;
}
}
c = i;
if (!c) {
ckfree ((char*) v);
v = NULL;
}
}
*nc = c;
*nv = v;
}
/* .................................................. */
static int
walkdfspre (Tcl_Interp* interp, GN* n, int dir, Tcl_HashTable* v,
int cc, Tcl_Obj** ev, Tcl_Obj* action)
{
/* ok - next node
* error - abort walking
* break - abort walking
* continue - next node
* return - abort walking
*/
int nc, res, new;
GN** nv;
/* Current node before neighbours, action is 'enter'. */
res = walk_invoke (interp, n, cc, ev, action);
if ((res != TCL_OK) && (res != TCL_CONTINUE)) {
return res;
}
Tcl_CreateHashEntry (v, (char*) n, &new);
walk_neighbours (n, v, dir, &nc, &nv);
if (nc) {
int i;
for (i = 0; i < nc; i++) {
/* Skip nodes already visited deeper in the recursion */
if (Tcl_FindHashEntry (v, (char*) nv[i])) continue;
res = walkdfspre (interp, nv [i], dir, v, cc, ev, action);
/* continue cannot occur, were transformed into ok by the
* neighbour.
*/
if (res != TCL_OK) {
ckfree ((char*) nv);
return res;
}
}
ckfree ((char*) nv);
}
return TCL_OK;
}
static int
walkdfspost (Tcl_Interp* interp, GN* n, int dir, Tcl_HashTable* v,
int cc, Tcl_Obj** ev, Tcl_Obj* action)
{
int nc, res, new;
GN** nv;
/* Current node after neighbours, action is 'leave'. */
Tcl_CreateHashEntry (v, (char*) n, &new);
walk_neighbours (n, v, dir, &nc, &nv);
if (nc) {
int i;
for (i = 0; i < nc; i++) {
/* Skip nodes already visited deeper in the recursion */
if (Tcl_FindHashEntry (v, (char*) nv[i])) continue;
res = walkdfspost (interp, nv [i], dir, v, cc, ev, action);
if ((res == TCL_ERROR) ||
(res == TCL_BREAK) ||
(res == TCL_RETURN)) {
ckfree ((char*) nv);
return res;
}
}
ckfree ((char*) nv);
}
res = walk_invoke (interp, n, cc, ev, action);
if ((res == TCL_ERROR) ||
(res == TCL_BREAK) ||
(res == TCL_RETURN)) {
return res;
}
return TCL_OK;
}
static int
walkdfsboth (Tcl_Interp* interp, GN* n, int dir, Tcl_HashTable* v,
int cc, Tcl_Obj** ev, Tcl_Obj* enter, Tcl_Obj* leave)
{
/* ok - next node
* error - abort walking
* break - abort walking
* continue - next node
* return - abort walking
*/
int nc, res, new;
GN** nv;
/* Current node before and after neighbours, action is 'enter' & 'leave'. */
res = walk_invoke (interp, n, cc, ev, enter);
if ((res != TCL_OK) && (res != TCL_CONTINUE)) {
return res;
}
Tcl_CreateHashEntry (v, (char*) n, &new);
walk_neighbours (n, v, dir, &nc, &nv);
if (nc) {
int i;
for (i = 0; i < nc; i++) {
/* Skip nodes already visited deeper in the recursion */
if (Tcl_FindHashEntry (v, (char*) nv[i])) continue;
res = walkdfsboth (interp, nv [i], dir, v, cc, ev, enter, leave);
/* continue cannot occur, were transformed into ok by the
* neighbour.
*/
if (res != TCL_OK) {
ckfree ((char*) nv);
return res;
}
}
ckfree ((char*) nv);
}
res = walk_invoke (interp, n, cc, ev, leave);
if ((res != TCL_OK) && (res != TCL_CONTINUE)) {
return res;
}
return TCL_OK;
}
static int
walkbfspre (Tcl_Interp* interp, GN* n, int dir, Tcl_HashTable* v,
int cc, Tcl_Obj** ev, Tcl_Obj* action)
{
/* ok - next node
* error - abort walking
* break - abort walking
* continue - next node
* return - abort walking
*/
int nc, res, new;
GN** nv;
NLQ q;
g_nlq_init (&q);
g_nlq_append (&q, n);
while (1) {
n = g_nlq_pop (&q);
if (!n) break;
/* Skip nodes already visited deeper in the recursion */
if (Tcl_FindHashEntry (v, (char*) n)) continue;
res = walk_invoke (interp, n, cc, ev, action);
if ((res != TCL_OK) && (res != TCL_CONTINUE)) {
g_nlq_clear (&q);
return res;
}
Tcl_CreateHashEntry (v, (char*) n, &new);
walk_neighbours (n, v, dir, &nc, &nv);
if (nc) {
int i;
for (i = 0; i < nc; i++) {
g_nlq_append (&q, nv [i]);
}
ckfree ((char*) nv);
}
}
return TCL_OK;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
syntax highlighted by Code2HTML, v. 0.9.1