compile.c

Go to the documentation of this file.

/*************************************************************************
 * Copyright (c) 2011 AT&T Intellectual Property 
 * All rights reserved. This program and the accompanying materials
 * are made available under the terms of the Eclipse Public License v1.0
 * which accompanies this distribution, and is available at
 * https://www.eclipse.org/legal/epl-v10.html
 *
 * Contributors: Details at https://graphviz.org
 *************************************************************************/
 
 
/*
 *  Compile-time and run-time interface between gvpr and libexpr
 */
 
#include "config.h"
#include <stdlib.h>
#include <stdint.h>
#include <unistd.h>
#include <gvpr/compile.h>
#include <assert.h>
#include <cgraph/agxbuf.h>
#include <cgraph/alloc.h>
#include <cgraph/cgraph.h>
#include <cgraph/exit.h>
#include <cgraph/prisize_t.h>
#include <cgraph/startswith.h>
#include <cgraph/streq.h>
#include <cgraph/unreachable.h>
#include <ast/error.h>
#include <gvpr/actions.h>
#include <inttypes.h>
#include <string.h>
#include <stdbool.h>
#include <stddef.h>
#include <stdint.h>
#include <stdio.h>
#include <math.h>
 
static int isedge(Agobj_t *obj) {
  return AGTYPE(obj) == AGOUTEDGE || AGTYPE(obj) == AGINEDGE;
}
 
#define MIN(a,b)        ((a)<(b)?(a):(b))
#define MAX(a,b)        ((a)>(b)?(a):(b))
 
#include <gvpr/gdefs.h>
 
#include <ctype.h>
#include <gvpr/trie.c>
 
#define BITS_PER_BYTE 8
 
static void *int2ptr(long long i) {
  return (void*)(intptr_t)i;
}
 
static long long ptr2int(const void *p) {
  return (long long)(intptr_t)p;
}
 
static int iofread(void *chan, char *buf, int bufsize)
{
  FILE *fp = chan;
 
  return (int)read(fileno(fp), buf, bufsize);
}
 
static int ioputstr(void *chan, const char *str)
{
  return fputs(str, chan);
}
 
static int ioflush(void *chan)
{
  return fflush(chan);
}
 
static Agiodisc_t gprIoDisc = { iofread, ioputstr, ioflush };
 
#ifdef GVDLL
static Agdisc_t gprDisc = { 0, &gprIoDisc };
#else
static Agdisc_t gprDisc = { &AgIdDisc, &gprIoDisc };
#endif
 
/* nameOf:
 * Return name of object. 
 * Assumes obj !=  NULL
 */
static char *nameOf(Expr_t *ex, Agobj_t *obj, agxbuf *tmps) {
    char *s;
    char *key;
    Agedge_t *e;
 
    switch (AGTYPE(obj)) {
    case AGNODE:
    case AGRAPH:
        s = agnameof(obj);
        break;
    default:                    /* edge */
        e = (Agedge_t *) obj;
        key = agnameof(AGMKOUT(e));
        agxbput(tmps, agnameof(AGTAIL(e)));
        if (agisdirected(agraphof(e)))
            agxbput(tmps, "->");
        else
            agxbput(tmps, "--");
        agxbput(tmps, agnameof(AGHEAD(e)));
        if (key && *key) {
            agxbputc(tmps, '[');
            agxbput(tmps, key);
            agxbputc(tmps, ']');
        }
        s = exstring(ex, agxbuse(tmps));
        break;
    }
    return s;
}
 
/* bbOf:
 * If string as form "x,y,u,v" where is all are numeric,
 * return "x,y" or "u,v", depending on getll, else return ""
 */
static char *bbOf(Expr_t * pgm, char *pt, bool getll)
{
    double x, y, u, v;
    char *s;
    char *p;
 
    if (sscanf(pt, "%lf,%lf,%lf,%lf", &x, &y, &u, &v) == 4) {
        p = strchr(pt, ',');
        p = strchr(p + 1, ',');
        if (getll) {
            size_t len = (size_t)(p - pt);
            s = exstralloc(pgm, len + 1);
            strncpy(s, pt, len);
            s[len] = '\0';
        } else
            s = exstring(pgm, p + 1);
    } else
        s = "";
    return s;
}
 
/* xyOf:
 * If string as form "x,y" where is x and y are numeric,
 * return "x" or "y", depending on getx, else return ""
 */
static char *xyOf(Expr_t * pgm, char *pt, bool getx)
{
    double x, y;
    char *v;
    char *p;
 
    if (sscanf(pt, "%lf,%lf", &x, &y) == 2) {
        p = strchr(pt, ',');
        if (getx) {
            size_t len = (size_t)(p - pt);
            v = exstralloc(pgm, len + 1);
            strncpy(v, pt, len);
            v[len] = '\0';
        } else
            v = exstring(pgm, p + 1);
    } else
        v = "";
    return v;
}
 
/* posOf:
 * Get pos data from node; store x or y into v if successful and return  0;
 * else return -1
 */
static int posOf(Agnode_t* np, int idx, double* v)
{
    static Agraph_t* root;
    static Agsym_t* pos;
    Agraph_t* nroot = agroot(np);
    char* ps;
    double p[2];
 
    if (root != nroot) {
        root = nroot;
        pos = agattr(root, AGNODE, "pos", 0);
    } 
    if (!pos) return -1;
    ps = agxget(np, pos);
    if (sscanf(ps, "%lf,%lf", &p[0], &p[1]) == 2) {
        *v = p[idx];
        return 0;
    }
    else return -1;
    
}
 
#if defined(DEBUG) && DEBUG > 1
static char *symName(Expr_t * ex, int op)
{
    if (op >= MINNAME && op <= MAXNAME)
        return gprnames[op];
    else {
        // calculate how much space we need to construct a name
        int bytes = vsnprintf(NULL, 0, "<unknown (%d)>", op);
        if (bytes < 0) {
                fprintf(stderr, "%s: vsnprintf failure\n", __func__);
                graphviz_exit(EXIT_FAILURE);
        }
 
        // construct a managed buffer to store this name
        char *s = vmalloc(ex->ve, (size_t)bytes + 1);
 
        // make the name
        if (s != NULL) {
                snprintf(s, (size_t)bytes + 1, "<unknown (%d)>", op);
        }
 
        return s;
    }
}
#endif
 
/* xargs:
 * Convert string argument to graph to type of graph desired.
 *   u => undirected
 *   d => directed
 *   s => strict
 *   n => non-strict
 * Case-insensitive
 * By default, the graph is directed, non-strict.
 */
static Agdesc_t xargs(char *args)
{
    Agdesc_t desc = Agdirected;
    char c;
 
    while ((c = *args++)) {
        switch (c) {
        case 'u':
        case 'U':
            desc.directed = false;
            break;
        case 'd':
        case 'D':
            desc.directed = true;
            break;
        case 's':
        case 'S':
            desc.strict = true;
            break;
        case 'n':
        case 'N':
            desc.directed = false;
            break;
        default:
            error(ERROR_WARNING, "unknown graph descriptor '%c' : ignored",
                  c);
            break;
        }
    }
    return desc;
}
 
/* deparse:
 * Recreate string representation of expression involving
 * a reference and a symbol.
 */
static char *deparse(Expr_t *ex, Exnode_t *n, agxbuf *xb) {
  exdump(ex, n, xb);
  return agxbuse(xb);
}
 
/* deref:
 * Evaluate reference to derive desired graph object.
 * A reference is either DI* or II*
 * The parameter objp is the current object.
 * Assume ref is type-correct.
 */
static Agobj_t *deref(Expr_t * pgm, Exnode_t * x, Exref_t * ref,
                      Agobj_t * objp, Gpr_t * state)
{
    void *ptr;
 
    if (ref == 0)
        return objp;
    else if (ref->symbol->lex == DYNAMIC) {
        ptr = int2ptr(x->data.variable.dyna->data.variable.dyna->data.
                    constant.value.integer);
        if (!ptr) {
            agxbuf xb = {0};
            exerror("null reference %s in expression %s.%s",
                  ref->symbol->name, ref->symbol->name, deparse(pgm, x, &xb));
            agxbfree(&xb);
            return ptr;
        } else
            return deref(pgm, x, ref->next, (Agobj_t *) ptr, state);
    } else
        switch (ref->symbol->index) {   /* sym->lex == ID */
        case V_outgraph:
            return deref(pgm, x, ref->next, (Agobj_t *) state->outgraph, state);
        case V_this:
            return deref(pgm, x, ref->next, state->curobj, state);
        case V_thisg:
            return deref(pgm, x, ref->next, (Agobj_t *) state->curgraph, state);
        case V_nextg:
            return deref(pgm, x, ref->next, (Agobj_t *) state->nextgraph, state);
        case V_targt:
            return deref(pgm, x, ref->next, (Agobj_t *) state->target, state);
        case V_travedge:
            return deref(pgm, x, ref->next, (Agobj_t *) state->tvedge, state);
        case V_travroot:
            return deref(pgm, x, ref->next, (Agobj_t *) state->tvroot, state);
        case V_travnext:
            return deref(pgm, x, ref->next, (Agobj_t *) state->tvnext, state);
        case M_head:
            if (!objp && !(objp = state->curobj)) {
                exerror("Current object $ not defined");
                return 0;
            }
            if (isedge(objp))
                return deref(pgm, x, ref->next, (Agobj_t *)AGHEAD((Agedge_t *)objp), state);
            else
                exerror("head of non-edge");
            break;
        case M_tail:
            if (!objp && !(objp = state->curobj)) {
                exerror("Current object $ not defined");
                return 0;
            }
            if (isedge(objp))
                return deref(pgm, x, ref->next, (Agobj_t *)AGTAIL((Agedge_t *)objp), state);
            else
                exerror("tail of non-edge %p", objp);
            break;
        default:
            exerror("%s : illegal reference", ref->symbol->name);
            break;
        }
    return 0;
 
}
 
/* assignable:
 * Check that attribute is not a read-only, pseudo-attribute.
 * fatal if not OK.
 */
static void assignable (Agobj_t *objp, unsigned char* name) {
    unsigned int ch;
    int rv;
    unsigned char* p = name;
 
    TFA_Init();
    while (TFA_State >= 0 && (ch = *p)) {
        TFA_Advance(ch > 127 ? 127 : (char)ch);
        p++;
    }
    rv = TFA_Definition();
    if (rv < 0) return;
 
    switch (AGTYPE(objp)) {
    case AGRAPH :
        if (rv & Y(G))
            exerror("Cannot assign to pseudo-graph attribute %s", name);
        break;
    case AGNODE :
        if (rv & Y(V))
            exerror("Cannot assign to pseudo-node attribute %s", name);
        break;
    default :  /* edge */
        if (rv & Y(E))
            exerror("Cannot assign to pseudo-edge attribute %s", name);
        break;
    }
}
 
/* setattr:
 * Set object's attribute name to val.
 * Initialize attribute if necessary.
 */
static int
setattr (Agobj_t *objp, char* name, char* val)
{
    Agsym_t *gsym = agattrsym(objp, name);
    if (!gsym) {
        gsym = agattr(agroot(agraphof(objp)), AGTYPE(objp), name, "");
    }
    return agxset(objp, gsym, val);
}
 
/* kindToStr:
 */
static char*
kindToStr (int kind)
{
    char* s;
 
    switch (kind) {
    case AGRAPH :
        s = "graph";
        break;
    case AGNODE :
        s = "node";
        break;
    default :
        s = "edge";
        break;
    }
    return s;
}
 
/* kindOf:
 * Return string rep of object's kind
 */
static char*
kindOf (Agobj_t* objp)
{
    return kindToStr (agobjkind (objp));
}
 
/* lookup:
 * Apply symbol to get field value of objp
 * Assume objp != NULL
 */
static int lookup(Expr_t *pgm, Agobj_t *objp, Exid_t *sym, Extype_t * v) {
    if (sym->lex == ID) {
        switch (sym->index) {
        case M_head:
            if (isedge(objp))
                v->integer = ptr2int(AGHEAD((Agedge_t *) objp));
            else {
                error(ERROR_WARNING, "head of non-edge");
                return -1;
            }
            break;
        case M_tail:
            if (isedge(objp))
                v->integer = ptr2int(AGTAIL((Agedge_t *) objp));
            else {
                error(ERROR_WARNING, "tail of non-edge");
                return -1;
            }
            break;
        case M_name: {
            agxbuf tmp = {0};
            v->string = nameOf(pgm, objp, &tmp);
            agxbfree(&tmp);
            break;
        }
        case M_indegree:
            if (AGTYPE(objp) == AGNODE)
                v->integer = agdegree(agroot(objp), (Agnode_t *) objp, 1, 0);
            else {
                exerror("indegree of non-node");
                return -1;
            }
            break;
        case M_outdegree:
            if (AGTYPE(objp) == AGNODE)
                v->integer = agdegree(agroot(objp), (Agnode_t *) objp, 0, 1);
            else {
                exerror("outdegree of non-node");
                return -1;
            }
            break;
        case M_degree:
            if (AGTYPE(objp) == AGNODE)
                v->integer = agdegree(agroot(objp), (Agnode_t *) objp, 1, 1);
            else {
                exerror("degree of non-node");
                return -1;
            }
            break;
        case M_X:
            if (AGTYPE(objp) == AGNODE) {
                if (posOf ((Agnode_t *) objp, 0, &v->floating))
                    exerror("no x coordinate for node \"%s\"", agnameof(objp));
            } else {
                exerror("x coordinate of non-node");
                return -1;
            }
            break;
        case M_Y:
            if (AGTYPE(objp) == AGNODE) {
                if (posOf ((Agnode_t *) objp, 1, &v->floating))
                    exerror("no y coordinate for node \"%s\"", agnameof(objp));
            } else {
                exerror("x coordinate of non-node");
                return -1;
            }
            break;
        case M_parent:
            if (AGTYPE(objp) == AGRAPH)
                v->integer = ptr2int(agparent((Agraph_t *) objp));
            else {
                exerror("parent of non-graph");
                return -1;
            }
            break;
        case M_root:
            v->integer = ptr2int(agroot(agraphof(objp)));
            break;
        case M_n_edges:
            if (AGTYPE(objp) == AGRAPH)
                v->integer = agnedges((Agraph_t *) objp);
            else {
                exerror("n_edges of non-graph");
                return -1;
            }
            break;
        case M_n_nodes:
            if (AGTYPE(objp) == AGRAPH)
                v->integer = agnnodes((Agraph_t *) objp);
            else {
                exerror("n_nodes of non-graph");
                return -1;
            }
            break;
        case M_directed:
            if (AGTYPE(objp) == AGRAPH)
                v->integer = agisdirected((Agraph_t *) objp);
            else {
                exerror("directed of non-graph");
                return -1;
            }
            break;
        case M_strict:
            if (AGTYPE(objp) == AGRAPH)
                v->integer = agisstrict((Agraph_t *) objp);
            else {
                exerror("strict of non-graph");
                return -1;
            }
            break;
        default:
            error(ERROR_WARNING, "%s : illegal reference", sym->name);
            return -1;
            break;
        }
    } else {
        Agsym_t *gsym = agattrsym(objp, sym->name);
        if (!gsym) {
            gsym = agattr(agroot(agraphof(objp)), AGTYPE(objp), sym->name, "");
            agxbuf tmp = {0};
            error(ERROR_WARNING,
                  "Using value of uninitialized %s attribute \"%s\" of \"%s\"",
                  kindOf (objp), sym->name, nameOf(pgm, objp, &tmp));
            agxbfree(&tmp);
        }
        v->string = agxget(objp, gsym);
    }
 
    return 0;
}
 
/* getArg:
 * Return value associated with $n.
 */
static char *getArg(int n, Gpr_t * state)
{
    if (n >= state->argc) {
        exerror("program references ARGV[%d] - undefined", n);
        return 0;
    }
    return (state->argv[n]);
}
 
/* setDfltAttr:
 */
static int
setDfltAttr (Agraph_t *gp, char* k, char* name, char* value)
{
    int kind;
 
    switch (*k) {
    case 'G' :
        kind = AGRAPH;
        break;
    case 'E' :
        kind = AGEDGE;
        break;
    case 'N' :
        kind = AGNODE;
        break;
    default :
        error(ERROR_WARNING, "Unknown kind \"%s\" passed to setDflt()", k);
        return 1;
        break;
    }
    agattr(gp, kind, name, value);
    return 0;
}
 
/* toKind:
 * Map string to object kind
 */
static int
toKind (char* k, char* fn)
{
    int      kind;
 
    switch (*k) {
    case 'G' :
        kind = AGRAPH;
        break;
    case 'E' :
        kind = AGEDGE;
        break;
    case 'N' :
        kind = AGNODE;
        break;
    default :
        exerror("Unknown kind \"%s\" passed to %s()", k, fn);
        kind = 0;
        break;
    }
    return kind;
}
 
/* nxtAttr:
 */
static char*
nxtAttr (Agraph_t *gp, char* k, char* name)
{
    char* fn = (name ? "nxtAttr" : "fstAttr");
    int kind = toKind (k, fn);
    Agsym_t* sym;
 
    if (name) {
        sym = agattr (gp, kind, name, 0);
        if (!sym) {
            exerror("Third argument \"%s\" in nxtAttr() must be the name of an existing attribute", name); 
            return "";
        }
        
    }
    else sym = NULL;
    
    sym = agnxtattr (gp, kind, sym);
    if (sym) return sym->name; 
    else return "";
}
 
/* getDfltAttr:
 */
static char*
getDfltAttr (Agraph_t *gp, char* k, char* name)
{
    int kind = toKind (k, "getDflt");
    Agsym_t* sym = agattr (gp, kind, name, 0);
    if (!sym) {
        sym = agattr(gp, kind, name, "");
        error(ERROR_WARNING, "Uninitialized %s attribute \"%s\" in %s", 
            kindToStr (kind), name, "getDflt");
    }
    return sym->defval; 
}
 
/* getval:
 * Return value associated with gpr identifier.
 */
static Extype_t
getval(Expr_t * pgm, Exnode_t * node, Exid_t * sym, Exref_t * ref,
       void *env, int elt, Exdisc_t * disc)
{
    Extype_t v;
    Gpr_t *state;
    Extype_t *args;
    Agobj_t *objp;
    Agobj_t *objp1;
    char *key;
    Agraph_t *gp;
    Agnode_t *np;
    Agnode_t *hp;
    Agedge_t *ep;
    gvprbinding* bp;
 
    assert(sym->lex != CONSTANT);
    if (elt == EX_CALL) {
        args = env;
        state = disc->user;
        switch (sym->index) {
        case F_graph:
            gp = openG(args[0].string, xargs(args[1].string));
            v.integer = ptr2int(gp);
            break;
        case F_subg:
            gp = int2ptr(args[0].integer);
            if (gp) {
                gp = openSubg(gp, args[1].string);
                v.integer = ptr2int(gp);
            } else {
                error(ERROR_WARNING, "NULL graph passed to subg()");
                v.integer = 0;
            }
            break;
        case F_issubg:
            gp = int2ptr(args[0].integer);
            if (gp) {
                v.integer = ptr2int(agsubg(gp, args[1].string, 0));
            } else {
                error(ERROR_WARNING, "NULL graph passed to isSubg()");
                v.integer = 0;
            }
            break;
        case F_fstsubg:
            gp = int2ptr(args[0].integer);
            if (gp) {
                gp = agfstsubg(gp);
                v.integer = ptr2int(gp);
            } else {
                error(ERROR_WARNING, "NULL graph passed to fstsubg()");
                v.integer = 0;
            }
            break;
        case F_nxtsubg:
            gp = int2ptr(args[0].integer);
            if (gp) {
                gp = agnxtsubg(gp);
                v.integer = ptr2int(gp);
            } else {
                error(ERROR_WARNING, "NULL graph passed to nxtsubg()");
                v.integer = 0;
            }
            break;
        case F_node:
            gp = int2ptr(args[0].integer);
            if (gp) {
                np = openNode(gp, args[1].string);
                v.integer = ptr2int(np);
            } else {
                error(ERROR_WARNING, "NULL graph passed to node()");
                v.integer = 0;
            }
            break;
        case F_addnode:
            gp = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to addNode()");
                v.integer = 0;
            } else if (!np) {
                error(ERROR_WARNING, "NULL node passed to addNode()");
                v.integer = 0;
            } else
                v.integer = ptr2int(addNode(gp, np, 1));
            break;
        case F_fstnode:
            gp = int2ptr(args[0].integer);
            if (gp) {
                np = agfstnode(gp);
                v.integer = ptr2int(np);
            } else {
                error(ERROR_WARNING, "NULL graph passed to fstnode()");
                v.integer = 0;
            }
            break;
        case F_nxtnode:
            np = int2ptr(args[0].integer);
            if (np) {
                np = agnxtnode(agroot(np), np);
                v.integer = ptr2int(np);
            } else {
                error(ERROR_WARNING, "NULL node passed to nxtnode()");
                v.integer = 0;
            }
            break;
        case F_nxtnodesg:
            gp = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            if (!gp)
                gp = agroot(np);
            if (np) {
                np = agnxtnode(gp, np);
                v.integer = ptr2int(np);
            } else {
                error(ERROR_WARNING, "NULL node passed to nxtnode_sg()");
                v.integer = 0;
            }
            break;
        case F_isnode:
            gp = int2ptr(args[0].integer);
            if (gp) {
                v.integer = ptr2int(agnode(gp, args[1].string, 0));
            } else {
                error(ERROR_WARNING, "NULL graph passed to isNode()");
                v.integer = 0;
            }
            break;
        case F_issubnode:
            gp = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            if (!gp)
                gp = agroot(np);
            if (np) {
                v.integer = ptr2int(addNode(gp, np, 0));
            } else {
                error(ERROR_WARNING, "NULL node passed to isSubnode()");
                v.integer = 0;
            }
            break;
        case F_indegree:
            gp = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            if (!gp)
                gp = agroot(np);
            if (np) {
                v.integer = agdegree(gp, np, 1, 0);
            } else {
                error(ERROR_WARNING, "NULL node passed to indegreeOf()");
                v.integer = 0;
            }
            break;
        case F_outdegree:
            gp = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            if (!gp)
                gp = agroot(np);
            if (np) {
                v.integer = agdegree(gp, np, 0, 1);
            } else {
                error(ERROR_WARNING, "NULL node passed to outdegreeOf()");
                v.integer = 0;
            }
            break;
        case F_degree:
            gp = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            if (!gp)
                gp = agroot(np);
            if (np) {
                v.integer = agdegree(gp, np, 1, 1);
            } else {
                error(ERROR_WARNING, "NULL node passed to degreeOf()");
                v.integer = 0;
            }
            break;
        case F_isin:
            gp = int2ptr(args[0].integer);
            objp = int2ptr(args[1].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to isIn()");
                v.integer = 0;
            } else if (!objp) {
                error(ERROR_WARNING, "NULL object passed to isIn()");
                v.integer = 0;
            } else
                v.integer = agcontains (gp, objp);
            break;
        case F_compof:
            gp = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to compOf()");
                v.integer = 0;
            } else if (!np) {
                error(ERROR_WARNING, "NULL node passed to compOf()");
                v.integer = 0;
            } else
                v.integer = ptr2int(compOf(gp, np));
            break;
        case F_kindof:
            objp = int2ptr(args[0].integer);
            if (!objp) {
                exerror("NULL object passed to kindOf()");
                v.string = 0;
            } else switch (AGTYPE(objp)) {
                case AGRAPH :
                    v.string = "G";
                    break;
                case AGNODE :
                    v.string = "N";
                    break;
                case AGINEDGE :
                case AGOUTEDGE :
                    v.string = "E";
                    break;
                default:
                    UNREACHABLE();
            }
            break;
        case F_edge:
            key = args[2].string;
            if (*key == '\0')
                key = 0;
            np = int2ptr(args[0].integer);
            hp = int2ptr(args[1].integer);
            if (!np) {
                error(ERROR_WARNING, "NULL tail node passed to edge()");
                v.integer = 0;
            } else if (!hp) {
                error(ERROR_WARNING, "NULL head node passed to edge()");
                v.integer = 0;
            } else {
                ep = openEdge(0, np, hp, key);
                v.integer = ptr2int(ep);
            }
            break;
        case F_edgesg:
            key = args[3].string;
            if (*key == '\0')
                key = 0;
            gp = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            hp = int2ptr(args[2].integer);
            if (!np) {
                error(ERROR_WARNING, "NULL tail node passed to edge_sg()");
                v.integer = 0;
            } else if (!hp) {
                error(ERROR_WARNING, "NULL head node passed to edge_sg()");
                v.integer = 0;
            } else {
                ep = openEdge(gp, np, hp, key);
                v.integer = ptr2int(ep);
            }
            break;
        case F_addedge:
            gp = int2ptr(args[0].integer);
            ep = int2ptr(args[1].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to addEdge()");
                v.integer = 0;
            } else if (!ep) {
                error(ERROR_WARNING, "NULL edge passed to addEdge()");
                v.integer = 0;
            } else
                v.integer = ptr2int(addEdge(gp, ep, 1));
            break;
        case F_opp:
            ep = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            if (!ep) {
                error(ERROR_WARNING, "NULL edge passed to opp()");
                v.integer = 0;
            } else if (!np) {
                error(ERROR_WARNING, "NULL node passed to opp()");
                v.integer = 0;
            } else {
                if (aghead(ep) == np)
                    np = agtail(ep);
                else
                    np = aghead(ep);
                v.integer = ptr2int(np);
            }
            break;
        case F_isedge:
            key = args[2].string;
            if (*key == '\0')
                key = 0;
            np = int2ptr(args[0].integer);
            hp = int2ptr(args[1].integer);
            if (!np) {
                error(ERROR_WARNING, "NULL tail node passed to isEdge()");
                v.integer = 0;
            } else if (!hp) {
                error(ERROR_WARNING, "NULL head node passed to isEdge()");
                v.integer = 0;
            } else
                v.integer = ptr2int(isEdge(agroot(np), np, hp, key));
            break;
        case F_isedgesg:
            key = args[3].string;
            if (*key == '\0')
                key = 0;
            gp = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            hp = int2ptr(args[2].integer);
            if (!gp)
                gp = agroot(np);
            if (!np) {
                error(ERROR_WARNING, "NULL tail node passed to isEdge_sg()");
                v.integer = 0;
            } else if (!hp) {
                error(ERROR_WARNING, "NULL head node passed to isEdge_sg()");
                v.integer = 0;
            } else
                v.integer = ptr2int(isEdge(gp, np, hp, key));
            break;
        case F_issubedge:
            gp = int2ptr(args[0].integer);
            ep = int2ptr(args[1].integer);
            if (!gp)
                gp = agroot(ep);
            if (ep) {
                v.integer = ptr2int(addEdge(gp, ep, 0));
            } else {
                error(ERROR_WARNING, "NULL edge passed to isSubedge()");
                v.integer = 0;
            }
            break;
        case F_fstout:
            np = int2ptr(args[0].integer);
            if (np) {
                ep = agfstout(agroot(np), np);
                v.integer = ptr2int(ep);
            } else {
                error(ERROR_WARNING, "NULL node passed to fstout()");
                v.integer = 0;
            }
            break;
        case F_fstoutsg:
            gp = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            if (!gp)
                gp = agroot(np);
            if (np) {
                ep = agfstout(gp, np);
                v.integer = ptr2int(ep);
            } else {
                error(ERROR_WARNING, "NULL node passed to fstout_sg()");
                v.integer = 0;
            }
            break;
        case F_nxtout:
            ep = int2ptr(args[0].integer);
            if (ep) {
                ep = agnxtout(agroot(ep), ep);
                v.integer = ptr2int(ep);
            } else {
                error(ERROR_WARNING, "NULL edge passed to nxtout()");
                v.integer = 0;
            }
            break;
        case F_nxtoutsg:
            gp = int2ptr(args[0].integer);
            ep = int2ptr(args[1].integer);
            if (!gp)
                gp = agroot(ep);
            if (ep) {
                ep = agnxtout(gp, ep);
                v.integer = ptr2int(ep);
            } else {
                error(ERROR_WARNING, "NULL edge passed to nxtout_sg()");
                v.integer = 0;
            }
            break;
        case F_fstin:
            np = int2ptr(args[0].integer);
            if (np) {
                ep = agfstin(agroot(np), np);
                v.integer = ptr2int(ep);
            } else {
                error(ERROR_WARNING, "NULL node passed to fstin()");
                v.integer = 0;
            }
            break;
        case F_fstinsg:
            gp = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            if (!gp)
                gp = agroot(np);
            if (np) {
                ep = agfstin(gp, np);
                v.integer = ptr2int(ep);
            } else {
                error(ERROR_WARNING, "NULL node passed to fstin_sg()");
                v.integer = 0;
            }
            break;
        case F_nxtin:
            ep = int2ptr(args[0].integer);
            if (ep) {
                ep = agnxtin(agroot(ep), ep);
                v.integer = ptr2int(ep);
            } else {
                error(ERROR_WARNING, "NULL edge passed to nxtin()");
                v.integer = 0;
            }
            break;
        case F_nxtinsg:
            gp = int2ptr(args[0].integer);
            ep = int2ptr(args[1].integer);
            if (!gp)
                gp = agroot(ep);
            if (ep) {
                ep = agnxtin(gp, ep);
                v.integer = ptr2int(ep);
            } else {
                error(ERROR_WARNING, "NULL edge passed to nxtin_sg()");
                v.integer = 0;
            }
            break;
        case F_fstedge:
            np = int2ptr(args[0].integer);
            if (np) {
                ep = agfstedge(agroot(np), np);
                v.integer = ptr2int(ep);
            } else {
                error(ERROR_WARNING, "NULL node passed to fstedge()");
                v.integer = 0;
            }
            break;
        case F_fstedgesg:
            gp = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            if (!gp)
                gp = agroot(np);
            if (np) {
                ep = agfstedge(gp, np);
                v.integer = ptr2int(ep);
            } else {
                error(ERROR_WARNING, "NULL node passed to fstedge_sg()");
                v.integer = 0;
            }
            break;
        case F_nxtedge:
            ep = int2ptr(args[0].integer);
            np = int2ptr(args[1].integer);
            if (!ep) {
                error(ERROR_WARNING, "NULL edge passed to nxtedge()");
                v.integer = 0;
            } else if (!np) {
                error(ERROR_WARNING, "NULL node passed to nxtedge()");
                v.integer = 0;
            } else {
                ep = agnxtedge(agroot(np), ep, np);
                v.integer = ptr2int(ep);
            }
            break;
        case F_nxtedgesg:
            gp = int2ptr(args[0].integer);
            ep = int2ptr(args[1].integer);
            np = int2ptr(args[2].integer);
            if (!gp)
                gp = agroot(np);
            if (!ep) {
                error(ERROR_WARNING, "NULL edge passed to nxtedge_sg()");
                v.integer = 0;
            } else if (!np) {
                error(ERROR_WARNING, "NULL node passed to nxtedge_sg()");
                v.integer = 0;
            } else {
                ep = agnxtedge(gp, ep, np);
                v.integer = ptr2int(ep);
            }
            break;
        case F_copy:
            gp = int2ptr(args[0].integer);
            objp = int2ptr(args[1].integer);
            if (!objp) {
                error(ERROR_WARNING, "NULL object passed to clone()");
                v.integer = 0;
            } else
                v.integer = ptr2int(copy(gp, objp));
            break;
        case F_clone:
            gp = int2ptr(args[0].integer);
            objp = int2ptr(args[1].integer);
            if (!objp) {
                error(ERROR_WARNING, "NULL object passed to clone()");
                v.integer = 0;
            } else
                v.integer = ptr2int(cloneO(gp, objp));
            break;
        case F_cloneG:
            gp = int2ptr(args[0].integer);
            if (gp) {
                gp = cloneG(gp, args[1].string);
                v.integer = ptr2int(gp);
            } else {
                error(ERROR_WARNING, "NULL graph passed to cloneG()");
                v.integer = 0;
            }
            break;
        case F_copya:
            objp = int2ptr(args[0].integer);
            objp1 = int2ptr(args[1].integer);
            if (!(objp && objp1)) {
                error(ERROR_WARNING, "NULL object passed to copyA()");
                v.integer = 0;
            } else
                v.integer = copyAttr(objp, objp1);
            break;
        case F_induce:
            gp = int2ptr(args[0].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to induce()");
                v.integer = 1;
            } else {
                (void)graphviz_node_induce(gp, NULL);
                v.integer = 0;
            }
            break;
        case F_write:
            gp = int2ptr(args[0].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to write()");
                v.integer = 1;
            } else
                v.integer = sfioWrite(gp, state->outFile);
            break;
        case F_writeg:
            gp = int2ptr(args[0].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to writeG()");
                v.integer = 1;
            } else
                v.integer = writeFile(gp, args[1].string);
            break;
        case F_readg:
            gp = readFile(args[0].string);
            v.integer = ptr2int(gp);
            break;
        case F_fwriteg:
            gp = int2ptr(args[0].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to fwriteG()");
                v.integer = 1;
            } else
                v.integer = fwriteFile(pgm, gp, args[1].integer);
            break;
        case F_freadg:
            gp = freadFile(pgm, args[0].integer);
            v.integer = ptr2int(gp);
            break;
        case F_openf:
            v.integer = openFile(pgm, args[0].string, args[1].string);
            break;
        case F_closef:
            v.integer = closeFile(pgm, args[0].integer);
            break;
        case F_readl:
            v.string = readLine(pgm, args[0].integer);
            break;
        case F_isdirect:
            gp = int2ptr(args[0].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to isDirect()");
                v.integer = 0;
            } else {
                v.integer = agisdirected(gp);
            }
            break;
        case F_isstrict:
            gp = int2ptr(args[0].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to isStrict()");
                v.integer = 0;
            } else {
                v.integer = agisstrict(gp);
            }
            break;
        case F_delete:
            gp = int2ptr(args[0].integer);
            objp = int2ptr(args[1].integer);
            if (!objp) {
                error(ERROR_WARNING, "NULL object passed to delete()");
                v.integer = 1;
            } else if (objp == (Agobj_t *) state->curgraph) {
                error(ERROR_WARNING, "cannot delete current graph $G");
                v.integer = 1;
            } else if (objp == (Agobj_t *) state->target) {
                error(ERROR_WARNING, "cannot delete target graph $T");
                v.integer = 1;
            } else if (objp == state->curobj) {
                if (!(v.integer = deleteObj(gp, objp)))
                    state->curobj = NULL;
            } else
                v.integer = deleteObj(gp, objp);
            break;
        case F_lock:
            gp = int2ptr(args[0].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to lock()");
                v.integer = -1;
            } else
                v.integer = lockGraph(gp, args[1].integer);
            break;
        case F_nnodes:
            gp = int2ptr(args[0].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to nNodes()");
                v.integer = 0;
            } else {
                v.integer = agnnodes(gp);
            }
            break;
        case F_nedges:
            gp = int2ptr(args[0].integer);
            if (!gp) {
                error(ERROR_WARNING, "NULL graph passed to nEdges()");
                v.integer = 0;
            } else {
                v.integer = agnedges(gp);
            }
            break;
        case F_atoi:
            v.integer = atoi(args[0].string);
            break;
        case F_atof:
            v.floating = atof(args[0].string);
            break;
        case F_sqrt:
            v.floating = sqrt(args[0].floating);
            break;
        case F_cos:
            v.floating = cos(args[0].floating);
            break;
        case F_sin:
            v.floating = sin(args[0].floating);
            break;
        case F_atan2:
            v.floating = atan2(args[0].floating, args[1].floating);
            break;
        case F_exp:
            v.floating = exp(args[0].floating);
            break;
        case F_pow:
            v.floating = pow(args[0].floating, args[1].floating);
            break;
        case F_log:
            v.floating = log(args[0].floating);
            break;
        case F_min:
            v.floating = MIN(args[0].floating, args[1].floating);
            break;
        case F_max:
            v.floating = MAX(args[0].floating, args[1].floating);
            break;
        case F_sys:
            v.integer = system(args[0].string);
            break;
        case F_hasattr:
        case F_get: {
            objp = int2ptr(args[0].integer);
            char *name = args[1].string;
            if (!objp) {
                exerror("NULL object passed to aget()/hasAttr()");
                v.integer = 0;
            } else if (!name) {
                exerror("NULL name passed to aget()/hasAttr()");
                v.integer = 0;
            }
            else {
                Agsym_t *gsym = agattrsym(objp, name);
                if (sym->index == F_hasattr)
                    v.integer = (gsym != NULL);
                else {
                    if (!gsym) {
                        gsym = agattr(agroot(agraphof(objp)), AGTYPE(objp), name, "");
                        agxbuf tmp = {0};
                        error(ERROR_WARNING,
                              "Using value of %s uninitialized attribute \"%s\" of \"%s\" in aget()",
                              kindOf (objp), name, nameOf(pgm, objp, &tmp));
                        agxbfree(&tmp);
                    }
                    v.string = agxget(objp, gsym);
                }
            }
            break;
        }
        case F_set:
            objp = int2ptr(args[0].integer);
            if (!objp) {
                error(ERROR_WARNING, "NULL object passed to aset()");
                v.integer = 1;
            } else {
                char* name = args[1].string;
                char* value = args[2].string;
                if (!name) {
                    error(ERROR_WARNING, "NULL name passed to aset()");
                    v.integer = 1;
                }
                else if (!value) {
                    error(ERROR_WARNING, "NULL value passed to aset()");
                    v.integer = 1;
                }
                else {
                    v.integer = setattr(objp, name, value);
                }
            }
            break;
        case F_dset:
            gp = int2ptr(args[0].integer);
            if (gp) {
                char* kind = args[1].string;
                char* name = args[2].string;
                char* value = args[3].string;
                if (!name) {
                    error(ERROR_WARNING, "NULL name passed to setDflt()");
                    v.integer = 1;
                }
                else if (!value) {
                    error(ERROR_WARNING, "NULL value passed to setDflt()");
                    v.integer = 1;
                }
                else if (!kind) {
                    error(ERROR_WARNING, "NULL kind passed to setDflt()");
                    v.integer = 1;
                }
                else {
                    v.integer = setDfltAttr(gp, kind, name, value);
                }
            } else {
                error(ERROR_WARNING, "NULL graph passed to node()");
                v.integer = 0;
            }
            break;
        case F_fstattr:
            gp = int2ptr(args[0].integer);
            if (gp) {
                char* kind = args[1].string;
                if (!kind) {
                    error(ERROR_ERROR,"NULL kind passed to fstAttr()");
                    v.string = 0;
                }
                else {
                    v.string = nxtAttr (gp, kind, NULL);
                }
            } else {
                exerror("NULL graph passed to fstAttr()");
                v.string = 0;
            }
            break;
        case F_nxtattr:
        case F_isattr:
        case F_dget:
            gp = int2ptr(args[0].integer);
            if (gp) {
                char* kind = args[1].string;
                char* name = args[2].string;
                if (!name) {
                    exerror("NULL name passed to %s", sym->name);
                    v.string = 0;
                }
                else if (!kind) {
                    exerror("NULL kind passed to %s", sym->name);
                    v.string = 0;
                }
                else if (sym->index == F_isattr) {
                    v.integer = (agattr(gp, toKind (kind, sym->name), name, 0) != NULL);
                }
                else if (sym->index == F_nxtattr) {
                    v.string = nxtAttr (gp, kind, name);
                }
                else {
                    v.string = getDfltAttr(gp, kind, name);
                }
            } else {
                exerror("NULL graph passed to %s", sym->name);
                v.string = 0;
            }
            break;
        case F_canon:
            v.string = canon(pgm, args[0].string);
            break;
        case F_ishtml:
            v.integer = aghtmlstr(args[0].string);
            break;
        case F_html:
            gp = int2ptr(args[0].integer);
            if (gp) {
                v.string = toHtml(gp, args[1].string);
            } else {
                error(ERROR_WARNING, "NULL graph passed to html()");
                v.string = 0;
            }
            break;
        case F_tolower:
            v.string = toLower(pgm, args[0].string);
            break;
        case F_colorx:
            v.string = colorx(pgm, args[0].string, args[1].string);
            break;
        case F_strcmp:
            if (args[0].string) {
                if (args[1].string)
                    v.integer = strcmp(args[0].string,args[1].string);
                else
                    v.integer = -1; 
            } else if (args[1].string)
                v.integer = 1; 
            else
                v.integer = 0; 
            break;
        case F_toupper:
            v.string = toUpper(pgm, args[0].string);
            break;
        case F_xof:
            v.string = xyOf(pgm, args[0].string, true);
            break;
        case F_yof:
            v.string = xyOf(pgm, args[0].string, false);
            break;
        case F_llof:
            v.string = bbOf(pgm, args[0].string, true);
            break;
        case F_urof:
            v.string = bbOf(pgm, args[0].string, false);
            break;
        case F_length:
            v.integer = strlen(args[0].string);
            break;
        case F_index:
            v.integer = indexOf(args[0].string, args[1].string);
            break;
        case F_rindex:
            v.integer = rindexOf(args[0].string, args[1].string);
            break;
        case F_match: {
            const size_t m = match(args[0].string, args[1].string);
            if (m == SIZE_MAX) {
                v.integer = -1;
            } else {
                v.integer = (long long)m;
            }
            break;
        }
        case F_call:
            if ((bp = findBinding (state, args[0].string)))
                v.integer = (bp->fn)(args[1].string);
            else
                v.integer = -1;
            break;
        default:
                v.integer = -1;
            exerror("unknown function call: %s", sym->name);
        }
        return v;
    } else if (elt == EX_ARRAY) {
        args = env;
        state = disc->user;
        switch (sym->index) {
        case A_ARGV:
            v.string = getArg(args[0].integer, state);
            break;
        default:
            exerror("unknown array name: %s", sym->name);
            v.string = 0;
        }
        return v;
    }
 
    state = env;
    if (ref) {
        objp = deref(pgm, node, ref, 0, state);
        if (!objp) {
            agxbuf xb = {0};
            exerror("null reference in expression %s", deparse(pgm, node, &xb));
            agxbfree(&xb);
        }
    } else if (sym->lex == ID && sym->index <= LAST_V) {
        switch (sym->index) {
        case V_this:
            v.integer = ptr2int(state->curobj);
            break;
        case V_thisg:
            v.integer = ptr2int(state->curgraph);
            break;
        case V_nextg:
            v.integer = ptr2int(state->nextgraph);
            break;
        case V_targt:
            v.integer = ptr2int(state->target);
            break;
        case V_outgraph:
            v.integer = ptr2int(state->outgraph);
            break;
        case V_tgtname:
            v.string = state->tgtname;
            break;
        case V_infname:
            v.string = state->infname;
            break;
        case V_ARGC:
            v.integer = state->argc;
            break;
        case V_travtype:
            v.integer = state->tvt;
            break;
        case V_travroot:
            v.integer = ptr2int(state->tvroot);
            break;
        case V_travnext:
            v.integer = ptr2int(state->tvnext);
            break;
        case V_travedge:
            v.integer = ptr2int(state->tvedge);
            break;
        }
        return v;
    } else {
        objp = state->curobj;
        if (!objp) {
            agxbuf xb = {0};
            exerror("current object $ not defined as reference for %s",
                  deparse(pgm, node, &xb));
            agxbfree(&xb);
        }
    }
 
    if (objp) {
        if (lookup(pgm, objp, sym, &v)) {
            agxbuf xb = {0};
            exerror("in expression %s", deparse(pgm, node, &xb));
            agxbfree(&xb);
            v.integer = 0;
        }
    }
    else
        v.integer = 0;
 
    return v;
}
 
#define MINTYPE (LAST_M+1)      /* First type occurs after last M_ */
 
static char *typeName(long op) {
    return typenames[op - MINTYPE];
}
 
/* setval:
 * Set sym to value v.
 * Return -1 if not allowed.
 * Assume already type correct.
 */
static int
setval(Expr_t * pgm, Exnode_t * x, Exid_t * sym, Exref_t * ref,
       void *env, Extype_t v)
{
    Gpr_t *state;
    Agobj_t *objp;
    Agnode_t *np;
    int rv = 0;
 
    state = env;
    if (ref) {
        objp = deref(pgm, x, ref, 0, state);
        if (!objp) {
            agxbuf xb = {0};
            exerror("in expression %s.%s", ref->symbol->name, deparse(pgm, x, &xb));
            agxbfree(&xb);
            return -1;
        }
    } else if (MINNAME <= sym->index && sym->index <= MAXNAME) {
        switch (sym->index) {
        case V_outgraph:
            state->outgraph = int2ptr(v.integer);
            break;
        case V_travtype: {
            long long iv = v.integer;
            if (validTVT(v.integer))
                state->tvt = (trav_type) iv;
            else
                error(1, "unexpected value %lld assigned to %s : ignored",
                      iv, typeName(T_tvtyp));
            break;
        }
        case V_travroot:
            np = int2ptr(v.integer);
            if (!np || agroot(np) == state->curgraph)
                state->tvroot = np;
            else {
                error(1, "cannot set $tvroot, node %s not in $G : ignored",
                      agnameof(np));
            }
            break;
        case V_travnext:
            np = int2ptr(v.integer);
            if (!np || agroot(np) == state->curgraph) {
                state->tvnext = np;
                state->flags |= GV_NEXT_SET;
            } else {
                error(1, "cannot set $tvnext, node %s not in $G : ignored",
                      agnameof(np));
            }
            break;
        case V_tgtname:
            free(state->tgtname);
            state->tgtname = strdup(v.string);
            state->name_used = 0;
            break;
        default:
            rv = -1;
            break;
        }
        return rv;
    } else {
        objp = state->curobj;
        if (!objp) {
            agxbuf xb = {0};
            exerror("current object $ undefined in expression %s",
                  deparse(pgm, x, &xb));
            agxbfree(&xb);
            return -1;
        }
    }
    
    assignable (objp, (unsigned char*)sym->name);
    return setattr(objp, sym->name, v.string);
}
 
static int codePhase;
 
#define haveGraph    (1 <= codePhase && codePhase <= 4)
#define haveTarget   (2 <= codePhase && codePhase <= 4)
#define inWalk       (2 <= codePhase && codePhase <= 3)
 
/* typeChk:
 * Type check input type against implied type of symbol sym.
 * If okay, return result type; else return 0.
 * For functions, input type set must intersect with function domain.
 * This means type errors may occur, but these will be caught at runtime.
 * For non-functions, input type must be 0.
 */
static tctype typeChk(tctype intype, Exid_t * sym)
{
    tctype dom = 0, rng = 0;
 
    switch (sym->lex) {
    case DYNAMIC:
        dom = 0;
        switch (sym->type) {
        case T_obj:
            rng = YALL;;
            break;
        case T_node:
            rng = Y(V);
            break;
        case T_graph:
            rng = Y(G);
            break;
        case T_edge:
            rng = Y(E);
            break;
        case INTEGER:
            rng = Y(I);
            break;
        case FLOATING:
            rng = Y(F);
            break;
        case STRING:
            rng = Y(S);
            break;
        default:
            exerror("unknown dynamic type %" PRIdMAX " of symbol %s",
                    (intmax_t)sym->type, sym->name);
            break;
        }
        break;
    case ID:
        if (sym->index <= MAXNAME) {
            switch (sym->index) {
            case V_travroot:
            case V_this:
            case V_thisg:
            case V_nextg:
                if (!haveGraph)
                    exerror
                        ("keyword %s cannot be used in BEGIN/END statements",
                         sym->name);
                break;
            case V_targt:
                if (!haveTarget)
                    exerror
                        ("keyword %s cannot be used in BEGIN/BEG_G/END statements",
                         sym->name);
                break;
            }
            dom = tchk[sym->index][0];
            rng = tchk[sym->index][1];
        } else {
            dom = YALL;
            rng = Y(S);
        }
        break;
    case NAME:
        if (!intype && !haveGraph)
            exerror
                ("undeclared, unmodified names like \"%s\" cannot be\nused in BEGIN and END statements",
                 sym->name);
        dom = YALL;
        rng = Y(S);
        break;
    default:
        exerror("unexpected symbol in typeChk: name %s, lex %" PRIdMAX, sym->name,
                (intmax_t)sym->lex);
        break;
    }
 
    if (dom) {
        if (!intype)
            intype = YALL;      /* type of $ */
        if (!(dom & intype))
            rng = 0;
    } else if (intype)
        rng = 0;
    return rng;
}
 
/* typeChkExp:
 * Type check variable expression.
 */
static tctype typeChkExp(Exref_t * ref, Exid_t * sym)
{
    tctype ty;
 
    if (ref) {
        ty = typeChk(0, ref->symbol);
        for (ref = ref->next; ty && ref; ref = ref->next)
            ty = typeChk(ty, ref->symbol);
        if (!ty)
            return 0;
    } else
        ty = 0;
    return typeChk(ty, sym);
}
 
/* refval:
 * Called during compilation for uses of references:   abc.x
 * Also for abc.f(..),  type abc.v, "abc".x and CONSTANTS.
 * The grammar has been  altered to disallow the first 3.
 * Type check expressions; return value unused.
 */
static Extype_t
refval(Expr_t * pgm, Exnode_t * node, Exid_t * sym, Exref_t * ref)
{
 
    Extype_t v;
    if (sym->lex == CONSTANT) {
        switch (sym->index) {
        case C_flat:
            v.integer = TV_flat;
            break;
        case C_ne:
            v.integer = TV_ne;
            break;
        case C_en:
            v.integer = TV_en;
            break;
        case C_bfs:
            v.integer = TV_bfs;
            break;
        case C_dfs:
            v.integer = TV_dfs;
            break;
        case C_fwd:
            v.integer = TV_fwd;
            break;
        case C_rev:
            v.integer = TV_rev;
            break;
        case C_postdfs:
            v.integer = TV_postdfs;
            break;
        case C_postfwd:
            v.integer = TV_postfwd;
            break;
        case C_postrev:
            v.integer = TV_postrev;
            break;
        case C_prepostdfs:
            v.integer = TV_prepostdfs;
            break;
        case C_prepostfwd:
            v.integer = TV_prepostfwd;
            break;
        case C_prepostrev:
            v.integer = TV_prepostrev;
            break;
        case C_null:
            v.integer = 0;
            break;
        default:
            v = exzero(node->type);
            break;
        }
    } else {
        if (!typeChkExp(ref, sym)) {
            agxbuf xb = {0};
            exerror("type error using %s", deparse(pgm, node, &xb));
            agxbfree(&xb);
        }
        v = exzero(node->type);
    }
    return v;
}
 
/* binary:
 * Evaluate (l ex->op r) producing a value of type ex->type,
 * stored in l.
 * May be unary, with r = NULL
 * Return -1 if operation cannot be done, 0 otherwise.
 * If arg is != 0, operation unnecessary; just report possibility.
 */
static int binary(Exnode_t * l, Exnode_t * ex, Exnode_t * r, int arg) {
    Agobj_t *lobjp;
    Agobj_t *robjp;
    int ret = -1;
 
    if (BUILTIN(l->type))
        return -1;
    if (r && BUILTIN(r->type))
        return -1;
    if (!INTEGRAL(ex->type))
        return -1;
 
    if (l->type == T_tvtyp) {
 
        if (!r)
            return -1;          /* Assume libexpr handled unary */
        if (r->type != T_tvtyp)
            return -1;
 
        long long li = l->data.constant.value.integer;
        long long ri = r->data.constant.value.integer;
        switch (ex->op) {
        case EQ:
            if (arg)
                return 0;
            l->data.constant.value.integer = li == ri;
            ret = 0;
            break;
        case NE:
            if (arg)
                return 0;
            l->data.constant.value.integer = li != ri;
            ret = 0;
            break;
        case '<':
            if (arg)
                return 0;
            l->data.constant.value.integer = li < ri;
            ret = 0;
            break;
        case LE:
            if (arg)
                return 0;
            l->data.constant.value.integer = li <= ri;
            ret = 0;
            break;
        case GE:
            if (arg)
                return 0;
            l->data.constant.value.integer = li >= ri;
            ret = 0;
            break;
        case '>':
            if (arg)
                return 0;
            l->data.constant.value.integer = li > ri;
            ret = 0;
            break;
        }
    }
 
    /* l is a graph object; make sure r is also */
    if (r && r->type == T_tvtyp)
        return -1;
 
    lobjp = int2ptr(l->data.constant.value.integer);
    if (r)
        robjp = int2ptr(r->data.constant.value.integer);
    else
        robjp = 0;
    switch (ex->op) {
    case EQ:
        if (arg)
            return 0;
        l->data.constant.value.integer = !compare(lobjp, robjp);
        ret = 0;
        break;
    case NE:
        if (arg)
            return 0;
        l->data.constant.value.integer = compare(lobjp, robjp);
        ret = 0;
        break;
    case '<':
        if (arg)
            return 0;
        l->data.constant.value.integer = compare(lobjp, robjp) < 0;
        ret = 0;
        break;
    case LE:
        if (arg)
            return 0;
        l->data.constant.value.integer = compare(lobjp, robjp) <= 0;
        ret = 0;
        break;
    case GE:
        if (arg)
            return 0;
        l->data.constant.value.integer = compare(lobjp, robjp) >= 0;
        ret = 0;
        break;
    case '>':
        if (arg)
            return 0;
        l->data.constant.value.integer = compare(lobjp, robjp) > 0;
        ret = 0;
        break;
    }
 
    return ret;
}
 
/* strToTvtype:
 */
static int
strToTvtype (char* s)
{
    int rt = 0;
    char* sfx;
 
    if (startswith(s, "TV_")) {
        sfx = s + 3;
        if (!strcmp(sfx, "flat")) {
            rt = TV_flat;
        } else if (!strcmp(sfx, "ne")) {
            rt = TV_ne;
        } else if (!strcmp(sfx, "en")) {
            rt = TV_en;
        } else if (!strcmp(sfx, "bfs")) {
            rt = TV_bfs;
        } else if (!strcmp(sfx, "dfs")) {
            rt = TV_dfs;
        } else if (!strcmp(sfx, "fwd")) {
            rt = TV_fwd;
        } else if (!strcmp(sfx, "rev")) {
            rt = TV_rev;
        } else if (!strcmp(sfx, "postdfs")) {
            rt = TV_postdfs;
        } else if (!strcmp(sfx, "postfwd")) {
            rt = TV_postfwd;
        } else if (!strcmp(sfx, "postrev")) {
            rt = TV_postrev;
        } else if (!strcmp(sfx, "prepostdfs")) {
            rt = TV_prepostdfs;
        } else if (!strcmp(sfx, "prepostfwd")) {
            rt = TV_prepostfwd;
        } else if (!strcmp(sfx, "prepostrev")) {
            rt = TV_prepostrev;
        } else
            exerror("illegal string \"%s\" for type tvtype_t", s);
    } else
        exerror("illegal string \"%s\" for type tvtype_t", s);
    return rt;
}
 
/* tvtypeToStr:
 */
static char *tvtypeToStr(long long v) {
    char* s = 0;
 
    switch (v) {
    case TV_flat:
        s = "TV_flat";
        break;
    case TV_ne:
        s = "TV_ne";
        break;
    case TV_en:
        s = "TV_en";
        break;
    case TV_bfs:
        s = "TV_bfs";
        break;
    case TV_dfs:
        s = "TV_dfs";
        break;
    case TV_fwd:
        s = "TV_fwd";
        break;
    case TV_rev:
        s = "TV_rev";
        break;
    case TV_postdfs:
        s = "TV_postdfs";
        break;
    case TV_postfwd:
        s = "TV_postfwd";
        break;
    case TV_postrev:
        s = "TV_postrev";
        break;
    case TV_prepostdfs:
        s = "TV_prepostdfs";
        break;
    case TV_prepostfwd:
        s = "TV_prepostfwd";
        break;
    case TV_prepostrev:
        s = "TV_prepostrev";
        break;
    default:
        exerror("Unexpected value %lld for type tvtype_t", v);
        break;
    }
    return s;
}
 
/* stringOf:
 * Convert value x to type string.
 * Assume x does not have a built-in type
 * Return -1 if conversion cannot be done, 0 otherwise.
 * If arg is != 0, conversion unnecessary; just report possibility.
 */
static int stringOf(Expr_t *prog, Exnode_t *x, int arg) {
    Agobj_t *objp;
    int rv = 0;
 
    if (arg)
        return 0;
 
    if (x->type == T_tvtyp) {
        if (!(x->data.constant.value.string = 
            tvtypeToStr (x->data.constant.value.integer)))
            rv = -1;
    } else {
        objp = int2ptr(x->data.constant.value.integer);
        if (!objp) {
            exerror("cannot generate name for NULL %s", typeName(x->type));
            rv = -1;
        }
        else {
            agxbuf tmp = {0};
            x->data.constant.value.string = nameOf(prog, objp, &tmp);
            agxbfree(&tmp);
        }
    }
    x->type = STRING;
    return rv;
}
 
/* convert:
 * Convert value x of type x->type to type type.
 * Return -1 if conversion cannot be done, 0 otherwise.
 * If arg is != 0, conversion unnecessary; just report possibility.
 * In particular, assume x != 0 if arg == 0.
 */
static int convert(Exnode_t *x, long type, int arg) {
    Agobj_t *objp;
    int ret = -1;
 
    /* If both types are built-in, let libexpr handle */
    if (BUILTIN(type) && BUILTIN(x->type))
        return -1;
    if (type == T_obj && x->type <= T_obj)
        ret = 0;                /* trivial cast from specific graph object to T_obj */
    else if (type <= T_obj && x->type == INTEGER) {
        if (x->data.constant.value.integer == 0)
            ret = 0;            /* allow NULL pointer */
    } else if (type == INTEGER) {
        ret = 0;
    } else if (x->type == T_obj) {
        /* check dynamic type */
        if (arg) {
            if (type != FLOATING && type <= T_obj)
                ret = 0;
        } else {
            objp = int2ptr(x->data.constant.value.integer);
            switch (type) {
            case T_graph:
                if (!objp || AGTYPE(objp) == AGRAPH)
                    ret = 0;
                break;
            case T_node:
                if (!objp || AGTYPE(objp) == AGNODE)
                    ret = 0;
                break;
            case T_edge:
                if (!objp || isedge(objp))
                    ret = 0;
                break;
            }
        }
    } else if (type == STRING) {
        if (x->type == T_tvtyp) {
            ret = 0;
            if (!arg) {
                x->data.constant.value.string =
                    tvtypeToStr (x->data.constant.value.integer);
            }
        }
    } else if (type == T_tvtyp && x->type == INTEGER) {
        if (arg)
            ret = 0;
        else if (validTVT(x->data.constant.value.integer))
            ret = 0;
        else
            exerror("Integer value %lld not legal for type tvtype_t",
                    x->data.constant.value.integer);
    }
    /* in case libexpr hands us the trivial case */
    else if (x->type == type) {
        ret = 0;
    } else if (x->type == STRING) {
        char *s;
        if (type == T_tvtyp) {
            if (arg)
                ret = 0;
            else {
                ret = 0;
                s = x->data.constant.value.string;
                x->data.constant.value.integer = strToTvtype(s);
            }
        }
    }
    if (!arg && ret == 0)
        x->type = type;
    return ret;
}
 
/* keyval;
 * Calculate unique key for object.
 * We use this to unify local copies of nodes and edges.
 */
static Extype_t keyval(Extype_t v, long type) {
    if (type <= T_obj) {
        v.integer = AGID(int2ptr(v.integer));
    }
    return v;
}
 
/* a2t:
 * Convert type indices to symbolic name.
 */
static int
 a2t[] = { 0, FLOATING, INTEGER, STRING,
    T_node, T_edge, T_graph, T_obj
};
 
/* initDisc:
 * Create and initialize expr discipline.
 */
static Exdisc_t *initDisc(Gpr_t * state)
{
    Exdisc_t *dp = calloc(1, sizeof(Exdisc_t));
    if (!dp) {
        error(ERROR_ERROR,
              "could not create libexp discipline: out of memory");
        return 0;
    }
 
    dp->version = EX_VERSION;
    dp->flags = EX_CHARSTRING | EX_UNDECLARED;
    dp->symbols = symbols;
    dp->convertf = convert;
    dp->stringof = stringOf;
    dp->binaryf = binary;
    dp->typename = typeName;
    if (state->errf)
        dp->errorf = state->errf;
    else
        dp->errorf = (Exerror_f) errorf;
    dp->keyf = keyval;
    dp->getf = getval;
    dp->reff = refval;
    dp->setf = setval;
    dp->exitf = state->exitf;
    dp->types = a2t;
    dp->user = state;
 
    state->dp = dp;   /* dp is freed when state is freed */
 
    return dp;
}
 
/* compile:
 * Compile given string, then extract and return
 * typed expression.
 */
static Exnode_t *compile(Expr_t * prog, char *src, char *input, int line,
                         const char *lbl, const char *sfx, int kind) {
    Exnode_t *e = 0;
    int rv;
 
    /* create input stream */
    FILE *sf = tmpfile();
    assert(sf != NULL);
    if (input) {
        fputs(input, sf);
    }
    if (sfx) {
        fputs(sfx, sf);
    }
    rewind(sf);
 
    /*  prefixing label if necessary */
    agxbuf label = {0};
    if (lbl) {
        agxbprint(&label, "%s:\n", lbl);
        line--;
    }
 
    if (!src)
        src = "<command line>";
    rv = excomp(prog, src, line, sf, lbl ? agxbdisown(&label) : NULL);
    fclose(sf);
 
    if (rv >= 0 && getErrorErrors() == 0)
        e = exexpr(prog, lbl, NULL, kind);
 
    return e;
}
 
/* checkGuard:
 * Check if guard is an assignment and warn.
 */
static void checkGuard(Exnode_t * gp, char *src, int line)
{
    gp = exnoncast(gp);
    if (gp && exisAssign(gp)) {
        if (src) {
            setErrorFileLine (src, line);
        }
        error(ERROR_WARNING, "assignment used as bool in guard");
    }
}
 
/* mkStmts:
 */
static case_stmt *mkStmts(Expr_t * prog, char *src, case_info * sp,
                          size_t cnt, const char *lbl)
{
    agxbuf tmp = {0};
 
    case_stmt *cs = gv_calloc(cnt, sizeof(case_stmt));
 
    for (size_t i = 0; i < cnt; i++) {
        if (sp->guard) {
            agxbprint(&tmp, "%s_g%" PRISIZE_T, lbl, i);
            cs[i].guard = compile(prog, src, sp->guard, sp->gstart, agxbuse(&tmp), 0,
                                  INTEGER);
            if (getErrorErrors()) break;
            checkGuard(cs[i].guard, src, sp->gstart);
        }
        if (sp->action) {
            agxbprint(&tmp, "%s_a%" PRISIZE_T, lbl, i);
            cs[i].action = compile(prog, src, sp->action, sp->astart, agxbuse(&tmp),
                                   0, INTEGER);
            if (getErrorErrors()) break;
            /* If no error but no compiled action, the input action must
             * have been essentially an empty block, which should be
             * considered different from a missing block. So, compile a
             * trivial block.
             */
            if (!cs[i].action) {
                agxbprint(&tmp, "%s__a%" PRISIZE_T, lbl, i);
                cs[i].action = compile(prog, src, "1", sp->astart, agxbuse(&tmp), 0,
                                       INTEGER);
            }
        }
        sp = sp->next;
    }
    agxbfree(&tmp);
    return cs;
}
 
static int mkBlock(comp_block *bp, Expr_t *prog, char *src, parse_block *inp,
                   size_t i) {
    int rv = 0;
 
    codePhase = 1;
    if (inp->begg_stmt) {
        static const char PREFIX[] = "_begin_g_";
        agxbuf label = {0};
        agxbprint(&label, "%s%" PRISIZE_T, PREFIX, i);
        symbols[0].type = T_graph;
        tchk[V_this][1] = Y(G);
        bp->begg_stmt = compile(prog, src, inp->begg_stmt,
                          inp->l_beging, agxbuse(&label), 0, VOIDTYPE);
        agxbfree(&label);
        if (getErrorErrors())
            goto finishBlk;
        rv |= BEGG;
    }
 
    codePhase = 2;
    if (inp->node_stmts) {
        static const char PREFIX[] = "_nd";
        agxbuf label = {0};
        symbols[0].type = T_node;
        tchk[V_this][1] = Y(V);
        bp->n_nstmts = inp->n_nstmts;
        agxbprint(&label, "%s%" PRISIZE_T, PREFIX, i);
        bp->node_stmts = mkStmts(prog, src, inp->node_stmts, inp->n_nstmts,
                                 agxbuse(&label));
        agxbfree(&label);
        if (getErrorErrors())
            goto finishBlk;
        bp->walks |= WALKSG;
    }
 
    codePhase = 3;
    if (inp->edge_stmts) {
        static const char PREFIX[] = "_eg";
        agxbuf label = {0};
        symbols[0].type = T_edge;
        tchk[V_this][1] = Y(E);
        bp->n_estmts = inp->n_estmts;
        agxbprint(&label, "%s%" PRISIZE_T, PREFIX, i);
        bp->edge_stmts = mkStmts(prog, src, inp->edge_stmts, inp->n_estmts,
                                 agxbuse(&label));
        agxbfree(&label);
        if (getErrorErrors())
            goto finishBlk;
        bp->walks |= WALKSG;
    }
 
    finishBlk:
    if (getErrorErrors()) {
        free (bp->node_stmts);
        free (bp->edge_stmts);
        bp->node_stmts = 0;
        bp->edge_stmts = 0;
    }
 
    return (rv | bp->walks);
}
 
/* doFlags:
 * Convert command line flags to actions in END_G.
 */
static const char *doFlags(int flags) {
  if (flags & SRCOUT) {
    if (flags & INDUCE) {
      return "\n$O = $G;\ninduce($O);\n";
    }
    return "\n$O = $G;\n";
  }
  if (flags & INDUCE) {
    return "\ninduce($O);\n";
  }
  return "\n";
}
 
/* compileProg:
 * Convert gpr sections in libexpr program.
 */
comp_prog *compileProg(parse_prog * inp, Gpr_t * state, int flags)
{
    const char *endg_sfx = NULL;
    int useflags = 0;
 
    /* Make sure we have enough bits for types */
    assert(BITS_PER_BYTE * sizeof(tctype) >= (1 << TBITS));
 
    comp_prog *p = calloc(1, sizeof(comp_prog));
    if (!p) {
        error(ERROR_ERROR,
              "could not create compiled program: out of memory");
        goto finish;
    }
 
    if (flags) {
        endg_sfx = doFlags(flags);
    }
 
    if (!initDisc(state))
        goto finish;
    
    exinit();
    if (!(p->prog = exopen(state->dp)))
        goto finish;
 
    codePhase = 0;
    if (inp->begin_stmt) {
        p->begin_stmt = compile(p->prog, inp->source, inp->begin_stmt,
                                inp->l_begin, 0, 0, VOIDTYPE);
        if (getErrorErrors())
            goto finish;
    }
 
    if (inp->blocks) {
        comp_block* bp;
        parse_block* ibp = inp->blocks;
 
        p->blocks = bp = gv_calloc(inp->n_blocks, sizeof(comp_block));
 
        for (size_t i = 0; i < inp->n_blocks; bp++, i++) {
            useflags |= mkBlock(bp, p->prog, inp->source, ibp, i);
            if (getErrorErrors())
                goto finish;
            else {
                ibp = ibp->next;
                p->n_blocks++;
            }
        }
    }
    p->flags = useflags;
 
    codePhase = 4;
    if (inp->endg_stmt || endg_sfx) {
        symbols[0].type = T_graph;
        tchk[V_this][1] = Y(G);
        p->endg_stmt = compile(p->prog, inp->source, inp->endg_stmt,
                               inp->l_endg, "_end_g", endg_sfx, VOIDTYPE);
        if (getErrorErrors())
            goto finish;
    }
 
    codePhase = 5;
    if (inp->end_stmt) {
        symbols[0].type = T_obj;
        p->end_stmt = compile(p->prog, inp->source, inp->end_stmt,
                              inp->l_end, "_end_", 0, VOIDTYPE);
        if (getErrorErrors())
            goto finish;
    }
    setErrorLine (0); /* execution errors have no line numbers */
 
    if (p->end_stmt)
        p->flags |= ENDG;
 
    finish:
    if (getErrorErrors()) {
        freeCompileProg (p);
        p = 0;
    }
 
    return p;
}
 
void
freeCompileProg (comp_prog *p)
{
    comp_block* bp;
 
    if (!p) return;
 
    exclose (p->prog, 1);
    for (size_t i = 0; i < p->n_blocks; i++) {
        bp = p->blocks + i;
        free (bp->node_stmts);
        free (bp->edge_stmts);
    }
    free (p->blocks);
    free (p);
}
 
/* walksGraph;
 * Returns true if block actually has node or edge statements.
 */
int walksGraph(comp_block * p)
{
    return p->walks;
}
 
/* usesGraph;
 * Returns true if program uses the graph, i.e., has
 * N/E/BEG_G/END_G statments
 */
int usesGraph(comp_prog * p)
{
    return p->flags;
}
 
/* readG:
 * Read graph from file and initialize
 * dynamic data.
 */
Agraph_t *readG(FILE * fp) {
    Agraph_t *g;
 
#ifdef _WIN32
    gprDisc.id = &AgIdDisc;
#endif
    g = agread(fp, &gprDisc);
    if (g) {
        aginit(g, AGRAPH, UDATA, sizeof(gdata), false);
        aginit(g, AGNODE, UDATA, sizeof(ndata), false);
        aginit(g, AGEDGE, UDATA, sizeof(edata), false);
    }
    return g;
}
 
/* openG:
 * Open graph and initialize dynamic data.
 */
Agraph_t *openG(char *name, Agdesc_t desc)
{
    Agraph_t *g;
 
#ifdef _WIN32
    gprDisc.id = &AgIdDisc;
#endif
    g = agopen(name, desc, &gprDisc);
    if (g)
        agbindrec(g, UDATA, sizeof(gdata), false);
    return g;
}
 
/* openSubg:
 * Open subgraph and initialize dynamic data.
 */
Agraph_t *openSubg(Agraph_t * g, char *name)
{
    Agraph_t *sg;
 
    sg = agsubg(g, name, 1);
    if (sg && !aggetrec(sg, UDATA, 0))
        agbindrec(sg, UDATA, sizeof(gdata), false);
    return sg;
}
 
/* openNode:
 * Create node and initialize dynamic data.
 */
Agnode_t *openNode(Agraph_t * g, char *name)
{
    Agnode_t *np;
 
    np = agnode(g, name, 1);
    if (np && !aggetrec(np, UDATA, 0))
        agbindrec(np, UDATA, sizeof(ndata), false);
    return np;
}
 
/* openEdge:
 * Create edge and initialize dynamic data.
 */
Agedge_t *openEdge(Agraph_t* g, Agnode_t * t, Agnode_t * h, char *key)
{
    Agedge_t *ep;
    Agraph_t *root;
 
    root = sameG(t, h, "openEdge", "tail and head nodes");
    if (!root)
        return 0;
    if (g) {
        if (!sameG(g, root, "openEdge", "subgraph and nodes"))
            return 0;
    } else
        g = root;
 
    ep = agedge(g, t, h, key, 1);
    if (ep && !aggetrec(ep, UDATA, 0))
        agbindrec(ep, UDATA, sizeof(edata), false);
    return ep;
}