Logo Search packages:      
Sourcecode: tcllib version File versions  Download package

graph.c

/* struct::graph - critcl - layer 1 definitions
 * (c) Graph functions
 */

#include <arc.h>
#include <attr.h>
#include <graph.h>
#include <node.h>
#include <objcmd.h>
#include <util.h>

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

static void swap (G* dst, G* src);
static G*   dup  (G* src);

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

G*
g_new (void)
{
    G* g = ALLOC (G);

    g->nodes.map = ALLOC (Tcl_HashTable);
    g->arcs.map  = ALLOC (Tcl_HashTable);

    Tcl_InitHashTable (g->nodes.map, TCL_STRING_KEYS);
    Tcl_InitHashTable (g->arcs.map,  TCL_STRING_KEYS);

    g->nodes.first = NULL;
    g->nodes.n       = 0;
    g->arcs.first  = NULL;
    g->arcs.n        = 0;

    g->attr        = NULL;

    g->cmd     = NULL;
    g->ncounter      = 0;
    g->acounter      = 0;

    return g;
}

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

void
g_delete (G* g)
{
    /* Delete a graph in toto. Deletes all arcs first, then all nodes. This
     * also handles the nodes/arcs lists. Then the name -> node/arc mapping,
     * and the object name.
     */

    while (g->arcs.first)  { ga_delete ((GA*) g->arcs.first);  }
    while (g->nodes.first) { gn_delete ((GN*) g->nodes.first); }

    Tcl_DeleteHashTable (g->arcs.map);
    Tcl_DeleteHashTable (g->nodes.map);

    ckfree ((char*) g->arcs.map);
    ckfree ((char*) g->nodes.map);

    g->arcs.map  = NULL;
    g->nodes.map = NULL;

    g->cmd = NULL;

    g_attr_delete (&g->attr);
    ckfree ((char*) g);
}

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

const char*
g_newnodename (G* g)
{
    int ok;
    Tcl_HashEntry* he;

    do {
      g->ncounter ++;
      sprintf (g->handle, "node%d", g->ncounter);

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

    return g->handle;
}

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

const char*
g_newarcname (G* g)
{
    int ok;
    Tcl_HashEntry* he;

    do {
      g->acounter ++;
      sprintf (g->handle, "arc%d", g->acounter);

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

    return g->handle;
}

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

/*
 *---------------------------------------------------------------------------
 *
 * g_ms_serialize --
 *
 *    Generates Tcl value from graph, serialized graph data.
 *
 * Results:
 *    A standard Tcl result code.
 *
 * Side effects:
 *    Only internal, memory allocation changes ...
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj*
g_ms_serialize (Tcl_Interp* interp, Tcl_Obj* go, G* g, int oc, Tcl_Obj* const* ov)
{
    Tcl_Obj*  ser;
    Tcl_Obj*  empty;

    int       lc = 1 + 3 * (oc ? oc : g->nodes.n);
    Tcl_Obj** lv = NALLOC (lc, Tcl_Obj*);

    Tcl_HashTable cn;
    int k, new;
    GN* n;

    /* Enumerate the nodes for the references used in arcs. FUTURE, TODO: Skip
     * this step if there are no arcs! We cannot skip testing the validity of
     * the nodes however, if the set is explicit. In that case we also check
     * and remove duplicates.  */

    Tcl_InitHashTable (&cn, TCL_ONE_WORD_KEYS);

    if (oc) {
      /* Enumerate the specified nodes, remove duplicates along the way */
      Tcl_HashEntry* he;
      int i, j, new;

      j = 0;
      for (i=0; i < oc; i++) {
          ASSERT_BOUNDS(i, oc);
          n = gn_get_node (g, ov[i], interp, go);
          if (!n) {
            goto abort;
          }
          if (Tcl_FindHashEntry (&cn, (char*) n)) continue;
          ASSERT_BOUNDS(j, lc-1);
          he = Tcl_CreateHashEntry (&cn, (char*) n, &new);
          lv [j] = n->base.name;
          Tcl_SetHashValue (he, (ClientData) j);
          j += 3;
      }
      lc = j + 1;
    } else {
      /* Enumerate all nodes */
      Tcl_HashEntry* he;
      int j, new;

      j = 0;
      for (n = (GN*) g->nodes.first;
           n != NULL;
           n = (GN*) n->base.next) {

          ASSERT_BOUNDS(j, lc-1);
          he = Tcl_CreateHashEntry (&cn, (char*) n, &new);
          lv [j] = n->base.name;
          Tcl_SetHashValue (he, (ClientData) j);
          j += 3;
      }
      lc = j + 1;
    }

    empty = Tcl_NewObj ();
    Tcl_IncrRefCount (empty);

    /* Fill in the arcs, attributes per node, and graph attributes */

    for (k=0; k < lc-1; k++) {
      ASSERT_BOUNDS(k, lc-1);
      n = gn_get_node (g, lv[k], NULL, NULL);
      k ++;

      ASSERT_BOUNDS(k, lc-1);
      lv [k] = g_attr_serial (n->base.attr, empty);
      k ++;

      ASSERT_BOUNDS(k, lc-1);
      lv [k] = gn_serial_arcs (n, empty, &cn);
    }

    ASSERT_BOUNDS(k, lc);
    lv [k] = g_attr_serial (g->attr, empty);

    /* Put everything together, release scratch space */

    ser = Tcl_NewListObj (lc, lv);

    Tcl_DecrRefCount (empty);
    Tcl_DeleteHashTable(&cn);
    ckfree ((char*) lv);

    return ser;

 abort:
    Tcl_DeleteHashTable(&cn);
    ckfree ((char*) lv);
    return NULL;
}


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

int
g_deserialize (G* dst, Tcl_Interp* interp, Tcl_Obj* src)
{
    /*
     * SV   = { NODE ATTR/node ARCS ... ATTR/graph }
     *
     * using:
     *            ATTR/x = { key value ... }
     *            ARCS   = { { NAME targetNODEref ATTR/arc } ... }
     *
     * Basic checks:
     * - Is the input a list ?
     * - Is its length a multiple of three modulo 1 ?
     */

    int           lc, i, j, k;
    Tcl_Obj** lv;
    int           ac;
    Tcl_Obj** av;
    int           axc, nref;
    Tcl_Obj** axv;
    int           nodes;
    G*        new;
    GN*       n;
    GN*       ndst;
    GA*       a;
    int       code = TCL_ERROR;

    if (Tcl_ListObjGetElements (interp, src, &lc, &lv) != TCL_OK) {
      return TCL_ERROR;
    }
    if ((lc % 3) != 1) {
      Tcl_AppendResult (interp,
                    "error in serialization: list length not 1 mod 3.",
                    NULL);
      return TCL_ERROR;
    }

    nodes = (lc-1)/3;

    /* Iteration 1. Check the overall structure of the incoming value (node
     * attributes, arcs, arc attributes, graph attributes).
     */

    if (!g_attr_serok (interp, lv[lc-1], "graph")) {
      return TCL_ERROR;
    }

    for (i=0; i < (lc-1); ) {
      /* Skip node name */
      ASSERT_BOUNDS (i, lc-1);
      i ++ ;
      /* Check node attributes */
      if (!g_attr_serok (interp, lv[i], "node")) {
          return TCL_ERROR;
      }
      /* Go to the arc information block for the node */
      ASSERT_BOUNDS (i, lc-1);
      i ++;
      /* Check arc information */
      if (Tcl_ListObjGetElements (interp, lv[i], &ac, &av) != TCL_OK) {
          return TCL_ERROR;
      }
      for (k=0; k < ac; k++) {
          ASSERT_BOUNDS (k, ac);
          /* Check each arc */
          if (Tcl_ListObjGetElements (interp, av[k], &axc, &axv) != TCL_OK) {
            return TCL_ERROR;
          }
          if (axc != 3) {
            Tcl_AppendResult (interp,
                          "error in serialization: arc information length not 3.",
                          NULL);
            return TCL_ERROR;
          }
          /* Check arc attributes */
          if (!g_attr_serok (interp, axv[2], "arc")) {
            return TCL_ERROR;
          }
          /* Check node reference for arc destination */
          if ((Tcl_GetIntFromObj (interp, axv[1], &nref) != TCL_OK) ||
            (nref % 3) || (nref < 0) || (nref >= lc)) {
            Tcl_ResetResult (interp);
            Tcl_AppendResult (interp,
                          "error in serialization: bad arc destination reference \"",
                          Tcl_GetString (axv[1]),
                          "\".", NULL);
            return TCL_ERROR;
          }
      }
      /* Go to the next node */
      ASSERT_BOUNDS (i, lc-1);
      i ++;
    }

    /* We now know that the value is structurally sound, i.e. lists, of the
     * specified lengths, fixed, and proper multiples, and that references are
     * kept inside to the proper locations. We can now go over the information
     * again and use it to build up a graph. At that time we can also do the
     * more complex semantic checks (dup nodes, dup arcs).
     *
     * The information is collected directly into a graph structure. We have
     * no better place where to put it. In case of problems we can tear it
     * down again easily, and otherwise we can swap with the actual graph and
     * then tear that one down, effectively replacing it with the new graph.
     */

    new = g_new ();

    /* I. Import the nodes */

    for (i=0; i < (lc-1); i += 3) {
      ASSERT_BOUNDS (i, lc-1);
      n = gn_get_node (new, lv[i], NULL, NULL);
      if (n) {
          Tcl_AppendResult (interp, 
                        "error in serialization: duplicate node names.",
                        NULL);
          goto done;
      }
      gn_new (new, Tcl_GetString (lv [i]));
    }

    /* II. Import the arcs */

    for (i=2; i < (lc-1); i += 3) {
      ASSERT_BOUNDS (i, lc-1);
      n = gn_get_node (new, lv[i-2], NULL, NULL);
      Tcl_ListObjGetElements (interp, lv[i], &ac, &av);

      for (k=0; k < ac; k++) {
          ASSERT_BOUNDS (k, ac);
          Tcl_ListObjGetElements (interp, av[k], &axc, &axv);
          a = ga_get_arc (new, axv[0], NULL, NULL);
          if (a) {
            Tcl_AppendResult (interp, 
                          "error in serialization: duplicate definition of arc \"",
                          Tcl_GetString (axv[0]),"\".", NULL);
            goto done;
          }
          Tcl_GetIntFromObj (interp, axv[1], &nref);
          ndst = gn_get_node (new, lv[nref], NULL, NULL);
          ga_new (new, Tcl_GetString (axv[0]), n, ndst);
      }
    }

    /* III. Import the various attributes */

    for (i=0; i < (lc-1); ) {
      ASSERT_BOUNDS (i, lc-1);
      n = gn_get_node (new, lv[i], NULL, NULL);
      /* Goto node attributes */
      i ++ ;
      /* Import node attributes */
      ASSERT_BOUNDS (i, lc-1);
      g_attr_deserial (&n->base.attr, lv[i]);
      /* Go to the arc information block for the node */
      ASSERT_BOUNDS (i, lc-1);
      i ++;
      /* Check arc information */
      Tcl_ListObjGetElements (interp, lv[i], &ac, &av);
      for (k=0; k < ac; k++) {
          ASSERT_BOUNDS (k, ac);
          Tcl_ListObjGetElements (interp, av[k], &axc, &axv);
          a = ga_get_arc (new, axv[0], NULL, NULL);
          g_attr_deserial (&a->base.attr, axv[2]);
      }
      /* Go to the next node */
      ASSERT_BOUNDS (i, lc-1);
      i ++;
    }

    g_attr_deserial (&new->attr, lv[lc-1]);

    /* swap dst <-> new. This puts the collected information into the graph
     * associated with the command, and the old information is put into the
     * scratch structure scheduled for destruction, making cleanup automatic.
     */

    swap (dst, new);
    code = TCL_OK;

 done:
    g_delete (new);
    return code;
}

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

int
g_assign (G* dst, G* src)
{
    G* new = dup (src);
    swap (dst, new);
    g_delete (new);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * g_ms_assign --
 *
 *    Copies the argument graph over into this one. Uses direct
 *    access to internal data structures for matching graph objects, and
 *    goes through a serialize/deserialize combination otherwise.
 *
 * Results:
 *    A standard Tcl result code.
 *
 * Side effects:
 *    Only internal, memory allocation changes ...
 *
 *---------------------------------------------------------------------------
 */

int
g_ms_assign (Tcl_Interp* interp, G* g, Tcl_Obj* src)
{
    Tcl_CmdInfo srcInfo;

    if (!Tcl_GetCommandInfo(interp, Tcl_GetString (src), &srcInfo)) {
      Tcl_AppendResult (interp, "invalid command name \"",
                    Tcl_GetString (src), "\"", NULL);
      return TCL_ERROR;
    }

    if (srcInfo.objProc == g_objcmd) {
      /* The source graph object is managed by this code also. We can
       * retrieve and copy the data directly.
       */

      G* gsrc = (G*) srcInfo.objClientData;

      return g_assign (g, gsrc);

    } else {
      /* The source graph is not managed by this package. Use
       * (de)serialization to transfer the information We do not invoke the
       * command proc directly
       */

      int    res;
      Tcl_Obj* ser;
      Tcl_Obj* cmd [2];

      /* Phase 1: Obtain a serialization by invoking the relevant object
       * method
       */

      cmd [0] = src;
      cmd [1] = Tcl_NewStringObj ("serialize", -1);

      Tcl_IncrRefCount (cmd [0]);
      Tcl_IncrRefCount (cmd [1]);

      res = Tcl_EvalObjv (interp, 2, cmd, 0);

      Tcl_DecrRefCount (cmd [0]);
      Tcl_DecrRefCount (cmd [1]);

      if (res != TCL_OK) {
          return TCL_ERROR;
      }

      ser = Tcl_GetObjResult (interp);
      Tcl_IncrRefCount (ser);
      Tcl_ResetResult (interp);

      /* Phase 2: Copy the serializtion into ourselves using the regular
       * deserialization functionality
       */

      res = g_deserialize (g, interp, ser);
      Tcl_DecrRefCount (ser);
      return res;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * g_ms_set --
 *
 *    Copies this graph over into the argument graph. Uses direct access to
 *    internal data structures for matching graph objects, and goes through a
 *    serialize/deserialize combination otherwise.
 *
 * Results:
 *    A standard Tcl result code.
 *
 * Side effects:
 *    Only internal, memory allocation changes ...
 *
 *---------------------------------------------------------------------------
 */

int
g_ms_set (Tcl_Interp* interp, Tcl_Obj* go, G* g, Tcl_Obj* dst)
{
    Tcl_CmdInfo dstInfo;

    if (!Tcl_GetCommandInfo(interp, Tcl_GetString (dst), &dstInfo)) {
      Tcl_AppendResult (interp, "invalid command name \"",
                    Tcl_GetString (dst), "\"", NULL);
      return TCL_ERROR;
    }

    if (dstInfo.objProc == g_objcmd) {
      /* The destination graph object is managed by this code also We can
       * retrieve and copy the data directly.
       */

      G* gdest = (G*) dstInfo.objClientData;

      return g_assign (gdest, g);

    } else {
      /* The destination graph is not managed by this package. Use
       * (de)serialization to transfer the information We do not invoke the
       * command proc directly.
       */

      int    res;
      Tcl_Obj* ser;
      Tcl_Obj* cmd [3];

      /* Phase 1: Obtain our serialization */

      ser = g_ms_serialize (interp, go, g, 0, NULL);

      /* Phase 2: Copy into destination by invoking the regular
       * deserialization method
       */

      cmd [0] = dst;
      cmd [1] = Tcl_NewStringObj ("deserialize", -1);
      cmd [2] = ser;

      Tcl_IncrRefCount (cmd [0]);
      Tcl_IncrRefCount (cmd [1]);
      Tcl_IncrRefCount (cmd [2]);

      res = Tcl_EvalObjv (interp, 3, cmd, 0);

      Tcl_DecrRefCount (cmd [0]);
      Tcl_DecrRefCount (cmd [1]);
      Tcl_DecrRefCount (cmd [2]); /* == ser, is gone now */

      if (res != TCL_OK) {
          return TCL_ERROR;
      }

      Tcl_ResetResult (interp);
      return TCL_OK;
    }
    return TCL_ERROR;
}


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

static void
swap (G* dst, G* src)
{
    GC* c;
    G tmp;

    /* Swap the main information */

    tmp  = *dst;
    *dst = *src;
    *src = tmp;

    /* Swap the cmd right back, because this part of the dst structure has to
     * be kept.
     */

    tmp.cmd  = dst->cmd;
    dst->cmd = src->cmd;
    src->cmd = tmp.cmd;

    /* At last fix the node/arc ownership in both structures, or else g_delete
     * will access and destroy the newly created information, and a future
     * delete of the graph accesses long gone memory.
     */

    for (c = src->nodes.first; c != NULL; c = c->next) {
      c->graph = src;
    }
    for (c = src->arcs.first; c != NULL; c = c->next) {
      c->graph = src;
    }

    for (c = dst->nodes.first; c != NULL; c = c->next) {
      c->graph = dst;
    }
    for (c = dst->arcs.first; c != NULL; c = c->next) {
      c->graph = dst;
    }
}

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

static G*
dup (G* src)
{
    G* new = g_new ();
    GN* no; GN* n;
    GA* ao; GA* a;
    GC* c;

    /* I. Duplicate nodes. NOTE. In the list of odes in src we break the chain
     * of prev references and use that to point from each src node to its
     * duplicate. This is then used during the duplication of arcs (-> II.) to
     * quickly locate the nodes to connect. After that is done the chain can
     * and is restored.
     */
#define ORIG base.prev

    for (no = (GN*) src->nodes.first;
       no != NULL;
       no = (GN*) no->base.next) {

      n = gn_new (new, Tcl_GetString(no->base.name));
      no->ORIG = (GC*) n;
      g_attr_dup (&n->base.attr, no->base.attr);
    }

    /* II. Duplicate the arcs */

    for (ao = (GA*) src->arcs.first;
       ao != NULL;
       ao = (GA*) ao->base.next) {
      a = ga_new (new, Tcl_GetString(ao->base.name),
                (GN*) ao->start->n->ORIG,
                (GN*) ao->end->n->ORIG);
      g_attr_dup (&a->base.attr, ao->base.attr);
    }

#undef ORIG

    /* III. Re-chain the nodes in the original */

    c = src->nodes.first;
    c->prev = NULL;
    c = c->next;

    for (; c != NULL; c = c->next) {
      if (!c->next) break;
      c->next->prev = c;
    }

    g_attr_dup (&new->attr, src->attr);
    return new;
}

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

Generated by  Doxygen 1.6.0   Back to index