#include "tcl.h"
#include <t.h>
#include <util.h>

/* .................................................. */

static int t_walkdfspre	 (Tcl_Interp* interp, TN* tdn, t_walk_function f,
			  Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
			  Tcl_Obj* action);
static int t_walkdfspost (Tcl_Interp* interp, TN* tdn, t_walk_function f,
			  Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
			  Tcl_Obj* action);
static int t_walkdfsin	 (Tcl_Interp* interp, TN* tdn, t_walk_function f,
			  Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
			  Tcl_Obj* action);
static int t_walkdfsboth (Tcl_Interp* interp, TN* tdn, t_walk_function f,
			  Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
			  Tcl_Obj* enter, Tcl_Obj* leave);
static int t_walkbfspre	 (Tcl_Interp* interp, TN* tdn, t_walk_function f,
			  Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
			  Tcl_Obj* action);
static int t_walkbfspost (Tcl_Interp* interp, TN* tdn, t_walk_function f,
			  Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
			  Tcl_Obj* action);
static int t_walkbfsboth (Tcl_Interp* interp, TN* tdn, t_walk_function f,
			  Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
			  Tcl_Obj* enter, Tcl_Obj* leave);

/* .................................................. */

int
t_walkoptions (Tcl_Interp* interp, int n,
	       int objc, Tcl_Obj* CONST* objv,
	       int* type, int* order, int* remainder,
	       char* usage)
{
    int i;
    Tcl_Obj* otype  = NULL;
    Tcl_Obj* oorder = NULL;

    static CONST char* wtypes [] = {
	"bfs", "dfs", NULL
    };
    static CONST char* worders [] = {
	"both", "in", "pre", "post", NULL
    };

    for (i = 3; i < objc; ) {
	ASSERT_BOUNDS (i, objc);
	if (0 == strcmp ("-type", Tcl_GetString (objv [i]))) {
	    if (objc == (i+1)) {
		Tcl_AppendResult (interp,
				  "value for \"-type\" missing",
				  NULL);
		return TCL_ERROR;
	    }

	    ASSERT_BOUNDS (i+1, objc);
	    otype = objv [i+1];
	    i += 2;

	} else if (0 == strcmp ("-order", Tcl_GetString (objv [i]))) {
	    if (objc == (i+1)) {
		Tcl_AppendResult (interp,
				  "value for \"-order\" missing",
				  NULL);
		return TCL_ERROR;
	    }

	    ASSERT_BOUNDS (i+1, objc);
	    oorder = objv [i+1];
	    i += 2;

	} else if (0 == strcmp ("--", Tcl_GetString (objv [i]))) {
	    i++;
	    break;
	} else {
	    break;
	}
    }

    if (i == objc) {
	Tcl_WrongNumArgs (interp, 2, objv, usage);
	return TCL_ERROR;
    }

    if ((objc - i) > n) {
	Tcl_AppendResult (interp, "unknown option \"", NULL);
	Tcl_AppendResult (interp, Tcl_GetString (objv [i]), NULL);
	Tcl_AppendResult (interp, "\"", NULL);
	return TCL_ERROR;
    }

    if (!otype) {
	*type = WT_DFS;
    } else if (Tcl_GetIndexFromObj (interp, otype, wtypes, "search type",
				    0, type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (!oorder) {
	*order = WO_PRE;
    } else if (Tcl_GetIndexFromObj (interp, oorder, worders, "search order",
				    0, order) != TCL_OK) {
	return TCL_ERROR;
    }

    if ((*order == WO_IN) && (*type == WT_BFS)) {
	Tcl_AppendResult (interp,
			  "unable to do a in-order breadth first walk",
			  NULL);
	return TCL_ERROR;
    }

    *remainder = i;
    return TCL_OK;
}

/* .................................................. */

int
t_walk (Tcl_Interp* interp, TN* tdn, int type, int order,
	t_walk_function f, Tcl_Obj* cs,
	Tcl_Obj* avn, Tcl_Obj* nvn)
{
    int	     res;
    Tcl_Obj* la = NULL;
    Tcl_Obj* lb = NULL;

    switch (type)
	{
	case WT_DFS:
	    switch (order)
		{
		case WO_BOTH:
		    la = Tcl_NewStringObj ("enter",-1); Tcl_IncrRefCount (la);
		    lb = Tcl_NewStringObj ("leave",-1); Tcl_IncrRefCount (lb);

		    res = t_walkdfsboth (interp, tdn, f, cs, avn, nvn, la, lb);

		    Tcl_DecrRefCount (la);
		    Tcl_DecrRefCount (lb);
		    break;

		case WO_IN:
		    la = Tcl_NewStringObj ("visit",-1); Tcl_IncrRefCount (la);

		    res = t_walkdfsin	(interp, tdn, f, cs, avn, nvn, la);

		    Tcl_DecrRefCount (la);
		    break;

		case WO_PRE:
		    la = Tcl_NewStringObj ("enter",-1); Tcl_IncrRefCount (la);

		    res = t_walkdfspre	(interp, tdn, f, cs, avn, nvn, la);

		    Tcl_DecrRefCount (la);
		    break;

		case WO_POST:
		    la = Tcl_NewStringObj ("leave",-1); Tcl_IncrRefCount (la);

		    res = t_walkdfspost (interp, tdn, f, cs, avn, nvn, la);

		    Tcl_DecrRefCount (la);
		    break;
		}
	    break;

	case WT_BFS:
	    switch (order)
		{
		case WO_BOTH:
		    la = Tcl_NewStringObj ("enter",-1); Tcl_IncrRefCount (la);
		    lb = Tcl_NewStringObj ("leave",-1); Tcl_IncrRefCount (lb);

		    res = t_walkbfsboth (interp, tdn, f, cs, avn, nvn, la, lb);

		    Tcl_DecrRefCount (la);
		    Tcl_DecrRefCount (lb);
		    break;

		case WO_PRE:
		    la = Tcl_NewStringObj ("enter",-1); Tcl_IncrRefCount (la);

		    res = t_walkbfspre	(interp, tdn, f, cs, avn, nvn, la);

		    Tcl_DecrRefCount (la);
		    break;

		case WO_POST:
		    la = Tcl_NewStringObj ("leave",-1); Tcl_IncrRefCount (la);

		    res = t_walkbfspost (interp, tdn, f, cs, avn, nvn, la);

		    Tcl_DecrRefCount (la);
		    break;
		}
	    break;
	}

    /* 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
t_walk_invokescript (Tcl_Interp* interp, TN* n, Tcl_Obj* cs,
		     Tcl_Obj* avn, Tcl_Obj* nvn,
		     Tcl_Obj* action)
{
    int res;

    /* Note: Array elements, like 'a(x)', are not possible as iterator variables */

    if (avn) {
	Tcl_ObjSetVar2 (interp, avn, NULL, action, 0);
    }
    Tcl_ObjSetVar2 (interp, nvn, NULL, n->name, 0);

    res = Tcl_EvalObj(interp, cs);

    return res;
}

int
t_walk_invokecmd (Tcl_Interp* interp, TN* n, Tcl_Obj* dummy0,
		  Tcl_Obj* dummy1, Tcl_Obj* dummy2,
		  Tcl_Obj* action)
{
    int	      res;
    int	      cc = (int)       dummy0;
    Tcl_Obj** ev = (Tcl_Obj**) dummy1; /* cc+3 elements */

    ev [cc]   = dummy2;	   /* Tree */
    ev [cc+1] = n->name;   /* Node */
    ev [cc+2] = action;	   /* Action */

    Tcl_IncrRefCount (ev [cc]);
    Tcl_IncrRefCount (ev [cc+1]);
    Tcl_IncrRefCount (ev [cc+2]);

    res = Tcl_EvalObjv (interp, cc+3, ev, 0);

    Tcl_DecrRefCount (ev [cc]);
    Tcl_DecrRefCount (ev [cc+1]);
    Tcl_DecrRefCount (ev [cc+2]);

    return res;
}

/* .................................................. */

static int
t_walkdfspre (Tcl_Interp* interp, TN* tdn, t_walk_function f,
	      Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
	      Tcl_Obj* action)
{
    /* ok	- next node
     * error	- abort walking
     * break	- abort walking
     * continue - next node
     * return	- abort walking
     * prune /5 - skip children, otherwise ok.
     */

    int res;

    /* Parent before children, action is 'enter'. */

    res = (*f) (interp, tdn, cs, avn, nvn, action);

    if (res == 5) {
	return TCL_OK;
    } else if ((res != TCL_OK) && (res != TCL_CONTINUE)) {
	return res;
    }

    if (tdn->nchildren) {
	/* We make a copy of the child array. This emulates the behaviour of
	 * the Tcl implementation, which will walk to a child of this node,
	 * even if the loop body/procedure moved it to a different node before
	 * it was reached by the loop here. If the node it the child is moved
	 * to was already visited nothing else will happen. Ortherwise the
	 * child will be visited multiple times.
	 */

	int i;
	int  nc = tdn->nchildren;
	TN** nv = NALLOC (nc,TN*);
	memcpy (nv, tdn->child, nc*sizeof(TN*));

	for (i = 0; i < nc; i++) {
	    res = t_walkdfspre (interp, nv [i], f, cs, avn, nvn, action);

	    /* prune, continue cannot occur, were transformed into ok
	     * by the child.
	     */

	    if (res != TCL_OK) {
		ckfree ((char*) nv);
		return res;
	    }
	}

	ckfree ((char*) nv);
    }

    return TCL_OK;
}

static int
t_walkdfspost (Tcl_Interp* interp, TN* tdn, t_walk_function f,
	       Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
	       Tcl_Obj* action)
{
    int res;

    /* Parent after children, action is 'leave'. */

    if (tdn->nchildren) {
	/* We make a copy of the child array. This emulates the behaviour of
	 * the Tcl implementation, which will walk to a child of this node,
	 * even if the loop body/procedure moved it to a different node before
	 * it was reached by the loop here. If the node it the child is moved
	 * to was already visited nothing else will happen. Ortherwise the
	 * child will be visited multiple times.
	 */

	int i;

	int  nc = tdn->nchildren;
	TN** nv = NALLOC (nc,TN*);
	memcpy (nv, tdn->child, nc*sizeof(TN*));

	for (i = 0; i < nc; i++) {
	    res = t_walkdfspost (interp, nv [i], f, cs, avn, nvn, action);

	    if ((res == TCL_ERROR) ||
		(res == TCL_BREAK) ||
		(res == TCL_RETURN)) {
		ckfree ((char*) nv);
		return res;
	    }
	}

	ckfree ((char*) nv);
    }

    res = (*f) (interp, tdn, cs, avn, nvn, action);

    if ((res == TCL_ERROR) ||
	(res == TCL_BREAK) ||
	(res == TCL_RETURN)) {
	return res;
    } else if (res == 5) {
	/* Illegal pruning */

	Tcl_ResetResult (interp);
	Tcl_AppendResult (interp,
			  "Illegal attempt to prune post-order walking", NULL);
	return TCL_ERROR;
    }

    return TCL_OK;
}

static int
t_walkdfsboth (Tcl_Interp* interp, TN* tdn, t_walk_function f,
	       Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
	       Tcl_Obj* enter, Tcl_Obj* leave)
{
    /* ok	- next node
     * error	- abort walking
     * break	- abort walking
     * continue - next node
     * return	- abort walking
     * prune /5 - skip children, otherwise ok.
     */

    int res;

    /* Parent before and after Children, action is 'enter' & 'leave'. */

    res = (*f) (interp, tdn, cs, avn, nvn, enter);

    if (res != 5) {
	if ((res != TCL_OK) && (res != TCL_CONTINUE)) {
	    return res;
	}

	if (tdn->nchildren) {
	    int i;
	    int  nc = tdn->nchildren;
	    TN** nv = NALLOC (nc,TN*);
	    memcpy (nv, tdn->child, nc*sizeof(TN*));

	    for (i = 0; i < nc; i++) {
		res = t_walkdfsboth (interp, nv [i], f, cs, avn, nvn, enter, leave);

		/* prune, continue cannot occur, were transformed into ok
		 * by the child.
		 */

		if (res != TCL_OK) {
		    ckfree ((char*) nv);
		    return res;
		}
	    }

	    ckfree ((char*) nv);
	}
    }

    res = (*f) (interp, tdn, cs, avn, nvn, leave);

    if (res == 5) {
	return TCL_OK;
    } else if ((res != TCL_OK) && (res != TCL_CONTINUE)) {
	return res;
    }

    return TCL_OK;
}

static int
t_walkdfsin (Tcl_Interp* interp, TN* tdn, t_walk_function f,
	     Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
	     Tcl_Obj* action)
{
    int res;

    /* First child visited first, then parent, then */
    /* the remaining children. Action is 'visit'.   */
    /* This is the correct thing for binary trees.  */
    /* For #children <= 1 the parent is visited */
    /* before the child */

    if (tdn->nchildren == 0) {
	res = (*f) (interp, tdn, cs, avn, nvn, action);

	if ((res == TCL_ERROR) ||
	    (res == TCL_BREAK) ||
	    (res == TCL_RETURN)) {
	    return res;
	} else if (res == 5) {
	    /* Illegal pruning */

	    Tcl_ResetResult (interp);
	    Tcl_AppendResult (interp,
			      "Illegal attempt to prune in-order walking", NULL);
	    return TCL_ERROR;
	}

    } else if (tdn->nchildren == 1) {
	res = (*f) (interp, tdn, cs, avn, nvn, action);

	if ((res == TCL_ERROR) ||
	    (res == TCL_BREAK) ||
	    (res == TCL_RETURN)) {
	    return res;
	} else if (res == 5) {
	    /* Illegal pruning */

	    Tcl_ResetResult (interp);
	    Tcl_AppendResult (interp,
			      "Illegal attempt to prune in-order walking", NULL);
	    return TCL_ERROR;
	}

	return t_walkdfsin (interp, tdn->child [0], f, cs, avn, nvn, action);

    } else {
	int i;
	int  nc = tdn->nchildren;
	TN** nv = NALLOC (nc,TN*);
	memcpy (nv, tdn->child, nc*sizeof(TN*));

	res = t_walkdfsin (interp, tdn->child [0], f, cs, avn, nvn, action);

	if ((res == TCL_ERROR) ||
	    (res == TCL_BREAK) ||
	    (res == TCL_RETURN)) {
	    ckfree ((char*) nv);
	    return res;
	}

	res = (*f) (interp, tdn, cs, avn, nvn, action);

	if ((res == TCL_ERROR) ||
	    (res == TCL_BREAK) ||
	    (res == TCL_RETURN)) {
	    ckfree ((char*) nv);
	    return res;
	} else if (res == 5) {
	    /* Illegal pruning */
	    ckfree ((char*) nv);

	    Tcl_ResetResult (interp);
	    Tcl_AppendResult (interp,
			      "Illegal attempt to prune in-order walking", NULL);
	    return TCL_ERROR;
	}

	for (i = 1; i < nc; i++) {
	    res = t_walkdfsin (interp, nv [i], f, cs, avn, nvn, action);

	    if ((res == TCL_ERROR) ||
		(res == TCL_BREAK) ||
		(res == TCL_RETURN)) {
		ckfree ((char*) nv);
		return res;
	    }
	}

	ckfree ((char*) nv);
    }

    return TCL_OK;
}

static int
t_walkbfsboth (Tcl_Interp* interp, TN* tdn, t_walk_function f,
	       Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
	       Tcl_Obj* enter, Tcl_Obj* leave)
{
    /* ok	- next node
     * error	- abort walking
     * break	- pre: abort walking, skip to post, post: abort walking
     * continue - next node
     * return	- abort walking
     * prune /5 - skip children, otherwise ok.
   */

    int res;
    TN* n;
    NLQ q;
    NLQ qb;

    nlq_init (&q);
    nlq_init (&qb);

    nlq_append (&q,  tdn);
    nlq_push   (&qb, tdn);

    while (1) {
	n = nlq_pop (&q);
	if (!n) break;

	res = (*f) (interp, n, cs, avn, nvn, enter);

	if (res == 5) {
	    continue;
	} else if (res == TCL_ERROR) {
	    nlq_clear (&q);
	    nlq_clear (&qb);
	    return res;
	} else if ((res != TCL_OK) && (res != TCL_CONTINUE)) {
	    nlq_clear (&q);

	    /* We abort the collection of more nodes, but still run the
	     * backward iteration (post-order phase).
	     */
	    break;
	}

	if (n->nchildren) {
	    int i;
	    for (i = 0; i < n->nchildren; i++) {
		nlq_append (&q,	 n->child [i]);
		nlq_push   (&qb, n->child [i]);
	    }
	}
    }

    /* Backward visit to leave */

    while (1) {
	n = nlq_pop (&qb);
	if (!n) break;

	res = (*f) (interp, n, cs, avn, nvn, leave);

	if (res == 5) {
	    continue;
	} else if ((res != TCL_OK) && (res != TCL_CONTINUE)) {
	    nlq_clear (&qb);
	    return res;
	}
    }

    return TCL_OK;
}

static int
t_walkbfspre (Tcl_Interp* interp, TN* tdn, t_walk_function f,
	      Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
	      Tcl_Obj* action)
{
    /* ok	- next node
     * error	- abort walking
     * break	- abort walking
     * continue - next node
     * return	- abort walking
     * prune /5 - skip children, otherwise ok.
   */

    int res;
    TN* n;
    NLQ q;

    nlq_init   (&q);
    nlq_append (&q, tdn);

    while (1) {
	n = nlq_pop (&q);
	if (!n) break;

	res = (*f) (interp, n, cs, avn, nvn, action);

	if (res == 5) {
	    continue;
	} else if ((res != TCL_OK) && (res != TCL_CONTINUE)) {
	    nlq_clear (&q);
	    return res;
	}

	if (n->nchildren) {
	    int i;
	    for (i = 0; i < n->nchildren; i++) {
		nlq_append (&q, n->child [i]);
	    }
	}
    }

    return TCL_OK;
}

static int
t_walkbfspost (Tcl_Interp* interp, TN* tdn, t_walk_function f,
	       Tcl_Obj* cs, Tcl_Obj* avn, Tcl_Obj* nvn,
	       Tcl_Obj* action)
{
    int res;
    TN* n;
    NLQ q;
    NLQ qb;

    nlq_init (&q);
    nlq_init (&qb);

    nlq_append (&q,  tdn);
    nlq_push   (&qb, tdn);

    while (1) {
	n = nlq_pop (&q);
	if (!n) break;

	if (n->nchildren) {
	    int i;
	    for (i = 0; i < n->nchildren; i++) {
		nlq_append (&q,	 n->child [i]);
		nlq_push   (&qb, n->child [i]);
	    }
	}
    }

    /* Backward visit to leave */

    while (1) {
	n = nlq_pop (&qb);
	if (!n) break;

	res = (*f) (interp, n, cs, avn, nvn, action);

	if ((res == TCL_ERROR) ||
	    (res == TCL_BREAK) ||
	    (res == TCL_RETURN)) {
	    nlq_clear (&qb);
	    return res;
	} else if (res == 5) {
	    /* Illegal pruning */

	    nlq_clear (&qb);
	    Tcl_ResetResult (interp);
	    Tcl_AppendResult (interp,
			      "Illegal attempt to prune post-order walking", NULL);
	    return TCL_ERROR;
	}
    }

    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */