/*************************************************************************
 * 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/cgraph.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>
#include <util/alloc.h>
#include <util/exit.h>
#include <util/prisize_t.h>
#include <util/startswith.h>
#include <util/unreachable.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_infos_t cases,
                          const char *lbl) {
    agxbuf tmp = {0};

    case_stmt *cs = gv_calloc(case_infos_size(&cases), sizeof(case_stmt));

    for (size_t i = 0; i < case_infos_size(&cases); i++) {
	case_info *sp = case_infos_at(&cases, 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);
	    }
	}
    }
    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 (!case_infos_is_empty(&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 = case_infos_size(&inp->node_stmts);
	agxbprint(&label, "%s%" PRISIZE_T, PREFIX, i);
	bp->node_stmts = mkStmts(prog, src, inp->node_stmts, agxbuse(&label));
	agxbfree(&label);
	if (getErrorErrors())
	    goto finishBlk;
	bp->walks |= WALKSG;
    }

    codePhase = 3;
    if (!case_infos_is_empty(&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 = case_infos_size(&inp->edge_stmts);
	agxbprint(&label, "%s%" PRISIZE_T, PREFIX, i);
	bp->edge_stmts = mkStmts(prog, src, inp->edge_stmts, 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 (!parse_blocks_is_empty(&inp->blocks)) {
	comp_block* bp;

	p->blocks = bp = gv_calloc(parse_blocks_size(&inp->blocks), sizeof(comp_block));

	for (size_t i = 0; i < parse_blocks_size(&inp->blocks); bp++, i++) {
	    parse_block *ibp = parse_blocks_at(&inp->blocks, i);
	    useflags |= mkBlock(bp, p->prog, inp->source, ibp, i);
	    if (getErrorErrors())
		goto finish;
	    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;
}