/* struct::tree - critcl - layer 1 definitions
 * (c) Tree functions
 */

#include <string.h>
#include <t.h>
#include <tn.h>
#include <util.h>

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

T*
t_new (void)
{
    T* t = ALLOC (T);

    Tcl_InitHashTable (&t->node, TCL_STRING_KEYS);

    t->cmd	 = NULL;
    t->counter	 = 0;
    t->nodes	 = NULL;
    t->nnodes	 = 0;
    t->leaves	 = NULL;
    t->nleaves	 = 0;
    t->root	 = tn_new (t, "root");
    t->structure = 0;

    return t;
}

void
t_delete (T* t)
{
    /* Delete a tree in toto. Recursively deletes all nodes first,
     * starting at root. This also handles the nodes/leaves lists.
     * Then the name -> node mapping, and the object name. The
     */

    tn_delete (t->root);

    Tcl_DeleteHashTable(&t->node);

    t->cmd = NULL;
    ckfree ((char*) t);
}

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

void
t_structure (T* t)
{
    /* Computes all structural data,
     * then declares it valid.
   */

    tn_structure (t->root, 0);
    t->structure = 1;
}

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

int
t_deserialize (T* dst, Tcl_Interp* interp, Tcl_Obj* src)
{
    Tcl_Size  listc, nodes;
    Tcl_Obj** listv;

    int	      root   = -1;
    int*      parent = NULL;

    /* Basic checks:
     * - Is the input a list ?
     * - Is its length a multiple of three ?
     *
     * structure:  node-name parent-index attr-dict
     *		   i+0	     i+1	  i+2
     */

#define NAME(i)	  (i)
#define PARENT(i) ((i)+1)
#define ATTR(i)	  ((i)+2)

    if (Tcl_ListObjGetElements (interp, src, &listc, &listv) != TCL_OK) { /* OK tcl9 */
	return TCL_ERROR;
    }
    if ((listc % 3) != 0) {
	Tcl_AppendResult (interp,
			  "error in serialization: list length not a multiple of 3.",
			  NULL);
	return TCL_ERROR;
    }

    nodes = listc/3;

    /* Iterate and check the attribute dictionaries for listness and
     * size (even length).
     */

    {
	Tcl_Size  ac, i, j;
	Tcl_Obj** av;

	for (i = 0, j = 0;
	     i < listc;
	     i += 3, j++) {

	    ASSERT_BOUNDS (ATTR(i), listc);
	    ASSERT_BOUNDS (j,	    nodes);

	    if (Tcl_ListObjGetElements (interp, listv [ATTR(i)], /* OK tcl9 */
					&ac, &av) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((ac % 2) != 0) {
		Tcl_AppendResult (interp,
				  "error in serialization: malformed attribute dictionary.",
				  NULL);
		return TCL_ERROR;
	    }
	}
    }

    /* Iterate to locate the definition of root. Fails if there is none,
     * or more than one.
     */

    {
	Tcl_Size i, j;
	CONST char* parent;

	for (i = 0, j = 0, root = -1;
	     i < listc;
	     i += 3, j++) {
	    /* j == i/3 */

	    ASSERT_BOUNDS (PARENT(i), listc);
	    ASSERT_BOUNDS (j,	      nodes);

	    parent = Tcl_GetString (listv [PARENT(i)]);

	    if (0 == strcmp ("", parent)) {
		if (root >= 0) {
		    Tcl_AppendResult (interp,
				      "error in serialization: multiple root nodes.",
				      NULL);
		    return TCL_ERROR;
		}

		root = j;
	    }
	}

	if (root < 0) {
	    Tcl_AppendResult (interp,
			      "error in serialization: no root specified.",
			      NULL);
	    return TCL_ERROR;
	}
    }

    /* Iterate again, check that the non-empty parent references
     * are ok. We use the information we have about root to skip
     * over the empty reference. We save the extracted and parsed
     * references in a temp. allocated array.
     */

    {
	int      res;
	Tcl_Size i, j, index;
	Tcl_Obj* p;

	parent = NALLOC (nodes, int);

	ASSERT_BOUNDS (root, nodes);
	parent [root] = -1; /* Sensible, unused */

	for (i = 0, j = 0;
	     i < listc;
	     i += 3, j++) {
	    /* j == i/3 */

	    ASSERT_BOUNDS (PARENT(i), listc);
	    ASSERT_BOUNDS (j,	      nodes);

	    if (j == root)
		continue;

	    p	= listv [PARENT(i)];
	    res = Tcl_GetSizeIntFromObj (interp, p, &index); /* OK tcl9 */

	    if (
		(res != TCL_OK) ||
		(index < 0) ||
		(index >= listc) ||
		((index % 3) != 0)
		) {
		Tcl_ResetResult (interp);
		Tcl_AppendResult (interp,
				  "error in serialization: bad parent reference \"",
				  Tcl_GetString (p),
				  "\".", NULL);
		ckfree ((char*) parent);
		return TCL_ERROR;
	    }

	    if (index == i) {
		/* Found a cyclic reference (direct cycle, node defines
		 * itself as its parent)
		 */

		Tcl_AppendResult (interp,
				  "error in serialization: cycle detected.",
				  NULL);
		ckfree ((char*) parent);
		return TCL_ERROR;
	    }

	    parent [j] = index/3;
	}
    }

    /* Iteration over the parent information from the last phase.  We
     * are looking for indirect cycles. We detect them indirectly. If
     * there are cycles we are unable to tag all nodes starting from the
     * root. A tag means that the depth of the node can be computed, and
     * for nodes in a cycle this is not possible.
     */

    {
	int*     tag = NALLOC (nodes, int);
	Tcl_Size i;
	int      changed = 1; /* Flag that last iteration tagged new nodes */
	int      done    = 0; /* #nodes tagged */

	for (i = 0; i < nodes; i++) {
	    ASSERT_BOUNDS (i, nodes);
	    tag [i] = 0;
	}

	ASSERT_BOUNDS (root, nodes);
	tag [root] = 1;
	done ++;

	while (changed) {
	    changed = 0;

	    for (i = 0; i < nodes; i++) {
		ASSERT_BOUNDS (i, nodes);
		if (tag [i])
		    continue;

		/* Assert: parent [i] in 0 .. nodes-1 */
		ASSERT_BOUNDS (parent[i], nodes);
		if (!tag [parent [i]])
		    continue;

		tag [i] = 1;
		changed = 1;
		done ++;
	    }
	}

	ckfree ((char*) tag);

	if (done < nodes) {
	    Tcl_AppendResult (interp,
			      "error in serialization: cycle detected.",
			      NULL);

	    ckfree ((char*) parent);
	    return TCL_ERROR;
	}
    }

    /* Last iteration. Check that the node names are unique.
     */

    {
	Tcl_Size      i, j;
	int           new;
	Tcl_HashTable nx;

	Tcl_InitHashTable (&nx, TCL_STRING_KEYS);

	for (i = 0, j = 0;
	     i < listc;
	     i += 3, j++) {

	    ASSERT_BOUNDS (NAME(i), listc);
	    ASSERT_BOUNDS (j,	    nodes);

	    Tcl_CreateHashEntry (&nx, Tcl_GetString (listv [NAME(i)]),
				 &new);

	    if (!new) {
		Tcl_AppendResult (interp,
				  "error in serialization: duplicate node names.",
				  NULL);
		Tcl_DeleteHashTable(&nx);
		ckfree ((char*) parent);
		return TCL_ERROR;
	    }
	}

	Tcl_DeleteHashTable(&nx);
    }

    /* The serialization has been successfully validated now.
     * We create the nodes, their attributes, and link them
     * into the proper structure per the root and parent
     * information provided to us by the validation.
     */

    {
	Tcl_Size i, j;
	TN** nv = NALLOC (nodes, TN*);
	TN* n;
	TN* p;

	tn_delete (dst->root);

	for (i = 0, j = 0;
	     i < listc;
	     i += 3, j++) {
	    /* j == i/3 */

	    ASSERT_BOUNDS (NAME(i), listc);
	    ASSERT_BOUNDS (j,	    nodes);

	    nv [j] = tn_new (dst, Tcl_GetString (listv [NAME(i)]));
	}

	dst->root = nv [root];

	for (i = 0, j = 0;
	     i < listc;
	     i += 3, j++) {
	    /* j == i/3 */

	    ASSERT_BOUNDS (ATTR(i),   listc);
	    ASSERT_BOUNDS (j,	      nodes);

	    if (j == root) {
		/* We don't append the node, this has already been covered,
		 * but we have to process the attributes.
		 */

		tn_set_attr (nv [j], interp, listv [ATTR(i)]);
		continue;
	    }

	    ASSERT_BOUNDS (parent[j], nodes);

	    n = nv [j];
	    p = nv [parent [j]];

	    tn_append (p, n);
	    tn_set_attr (n, interp, listv [ATTR(i)]);
	}

	ckfree ((char*) nv);
    }

    ckfree ((char*) parent);
    return TCL_OK;
}

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

int
t_assign (T* dst, T* src)
{
    tn_delete (dst->root);
    dst->root = tn_dup (dst, src->root);
    return TCL_OK;
}

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

CONST char*
t_newnodename (T* t)
{
    int ok;
    Tcl_HashEntry* he;

    do {
	t->counter ++;
	sprintf (t->handle, "node%d", t->counter);

	/* Check that there is no node using that name already */
	he = Tcl_FindHashEntry (&t->node, t->handle);
	ok = (he == NULL);
    } while (!ok);

    return t->handle;
}

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

void
t_dump (TPtr t, FILE* f)
{
    /* Write the structural data of the
     * tree (i.e. internal pointers) to
     * the file, as aid in debugging
     */

    Tcl_HashSearch hs;
    Tcl_HashEntry* he;
    TNPtr n;

    fprintf (f, "T (%p) {\n",t);fflush(f);
    fprintf (f, ".   Lstart %p '%s'\n", t->leaves, t->leaves?Tcl_GetString(t->leaves->name):"");fflush(f);
    fprintf (f, ".   Nstart %p '%s'\n", t->nodes,  t->nodes ?Tcl_GetString(t->nodes ->name):"");fflush(f);

    for (he = Tcl_FirstHashEntry (&t->node, &hs);
	 he != NULL;
	 he = Tcl_NextHashEntry (&hs)) {
	n = (TNPtr) Tcl_GetHashValue(he);
	fprintf (f, ".   N [%p '%s']",n,Tcl_GetString(n->name))   ;fflush(f);
	fprintf (f, " %p",n->tree);fflush(f);
	fprintf (f, " %p '%s'",n->prevleaf,n->prevleaf?Tcl_GetString(n->prevleaf->name):"");fflush(f);
	fprintf (f, " %p '%s'",n->nextleaf,n->nextleaf?Tcl_GetString(n->nextleaf->name):"");fflush(f);
	fprintf (f, " %p '%s'",n->prevnode,n->prevnode?Tcl_GetString(n->prevnode->name):"");fflush(f);
	fprintf (f, " %p '%s'",n->nextnode,n->nextnode?Tcl_GetString(n->nextnode->name):"");fflush(f);
	fprintf (f, " %p '%s'",n->parent  ,n->parent  ?Tcl_GetString(n->parent->name)  :"");fflush(f);
	fprintf (f, "\n");fflush(f);
    }
    fprintf (f, "}\n");fflush(f);
}

/* .................................................. */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */