/***********************************************************************
 *               Copyright (C) 1995 Joe English
 *                   Freely redistributable
 ***********************************************************************
 *
 * assoc.c,v 1.11 1999/07/17 20:43:48 joe Exp
 *
 * Author:	Joe English
 * Created:	23 Mar 95 / 10 Jun 95
 * Description:	Cost 'associations' module.
 * 		Map list of selection queries to set of name/value bindings
 *
 * BUGS:	query list processing could use some optimization.
 *		Add generalized concept of 'parameter sets',
 *		and cache matched association with node;
 * 		how to do this is unclear.
 * 		testing query lists could be optimized
 * 		with the same technique as Haskell/ML-style pattern matching
 */

#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <ctype.h>

#include "tcl.h"
#include "project.h"
#include "strmgt.h"
#include "strmap.h"
#include "esis.h"
#include "costq.h"
#include "tclcost.h"

/*+++ Local definitions:
 */

struct CQAssoc
{
    CostData	*costData;
    int		nassoc;
    CQQuery	*queries;
    strmap	*bindings;
};

/*+++ Associations
 */

void assocDestructor(ClientData closure)
{
    CQAssoc assoc = (CQAssoc)closure;
    int i;
    for (i=0; i<assoc->nassoc; ++i)
    {
	if (assoc->queries[i]) cq_destroyquery(assoc->queries[i]);
	if (assoc->bindings[i]) strmap_destroy(assoc->bindings[i]);
    }
    free(assoc->queries);
    free(assoc->bindings);
    free(assoc);
}

CQAssoc assocConstructor(Tcl_Interp *interp, CostData *cd, char *str)
{
    CQAssoc assoc = NULL;
    char **assocpairs = NULL;
    int nassocpairs;
    int status;
    int i;

    status = Tcl_SplitList(interp, skip_comments(str),
	&nassocpairs, &assocpairs);
    if (status == TCL_ERROR) return 0;

    if (nassocpairs & 1) {
	Tcl_SetErrorCode(interp,"COST","ASSOC","Odd number of assocations",0);
	goto err;
    }

    assoc		= malloc(sizeof(*assoc));
    assoc->costData	= cd;
    assoc->nassoc 	= nassocpairs / 2;
    assoc->queries 	= calloc(sizeof(assoc->queries[0]), assoc->nassoc + 1);
    assoc->bindings 	= calloc(sizeof(assoc->bindings[0]), assoc->nassoc + 1);

    for (i=0; i<assoc->nassoc; ++i)
    {
	char **sublist;
	int sublistlen,j;
	char *errmsg = 0;

	/* First pair: query */
	status = Tcl_SplitList(interp, assocpairs[2*i], &sublistlen, &sublist);
	if (status == TCL_ERROR) goto err;

	assoc->queries[i] = cq_buildquery(sublist, sublistlen, &errmsg);
	Tcl_FreeSplitList(sublist);
	if (!assoc->queries[i]) {
	    Tcl_SetResult(interp, errmsg, TCL_DYNAMIC);
	    goto err;
	}

	/* Second pair: bindings */
	assoc->bindings[i] = strmap_create();
	status = Tcl_SplitList(interp, skip_comments(assocpairs[2*i+1]),
						&sublistlen, &sublist);
	if (status == TCL_ERROR) goto err;

	if (sublistlen % 2 != 0) goto err;
	for (j=0; j < sublistlen; j += 2)
	    strmap_set(assoc->bindings[i], sublist[j], sublist[j+1]);

	Tcl_FreeSplitList(sublist);
    }

    assoc->queries[i] = NULL;
    assoc->bindings[i] = NULL;

    Tcl_FreeSplitList(assocpairs);
    return assoc;

err:
    if (assocpairs) Tcl_FreeSplitList(assocpairs);
    assocDestructor((ClientData)assoc);
    return 0;
}

static char *assocLookup(CQAssoc assoc, ESISNode node, const char *name)
{
    int i;
    for (i=0; i<assoc->nassoc; ++i)
    {
	if (cq_testquery(node, assoc->queries[i])) 
	{
	    char *value = strmap_get(assoc->bindings[i], name);
	    if (value)
		return value;
	}
    }
    return 0;
}

int assocProc(ClientData clientData, Tcl_Interp *interp,
			int argc, char *argv[])
{
    CQAssoc assoc = (CQAssoc)clientData;
    CostData *cd = assoc->costData;
    char *subcmd = argv[1];

    if (argc <= 1) goto usage;
    CHECKCURNODE(cd);

    if (isupper(subcmd[0]))
    { /* Assume it's an event handler/method name -- lookup and execute */
	char *script = assocLookup(assoc, cd->current_node, subcmd);
	if (script)
	    return Tcl_Eval(interp, script);
	/* Calling non-existant handler is a no-op */
	return TCL_OK;
    }
    else if (!strcmp(subcmd,"get"))
    {
	char *retval = 0;
	if (argc < 3 || argc > 4) goto usage;
	retval = assocLookup(assoc, cd->current_node, argv[2]);
	if (!retval) {
	    if (argc >= 4)  {
		retval = argv[3];
	    } else {
		Tcl_AppendResult(interp,
			argv[0], ": no binding for ", argv[2], NULL);
		return TCL_ERROR;
	    }
	}
	Tcl_SetResult(interp, retval, TCL_VOLATILE);
	return TCL_OK;
    }
    else if (!strcmp(subcmd,"has"))
    {
	if (argc != 3) goto usage;
	if (assocLookup(assoc, cd->current_node, argv[2]) != 0)
	    Tcl_SetResult(interp,"1",TCL_STATIC);
	else
	    Tcl_SetResult(interp,"0",TCL_STATIC);
	return TCL_OK;
    }
    else if (!strcmp(subcmd,"do"))
    {
	char *script = 0;
	if (argc != 3 && argc != 4) goto usage;
	script = assocLookup(assoc, cd->current_node, argv[2]);
	if (!script && argc == 4)
	    script = argv[3];
	if (script)
	    return Tcl_Eval(interp, script);
	return TCL_OK;
    }

    /* else -- fallthru to usage */
usage:
    Tcl_AppendResult(interp, "Usage: ",
	argv[0],
	" get name ?default?",
	" | has name ",
	" | do method",	/* don't mention START/END/etc */
	0);

    return TCL_ERROR;
}

/*EOF*/