/* This file is part of Eclat.
   Copyright (C) 2012-2018 Sergey Poznyakoff.
 
   Eclat is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 3, or (at your option)
   any later version.
 
   Eclat is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.
 
   You should have received a copy of the GNU General Public License
   along with Eclat.  If not, see <http://www.gnu.org/licenses/>. */

#include "libeclat.h"
#include <string.h>
#include <setjmp.h>
#include <ctype.h>
#include <sysexits.h>
#include <time.h>
#include "grecs.h"
#include "forlan.h"

struct forlan_eval_env {
	union forlan_node *parse_tree;
	struct forlan_value *vartab;
	struct grecs_node *tree;
	struct grecs_node *last;
	struct grecs_node *top_node;
	struct forlan_value retval;
	union forlan_node *instr;
	int exit_code;
	jmp_buf stop_buf;
	jmp_buf loop_buf;
};

int forlan_dbg = -1;

void
forlan_init()
{
	forlan_dbg = debug_register("forlan");
}

union forlan_node *
forlan_node_create(enum forlan_type type)
{
	union forlan_node *p = grecs_zalloc(sizeof(*p));
	p->type = type;
	return p;
}

static void f_dump_node(FILE *fp, union forlan_node *p, int *num, int lev);

static unsigned long
strtots(const char *input)
{
	struct tm tm;
	
	/* 2012-06-21T10:36:48.000Z */
	memset(&tm, 0, sizeof(tm));
	if (sscanf(input, "%d-%2d-%2dT%2d:%2d:%2d.",
		   &tm.tm_year, &tm.tm_mon, &tm.tm_mday,
		   &tm.tm_hour, &tm.tm_min, &tm.tm_sec) != 6)
		die(EX_DATAERR, "invalid timestamp: %s", input);
	tm.tm_year -= 1900;
	tm.tm_mon--;
	return mktime(&tm);
}

static void
free_value(void *p)
{
	if (p) {
		struct forlan_value *val = p;

		switch (val->type) {
		case forlan_value_void:
		case forlan_value_node:
		case forlan_value_boolean:
			break;
		case forlan_value_literal:
			free(val->v.string);
			break;
		default:
			abort();
		}
		val->type = forlan_value_void;
	}
}

static void
copy_value(struct forlan_value *dst, struct forlan_value *src)
{
	*dst = *src;
	if (dst->type == forlan_value_literal)
		dst->v.string = grecs_strdup(dst->v.string);
}

static char *
valtypestr(enum forlan_value_type t)
{
	switch (t) {
	case forlan_value_void:
		return "void";
	case forlan_value_node:
		return "node";
	case forlan_value_literal:
		return "string";
	case forlan_value_boolean:
		return "boolean";
	default:
		abort();
	}
}

static int
value_boolean(struct forlan_value *val)
{
	int res;
	
	switch (val->type) {
	case forlan_value_void:
		err("controlling expression returned void, aborting");
		abort();

	case forlan_value_node:
		res = val->v.node != NULL;
		break;

	case forlan_value_literal:
		res = val->v.string != NULL && val->v.string[0] != 0;
		break;

	case forlan_value_boolean:
		res = val->v.num;
		break;
		
	default:
		abort();
	}
	return res;
}

int
retval_boolean(forlan_eval_env_t env)
{
	return value_boolean(&env->retval);
}

static void
coerce_value(forlan_eval_env_t env, struct forlan_value *val,
	     enum forlan_value_type t)
{
	struct grecs_node *node;
	
	if (t == val->type)
		return;

	if (t == forlan_value_void) {
		free_value(val);
		val->type = forlan_value_void;
		return;
	}

	if (val->type == forlan_value_void) {
		err("can't coerce %s to %s",
		    valtypestr(val->type),
		    valtypestr(t));
		abort();
	}

	if (t == forlan_value_boolean) {
		int res = value_boolean(val);
		free_value(val);
		val->type = forlan_value_boolean;
		val->v.num = res;
		return;
	}

	/* Convert between string and node */
	switch (val->type) {
	case forlan_value_literal:
		node = grecs_find_node(env->tree, val->v.string);
		free(val->v.string);
		val->v.node = node;
		break;

	case forlan_value_node:
		if (!val->v.node)
			val->v.string = NULL;
		else if (val->v.node->type == grecs_node_stmt) {
			struct grecs_txtacc *acc = grecs_txtacc_create();
			grecs_txtacc_format_value(val->v.node->v.value,
						  0, acc);
			grecs_txtacc_grow_char(acc, 0);
			val->v.string = grecs_txtacc_finish(acc, 1);
			grecs_txtacc_free(acc);
		} else
			val->v.string = grecs_strdup("");
		break;

	default:
		abort();
	}
	val->type = t;
}

static void
coerce_retval(forlan_eval_env_t env, int c)
{
	enum forlan_value_type t;

	switch (c) {
	case 's':
		t = forlan_value_literal;
		break;
	case 'n':
		t = forlan_value_node;
		break;
	case 'b':
		t = forlan_value_boolean;
		break;
	case ' ':
		t = forlan_value_void;
	}
	coerce_value(env, &env->retval, t);
}

#define T_E -1
#define T_V forlan_value_void
#define T_N forlan_value_node
#define T_S forlan_value_literal
#define T_B forlan_value_boolean

enum forlan_value_type convtab[FORLAN_NTYPES][FORLAN_NTYPES] = {
	/*  T_V   T_N   T_S   T_B */	
/* T_V */ { T_E,  T_E,  T_E,  T_E   },
/* T_N */ { T_E,  T_S,  T_S,  T_B   },
/* T_S */ { T_E,  T_S,  T_S,  T_B   },
/* T_B */ { T_E,  T_B,  T_B,  T_B   }
};
	
static int
values_equal(forlan_eval_env_t env,
	     struct forlan_value *a, struct forlan_value *b)
{
	int res;
	enum forlan_value_type t;

	t = convtab[a->type][b->type];
	if (t == T_E) {
		err("incompatible values for comparison: %s, %s",
		    valtypestr(a->type),
		    valtypestr(b->type));
		abort();
	}
	coerce_value(env, a, t);
	coerce_value(env, b, t);

	switch (t) {
	case T_S:
		if (!a->v.string || !b->v.string)
			res = a->v.string == b->v.string;
		else
			res = strcmp(a->v.string, b->v.string) == 0;
		break;
	case T_B:
		res = !!a->v.num == !!b->v.num;
		break;
	default:
		abort();
	}
	return res;
}


void eval_func(forlan_eval_env_t env, union forlan_node *node);
void eval_last(forlan_eval_env_t env, union forlan_node *node);


static void
free_type_null(union forlan_node *p)
{
	warn("freeing undefined forlan_node");
}

void
dump_null(FILE *fp, union forlan_node *p, int *num, int lev)
{
	fprintf(fp, "[undefined node]\n");
}

void
eval_null(forlan_eval_env_t env, union forlan_node *node)
{
	err("stumbled upon an undefined node, aborting");
	abort();
}

static void
free_type_comp(union forlan_node *p)
{
	int i;
	for (i = 0; i < p->comp.argc; i++) {
		free(p->comp.argv[i]);
		if (p->comp.labelv[i]) {
			free_value(p->comp.labelv[i]);
			free(p->comp.labelv[i]);
		}
	}
	free(p->comp.argv);
	free(p->comp.labelv);
}

void
dump_comp(FILE *fp, union forlan_node *p, int *num, int lev)
{
	int i;
	
	fprintf(fp, "COMP");
	if (p->comp.root) {
		fprintf(fp, "\n");
		fprintf(fp, "%04d: %*.*sROOT\n", ++*num, lev, lev, "");
		forlan_dump_node(fp, p->comp.root, num, lev + 1);
		fprintf(fp, "%04d: %*.*sCOMP: ", ++*num, lev, lev, "");
	}
	for (i = 0; i < p->comp.argc; i++) {
		fprintf(fp, ".%s", p->comp.argv[i]);
		if (p->comp.labelv[i]) {
			fprintf(fp, "[%s]", p->comp.labelv[i]->v.string);
		}
	}
	fputc('\n', fp);
}

grecs_match_buf_t 
eval_comp0(forlan_eval_env_t env, union forlan_node *p)
{
	struct grecs_node *root;
	grecs_match_buf_t mb = NULL;
	
	if (p->comp.root) {
		forlan_eval(env, p->comp.root);
		if (!retval_boolean(env))
			return NULL;
		coerce_retval(env, 'n');
		root = env->retval.v.node;
	} else
		root = env->tree;
	if (p->comp.argc) {
		mb = grecs_match_buf_create(p->comp.argc, p->comp.argv,
					    p->comp.labelv);
		if (p->comp.wildcards) {
			root = grecs_match_buf_first(mb, root);
		} else {
			grecs_match_buf_set_root(mb, root);
			if (root->type != grecs_node_root)
				root = root->down;
			grecs_tree_recurse(root, grecs_node_exact_match, mb);
			root = grecs_match_buf_get_node(mb);
		}
	}
	env->retval.type = forlan_value_node;
	env->last = env->retval.v.node = root;
	return mb;
}

void
eval_comp(forlan_eval_env_t env, union forlan_node *p)
{
	free(eval_comp0(env, p));
}

static void
free_type_test(union forlan_node *p)
{
	free(p->test.comp);
	free(p->test.value);
}

void
dump_test(FILE *fp, union forlan_node *p, int *num, int lev)
{
	fprintf(fp, "TEST: %s[%s]\n", p->test.comp, p->test.value);
}

void
eval_test(forlan_eval_env_t env, union forlan_node *node)
{
	err("stumbled upon a lone test node, aborting");
	abort();
}


static void
free_type_func(union forlan_node *p)
{
	grecs_list_free(p->func.args);
}

void
dump_func(FILE *fp, union forlan_node *p, int *num, int lev)
{
	struct grecs_list_entry *ep;
	fprintf(fp, "CALL: %s\n", p->func.fp->name);
	if (p->func.args)
		for (ep = p->func.args->head; ep; ep = ep->next)
			forlan_dump_node(fp, ep->data, num, lev + 1);
}		

void
eval_func(forlan_eval_env_t env, union forlan_node *node)
{
	struct grecs_list *vlist;
	struct grecs_list_entry *ep;
	char *type;
	
	free_value(&env->retval);

	vlist = grecs_list_create();
	vlist->free_entry = free_value;

	type = node->func.fp->argtypes;
	for (ep = node->func.args->head; ep; ep = ep->next) {
		struct forlan_value *val;
		
		forlan_eval(env, ep->data);
		if (*type) 
			coerce_retval(env, *type++);
		val = grecs_malloc(sizeof(*val));
		copy_value(val, &env->retval);
		grecs_list_append(vlist, val);
	}
	
	node->func.fp->func(env, vlist);
	grecs_list_free(vlist);
	env->retval.type = node->func.fp->rettype;
	if (env->retval.type == forlan_value_node)
		env->last = env->retval.v.node;
}


static void
free_type_cond(union forlan_node *p)
{
	forlan_node_free((union forlan_node *)p->cond.expr);
	forlan_node_free(p->cond.iftrue);
	forlan_node_free(p->cond.iffalse);
}

void
dump_cond(FILE *fp, union forlan_node *p, int *num, int lev)
{
	int n = *num;
	fprintf(fp, "COND\n");
	forlan_dump_node(fp, p->cond.expr, num, lev + 1);
	fprintf(fp, "%04d: %*.*sIFTRUE %04d\n", ++*num, lev, lev, "", n);
	forlan_dump_node(fp, p->cond.iftrue, num, lev + 1);
	fprintf(fp, "%04d: %*.*sIFFALSE %04d\n", ++*num, lev, lev, "", n);
	forlan_dump_node(fp, p->cond.iffalse, num, lev + 1);	
}

void
eval_cond(forlan_eval_env_t env, union forlan_node *node)
{
	forlan_eval(env, node->cond.expr);
	if (retval_boolean(env))
		forlan_eval(env, node->cond.iftrue);
	else if (node->cond.iffalse)
		forlan_eval(env, node->cond.iffalse);
}

static void
free_type_stmt(union forlan_node *p)
{
	forlan_node_free(p->stmt.stmt);
	forlan_node_free(p->stmt.next);
}

void
dump_stmt(FILE *fp, union forlan_node *p, int *num, int lev)
{
	f_dump_node(fp, p->stmt.stmt, num, lev);
	forlan_dump_node(fp, p->stmt.next, num, lev);
}

void
eval_stmt(forlan_eval_env_t env, union forlan_node *node)
{
	while (node && node->type == forlan_type_stmt) {
		forlan_eval(env, node->stmt.stmt);
		node = node->stmt.next;
	}
	if (node)
		forlan_eval(env, node);
}

static void
free_type_lit(union forlan_node *p)
{
	free(p->lit.string);
}

void
dump_lit(FILE *fp, union forlan_node *p, int *num, int lev)
{
	fprintf(fp, "LIT: \"%s\"\n", p->lit.string);
}

void
eval_lit(forlan_eval_env_t env, union forlan_node *node)
{
	free_value(&env->retval);
	env->retval.type = forlan_value_literal;
	env->retval.v.string = grecs_strdup(node->lit.string);
}


static void
free_type_expr(union forlan_node *p)
{
	forlan_node_free(p->expr.arg[0]);
	forlan_node_free(p->expr.arg[1]);
}

void
dump_expr(FILE *fp, union forlan_node *p, int *num, int lev)
{
	static char *opstr[] = { "NODE", "AND", "OR", "NOT", "EQ", "NE" };

	fprintf(fp, "%s\n", opstr[p->expr.opcode]);
	forlan_dump_node(fp, p->expr.arg[0], num, lev + 1);
	if (p->expr.arg[1])
		forlan_dump_node(fp, p->expr.arg[1], num, lev + 1);
}

void
eval_expr(forlan_eval_env_t env, union forlan_node *node)
{
	int res;
	struct forlan_value lval;
	
	free_value(&env->retval);
	switch (node->expr.opcode) {
	case forlan_opcode_node:
		forlan_eval(env, node->expr.arg[0]); 
		break;

	case forlan_opcode_and:
		forlan_eval(env, node->expr.arg[0]); 
		if (retval_boolean(env))
			forlan_eval(env, node->expr.arg[1]);
		break;

	case forlan_opcode_or:
		forlan_eval(env, node->expr.arg[0]);
		if (!retval_boolean(env))
			forlan_eval(env, node->expr.arg[1]);
		break;

	case forlan_opcode_not:
		forlan_eval(env, node->expr.arg[0]); 
		res = retval_boolean(env);
		free_value(&env->retval);
		env->retval.type = forlan_value_boolean;
		env->retval.v.num = !res;
		break;

	case forlan_opcode_eq:
	case forlan_opcode_ne:
		forlan_eval(env, node->expr.arg[0]); 
		copy_value(&lval, &env->retval);
		forlan_eval(env, node->expr.arg[1]); 
		res = values_equal(env, &lval, &env->retval);
		free_value(&lval);
		free_value(&env->retval);
		env->retval.type = forlan_value_boolean;
		env->retval.v.num = node->expr.opcode == forlan_opcode_eq ?
			              res : !res;
		break;
		
	default:
		abort();
	}
}

static void
free_type_last(union forlan_node *p)
{
}

void
dump_last(FILE *fp, union forlan_node *p, int *num, int lev)
{
	fprintf(fp, "LAST\n");
}

void
eval_last(forlan_eval_env_t env, union forlan_node *node)
{
	free_value(&env->retval);
	env->retval.type = forlan_value_node;
	env->retval.v.node = env->last;
}

static void
free_type_asgn(union forlan_node *p)
{
	forlan_node_free(p->asgn.node);
}

void
dump_asgn(FILE *fp, union forlan_node *p, int *num, int lev)
{
	fprintf(fp, "ASGN %lu\n", (unsigned long) p->asgn.idx);
	forlan_dump_node(fp, p->asgn.node, num, lev + 1);
}

void
eval_asgn(forlan_eval_env_t env, union forlan_node *p)
{
	forlan_eval(env, p->asgn.node);
	env->vartab[p->asgn.idx] = env->retval;
}

static void
free_type_var(union forlan_node *p)
{
	/* nothing */
}

void
dump_var(FILE *fp, union forlan_node *p, int *num, int lev)
{
	fprintf(fp, "VAR %lu\n", (unsigned long) p->asgn.idx);
	forlan_dump_node(fp, p->loop.node, num, lev + 1);
}

void
eval_var(forlan_eval_env_t env, union forlan_node *p)
{
	free_value(&env->retval);
	copy_value(&env->retval, &env->vartab[p->asgn.idx]);
}

static void
free_type_loop(union forlan_node *p)
{
	forlan_node_free(p->loop.node);
	forlan_node_free(p->loop.stmt);
}

void
dump_loop(FILE *fp, union forlan_node *p, int *num, int lev)
{
	int n = *num;
	fprintf(fp, "LOOP %lu\n", (unsigned long) p->loop.idx);
	fprintf(fp, "%04d: %*.*sEXPR\n", ++*num, lev, lev, "");
	forlan_dump_node(fp, p->loop.node, num, lev + 1);
	fprintf(fp, "%04d: %*.*sSTMT %d\n", ++*num, lev, lev, "", n);
	forlan_dump_node(fp, p->loop.stmt, num, lev + 1);
	fprintf(fp, "%04d: %*.*sEND LOOP %d\n", ++*num, lev, lev, "", n);
}

void
eval_loop(forlan_eval_env_t env, union forlan_node *p)
{
	jmp_buf save;
	grecs_match_buf_t mb;
	struct grecs_node *node;
	
	mb = eval_comp0(env, p->loop.node);
	memcpy(&save, &env->loop_buf, sizeof(save));
	if (setjmp(env->loop_buf) < 2) {
		while (retval_boolean(env)) {
			copy_value(&env->vartab[p->asgn.idx], &env->retval);
			forlan_eval(env, p->loop.stmt);
			node = grecs_match_next(mb);
			env->retval.type = forlan_value_node;
			env->retval.v.node = node;
		}			
	}
	memcpy(&env->loop_buf, &save, sizeof(save));
	free(mb);
}

void
dump_continue(FILE *fp, union forlan_node *p, int *num, int lev)
{
	fprintf(fp, "CONTINUE\n");
}

void
eval_continue(forlan_eval_env_t env, union forlan_node *node)
{
	longjmp(env->loop_buf, 1);
}

void
dump_break(FILE *fp, union forlan_node *p, int *num, int lev)
{
	fprintf(fp, "BREAK\n");
}

void
eval_break(forlan_eval_env_t env, union forlan_node *node)
{
	longjmp(env->loop_buf, 2);
}

void
dump_stop(FILE *fp, union forlan_node *p, int *num, int lev)
{
	fprintf(fp, "STOP\n");
}

void
eval_stop(forlan_eval_env_t env, union forlan_node *node)
{
	longjmp(env->stop_buf, 1);
}


struct forlan_node_method {
	void (*f_free)(union forlan_node *);
	void (*f_dump)(FILE *fp, union forlan_node *node, int *num, int lev);
	void (*f_eval)(forlan_eval_env_t, union forlan_node *node);
};

static struct forlan_node_method f_tab[] = {
	{ free_type_null,  dump_null, eval_null }, /* Unknown/unset type */
	{ free_type_comp,  dump_comp, eval_comp }, /* A path component */  
	{ free_type_test,  dump_test, eval_test }, /* Value test (f[X]) */ 
	{ free_type_func,  dump_func, eval_func }, /* Function call */     
	{ free_type_cond,  dump_cond, eval_cond }, /* Conditional */       
	{ free_type_stmt,  dump_stmt, eval_stmt }, /* Statement */         
	{ free_type_lit,   dump_lit,  eval_lit  }, /* Literal */           
	{ free_type_expr,  dump_expr, eval_expr }, /* Boolean expression */
	{ free_type_last,  dump_last, eval_last }, /* "last" */
	{ free_type_asgn,  dump_asgn, eval_asgn }, /* Variable assignment */
	{ free_type_var,   dump_var,  eval_var  }, /* Variable reference */
	{ free_type_loop,  dump_loop, eval_loop }, /* Loop */
	{ NULL,            dump_continue, eval_continue },  /* continue
							       statement */
	{ NULL,            dump_break, eval_break },        /* break
							       statement */
	{ NULL,            dump_stop,  eval_stop },         /* stop
							       statement */
};

void
forlan_node_free(union forlan_node *p)
{
	if (!p)
		return;
	if (p->type > sizeof(f_tab) / sizeof(f_tab[0]))
		abort();
	if (f_tab[p->type].f_free)
		f_tab[p->type].f_free(p);
	free(p);
}

static void
stmt_list_free_entry(void *p)
{
	forlan_node_free(p);
}

struct grecs_list *
forlan_stmt_list()
{
	struct grecs_list *lp;

	lp = grecs_list_create();
	lp->free_entry = stmt_list_free_entry;
	return lp;
}

union forlan_node *
forlan_stmt_from_list(struct grecs_list *list)
{
	union forlan_node *prev = NULL, *ret = NULL;
	struct grecs_list_entry *ep;

	for (ep = list->head; ep; ep = ep->next) {
		union forlan_node *sp = forlan_node_create(forlan_type_stmt);
		sp->stmt.stmt = ep->data;
		if (prev) {
			prev->stmt.next = sp;
			sp->stmt.prev = prev;
		} else
			ret = sp;
		prev = sp;
	}
	list->free_entry = NULL;
	grecs_list_free(list);
	return ret;
}

static void
f_dump_node(FILE *fp, union forlan_node *p, int *num, int lev)
{
	if (p) {
		if (p->type > sizeof(f_tab) / sizeof(f_tab[0]))
			abort();
		if (f_tab[p->type].f_dump)
			f_tab[p->type].f_dump(fp, p, num, lev);
		else
			fprintf(fp, "type %d", p->type);
	} else
		fprintf(fp, "NULL");
}

void
forlan_dump_node(FILE *fp, union forlan_node *p, int *num, int lev)
{
	if (!p)
		return;
	++*num;
	fprintf(fp, "%04d: %*.*s", *num, lev, lev, "");
	f_dump_node(fp, p, num, lev);
}

void
forlan_dump_tree(FILE *fp, forlan_eval_env_t env)
{
	int n = 0;
	forlan_dump_node(fp, env->parse_tree, &n, 0);
}

void
func_dump(forlan_eval_env_t env, struct grecs_list *list)
{
	struct forlan_value *val = list->head->data;
	if (val->v.node)
		grecs_print_node(val->v.node, GRECS_NODE_FLAG_DEFAULT,
				 stdout);
	fputc('\n', stdout);
}

static void
generic_print(forlan_eval_env_t env, struct grecs_list *list, FILE *fp)
{
	struct grecs_list_entry *ep;
	struct forlan_value *val;

	for (ep = list->head; ep; ep = ep->next) {
		val = ep->data;

		switch (val->type) {
		case forlan_value_void:
			/* skip it */
			break;
		case forlan_value_node:
			if (val->v.node)
				grecs_print_node(val->v.node,
						 GRECS_NODE_FLAG_VALUE, fp);
			break;
		case forlan_value_literal:
			if (val->v.string)
				fwrite(val->v.string, strlen(val->v.string),
				       1, fp);
			break;
		case forlan_value_boolean:
			fprintf(fp, "%d", !!val->v.num);
		}
	}
}

void
func_print(forlan_eval_env_t env, struct grecs_list *list)
{
	generic_print(env, list, stdout);
}

void
func_error(forlan_eval_env_t env, struct grecs_list *list)
{
	generic_print(env, list, stderr);
}

void
func_parent(forlan_eval_env_t env, struct grecs_list *list)
{
	struct forlan_value *val = list->head->data;
	if (val->v.node) {
		env->retval.type = forlan_value_node;
		env->retval.v.node = val->v.node->up;
	}
}

/* Work over a sort of bug in GRECS: there's no way to pass user-defined
   data to the comparator function */
static char *forlan_sort_key;
static int (*forlan_compar)(const char *, const char *);
static int forlan_sort_reverse;

static int
forlan_compar_string(const char *a, const char *b)
{
	return strcmp(a, b);
}

static int
forlan_compar_string_ci(const char *a, const char *b)
{
	return strcasecmp(a, b);
}

static int
forlan_compar_numeric(const char *a, const char *b)
{
	unsigned long na, nb;
	char *p;

	na = strtoul(a, &p, 0);
	if (*p)
		return forlan_compar_string(a, b);
	nb = strtoul(b, &p, 0);
	if (*p)
		return forlan_compar_string(a, b);
	if (na < nb)
		return -1;
	if (na > nb)
		return 1;
	return 0;
}

static int
forlan_compar_timestamp(const char *a, const char *b)
{
	unsigned long na = strtots(a), nb = strtots(b);
	if (na < nb)
		return -1;
	if (na > nb)
		return 1;
	return 0;
}

static int
forlan_node_cmp(struct grecs_node const *a, struct grecs_node const *b)
{
	int rc;
	
	struct grecs_node const *sa, *sb;
	if (!forlan_sort_key)
		rc = strcmp(a->ident, b->ident);
	else {
		sa = grecs_find_node((struct grecs_node *)a, forlan_sort_key);
		sb = grecs_find_node((struct grecs_node *)b, forlan_sort_key);
		if (!sa || !sb || sa->type != grecs_node_stmt ||
		    sb->type != grecs_node_stmt ||
		    sa->v.value->type != GRECS_TYPE_STRING ||
		    sb->v.value->type != GRECS_TYPE_STRING)
			rc = 0;
		else
			rc = forlan_compar(sa->v.value->v.string,
					   sb->v.value->v.string);
	}
	if (forlan_sort_reverse)
		rc = -rc;
	return rc;
}

static void
func_sort(forlan_eval_env_t env, struct grecs_list *list)
{
	struct forlan_value *val = list->head->data;
	struct forlan_value *t;
	struct grecs_list_entry *ep;
	
	if (!val->v.node)
		return;

	forlan_sort_key = NULL;
	forlan_compar = forlan_compar_string;
	forlan_sort_reverse = 0;
	
	if ((ep = list->head->next)) {
		t = ep->data;
		forlan_sort_key = t->v.string;
		if ((ep = ep->next)) {
			char *p;
			
			t = ep->data;
			for (p = t->v.string; *p; p++) {
				switch (*p) {
				case 'n':
					forlan_compar = forlan_compar_numeric;
					break;
				case 'i':
					forlan_compar = forlan_compar_string_ci;
					break;
				case 't':
					forlan_compar = forlan_compar_timestamp;
					break;
				case 's':
					forlan_compar = forlan_compar_string;
					break;
				case 'r':
					forlan_sort_reverse = 1;
					break;
				default:
					/* FIXME: silently ignored */
					break;
				}
			}
		}
	}

	grecs_tree_sort(val->v.node, forlan_node_cmp);
}

static void
func_empty(forlan_eval_env_t env, struct grecs_list *list)
{
	struct forlan_value *val = list->head->data;
	env->retval.v.num = !(val->v.node && val->v.node->down);
}

static void
func_decode(forlan_eval_env_t env, struct grecs_list *list)
{
	struct forlan_value *val = list->head->data;
	struct grecs_txtacc *acc = grecs_txtacc_create();
	char *p;

	for (p = val->v.string; *p; ) {
		size_t ilen, olen;
		unsigned char *optr;
		
		while (*p && isspace(*p))
			p++;
		if (!*p)
			break;
		ilen = strcspn(p, " \t\f\n");
		eclat_base64_decode((unsigned char*) p, ilen, &optr, &olen);
		grecs_txtacc_grow(acc, (char*)optr, olen);
		free(optr);

		p += ilen;
	}
	grecs_txtacc_grow_char(acc, 0);
	env->retval.v.string = grecs_txtacc_finish(acc, 1);
	grecs_txtacc_free(acc);
}

static void
func_dequote(forlan_eval_env_t env, struct grecs_list *list)
{
	struct forlan_value *val = list->head->data;
	char *s = val->v.string;
	size_t l = strlen(s);
	
	if (l >= 2 && s[0] == '"' && s[l-1] == '"') {
		s++;
		l -= 2;
	}
	env->retval.v.string = grecs_malloc(l + 1);
	memcpy(env->retval.v.string, s, l);
	env->retval.v.string[l] = 0;
}

static void
func_exit(forlan_eval_env_t env, struct grecs_list *list)
{
	struct forlan_value *val = list->head->data;
	unsigned long code;
	char *p;
	
	code = strtoul(val->v.string, &p, 10);
	if (*p || code > 255) {
		err("invalid exit code \"%s\", assuming 255",
		    val->v.string);
		code = 255;
	}
	env->exit_code = code;
	longjmp(env->stop_buf, 1);
}	

static void
func_timestamp(forlan_eval_env_t env, struct grecs_list *list)
{
	struct forlan_value *val = list->head->data;
	char *buf = NULL;
	size_t size = 0;
	unsigned long t = strtots(val->v.string);
	grecs_asprintf(&buf, &size, "%lu", (unsigned long)t);
	env->retval.v.string = buf;
}
	
static void
func_lookup(forlan_eval_env_t env, struct grecs_list *list)
{
	struct forlan_value *p;
	const char *key;
	char *mapname;
	struct eclat_map *map;
	int dir;
	char *q;
	
	p = list->head->data;

	dir = eclat_map_name_split(p->v.string, &mapname, &q);
	if (dir == -1)
		die(EX_USAGE, "map %s: bad qualifier  %s", p->v.string, q);

	map = eclat_map_lookup(mapname);
	free(mapname);

	p = list->head->next->data;
	key = p->v.string;

	if (map) {
		if (eclat_map_open(map) == eclat_map_ok &&
		    eclat_map_get(map, dir, key, &env->retval.v.string)
		      == eclat_map_ok)
			return;
	} else
		err("no such map: %s", mapname);
	
	env->retval.v.string = grecs_strdup(key);
}

static void
func_has_map(forlan_eval_env_t env, struct grecs_list *list)
{
	struct forlan_value *p;
	struct eclat_map *map;
	
	p = list->head->data;
	map = eclat_map_lookup(p->v.string);
	env->retval.v.num = map && eclat_map_open(map) == eclat_map_ok;
}

static struct forlan_function functab[] = {
	{ "dump",   forlan_value_void, "n", 1, 1, func_dump },
	{ "print",  forlan_value_void, "", 1, -1, func_print },
	{ "error",  forlan_value_void, "", 1, -1, func_error },
	{ "parent", forlan_value_node, "n", 1, 1, func_parent },
	{ "sort",   forlan_value_void, "nss", 1, 3, func_sort },
	{ "decode", forlan_value_literal, "s", 1, 1, func_decode },
	{ "dequote", forlan_value_literal, "s", 1, 1, func_dequote },
	{ "exit",   forlan_value_void, "s", 1, 1, func_exit },
	{ "empty",  forlan_value_boolean, "n", 1, 1, func_empty },
	{ "timestamp", forlan_value_literal, "s", 1, 1, func_timestamp },
	{ "lookup", forlan_value_literal, "ss", 2, 2, func_lookup },
	{ "has_map",forlan_value_boolean, "s", 1, 1, func_has_map },
	{ NULL }
};

struct forlan_function *
forlan_find_function(const char *name)
{
	struct forlan_function *fp;
	for (fp = functab; fp->name; fp++)
		if (strcmp(name, fp->name) == 0)
			return fp;
	return NULL;
}	

void
forlan_eval(struct forlan_eval_env *env, union forlan_node *p)
{
	if (p->type > sizeof(f_tab) / sizeof(f_tab[0]))
		abort();
	if (f_tab[p->type].f_eval)
		f_tab[p->type].f_eval(env, p);
}

int
forlan_run(forlan_eval_env_t env, struct grecs_node *tree)
{
	env->last = NULL;
	env->top_node = NULL;
	env->retval.type = forlan_value_void;
	env->instr = NULL;
	env->tree = tree;
	if (setjmp(env->stop_buf) == 0)
		forlan_eval(env, env->parse_tree);
	free_value(&env->retval);
	return env->exit_code;
}

forlan_eval_env_t
forlan_create_environment(union forlan_node *parse_tree, size_t varcount)
{
	struct forlan_eval_env *env;
	env = grecs_zalloc(sizeof(*env));
	env->parse_tree = parse_tree;
	env->vartab = grecs_calloc(varcount, sizeof(env->vartab[0]));
	return env;
}

void
forlan_free_environment(forlan_eval_env_t env)
{
	forlan_node_free(env->parse_tree);
	free(env->vartab);
	free(env);
}