Implement loops and variables

* lib/forlan.c: Implement loops and variables.
* lib/forlangrm.y: Likewise.
* lib/forlanlex.l: Likewise.
* lib/forlan.h (forlan_parse): Change return type.
(forlan_type): New types.
(forlan_dump_tree): Change signature.
(forlan_value_type) <forlan_value_boolean>: New type.
* tests/tforlan.c: Update.

5 files changed, 844 insertions, 50 deletions

diff --git a/lib/forlan.c b/lib/forlan.c
index 008ee5b..2f552d1 100644
--- a/lib/forlan.c
+++ b/lib/forlan.c
@@ -15,9 +15,23 @@
    along with Eclat.  If not, see <http://www.gnu.org/licenses/>. */
 
 #include "libeclat.h"
+#include <string.h>
+#include <setjmp.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;
+	jmp_buf stop_buf;
+	jmp_buf loop_buf;
+};
+
 int forlan_dbg = -1;
 
 void
@@ -35,6 +49,153 @@ forlan_node_create(enum forlan_type type)
 }
 
 static void f_dump_node(FILE *fp, union forlan_node *p, int *num, int lev);
+
+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 void
+coerce_retval(forlan_eval_env_t env, int c)
+{
+	enum forlan_value_type t;
+	struct grecs_node *node;
+	
+	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;
+	}
+
+	if (t == env->retval.type)
+		return;
+
+	if (t == forlan_value_void) {
+		free_value(&env->retval);
+		env->retval.type = forlan_value_void;
+		return;
+	}
+
+	if (env->retval.type == forlan_value_void) {
+		err("can't coerce %s to %s",
+		    valtypestr(env->retval.type),
+		    valtypestr(t));
+		abort();
+	}
+
+	if (t == forlan_value_boolean) {
+		int res = retval_boolean(env);
+		free_value(&env->retval);
+		env->retval.type = forlan_value_boolean;
+		env->retval.v.num = res;
+		return;
+	}
+
+	/* Convert between string and node */
+	switch (env->retval.type) {
+	case forlan_value_literal:
+		node = grecs_find_node(env->tree, env->retval.v.string);
+		free(env->retval.v.string);
+		env->retval.v.node = node;
+		break;
+
+	case forlan_value_node:
+		if (env->retval.v.node->type == grecs_node_stmt) {
+			struct grecs_txtacc *acc = grecs_txtacc_create();
+			grecs_txtacc_format_value(env->retval.v.node->v.value,
+						  0, acc);
+			env->retval.v.string = grecs_txtacc_finish(acc, 1);
+			grecs_txtacc_free(acc);
+		} else
+			env->retval.v.string = grecs_strdup("");
+		break;
+
+	default:
+		abort();
+	}
+	env->retval.type = t;
+}
+	
+int
+retval_boolean(forlan_eval_env_t env)
+{
+	int res;
+	
+	switch (env->retval.type) {
+	case forlan_value_void:
+		err("controlling expression returned void, aborting");
+		abort();
+
+	case forlan_value_node:
+		res = env->retval.v.node != NULL;
+		break;
+
+	case forlan_value_literal:
+		res = env->retval.v.string != NULL &&
+			env->retval.v.string[0] != 0;
+		break;
+
+	case forlan_value_boolean:
+		res = env->retval.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
@@ -48,12 +209,20 @@ 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)
 {
 	forlan_node_free(p->comp.node);
 }
+
 void
 dump_comp(FILE *fp, union forlan_node *p, int *num, int lev)
 {
@@ -63,6 +232,118 @@ dump_comp(FILE *fp, union forlan_node *p, int *num, int lev)
 	fputc('\n', fp);
 	forlan_dump_node(fp, p->comp.node, num, lev + 1);
 }
+
+static enum grecs_tree_recurse_res
+eval_node_finder(enum grecs_tree_recurse_op op, struct grecs_node *node,
+		 void *data)
+{
+	forlan_eval_env_t env = data;
+	union forlan_node *instr = env->instr->stmt.stmt;
+	int match;
+
+	if (node->type == grecs_node_root)
+		return grecs_tree_recurse_ok;
+	if (op == grecs_tree_recurse_post) {
+		env->instr = env->instr->stmt.prev;
+		if (!env->instr)
+			return grecs_tree_recurse_stop;
+		return grecs_tree_recurse_ok;
+	}		
+	if (op == grecs_tree_recurse_pre && env->top_node == node)
+		return grecs_tree_recurse_ok;
+	
+	switch (instr->type) {
+	case forlan_type_lit:
+		match = strcmp(instr->lit.string, node->ident) == 0;
+		break;
+		
+	case forlan_type_test:
+		match = strcmp(instr->test.comp, node->ident) == 0;
+		if (match) {
+			struct grecs_value gval;
+			gval.type = GRECS_TYPE_STRING;
+			gval.v.string = instr->test.value;
+			match = grecs_value_eq(&gval, node->v.value);
+		}
+		break;
+
+	default:
+		abort();
+	}
+
+	if (match && !env->instr->stmt.next) {
+		env->retval.v.node = env->last = node;
+		return grecs_tree_recurse_stop;
+	}
+
+	if (op == grecs_tree_recurse_pre)
+		env->instr = env->instr->stmt.next;
+
+	if (match)
+		return grecs_tree_recurse_ok;
+  
+	return node->type == grecs_node_block ?
+		grecs_tree_recurse_skip : grecs_tree_recurse_ok;
+}
+
+static struct grecs_node *
+next_node(struct grecs_node *node)
+{
+	if (!node)
+		return NULL;
+	while (!node->next) {
+		node = node->up;
+		if (!node || node->type == grecs_node_root)
+			return NULL;
+	}
+	return node->next;
+}
+
+void
+eval_comp(forlan_eval_env_t env, union forlan_node *node)
+{
+	union forlan_node *np, tempnode;
+	struct grecs_node *g_node;
+	
+	np = node->comp.node;
+	if (!np) {
+		free_value(&env->retval);
+		env->retval.type = forlan_value_node;
+		env->retval.v.node = env->tree;
+		return;
+	}
+
+	switch (np->type) {
+	case forlan_type_func:
+		eval_func(env, np);
+		break;
+		
+	case forlan_type_last:
+		eval_last(env, np);
+		break;
+
+	case forlan_type_stmt:
+		if (np->stmt.stmt->type == forlan_type_func) {
+			eval_func(env, np->stmt.stmt);
+			g_node = env->top_node = env->last;
+			np = np->stmt.next;
+		} else {
+			g_node = env->tree;
+			env->top_node = NULL;
+		}
+		tempnode = *np;
+		tempnode.stmt.prev = NULL;
+		env->instr = &tempnode;
+		env->retval.type = forlan_value_node;
+		env->retval.v.node = NULL;
+		grecs_tree_recurse(g_node, eval_node_finder, env);
+		break;
+		
+	default:
+		err("invalid node type %d in comp node, aborting", np->type);
+		abort();
+	}
+}
 
 static void
 free_type_test(union forlan_node *p)
@@ -70,17 +351,27 @@ 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)
 {
@@ -90,6 +381,37 @@ dump_func(FILE *fp, union forlan_node *p, int *num, int lev)
 		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);
+	if (env->retval.type == forlan_value_node)
+		env->last = env->retval.v.node;
+}
+
 
 static void
 free_type_cond(union forlan_node *p)
@@ -98,6 +420,7 @@ free_type_cond(union forlan_node *p)
 	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)
 {
@@ -109,6 +432,16 @@ dump_cond(FILE *fp, union forlan_node *p, int *num, int lev)
 	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)
@@ -116,23 +449,47 @@ 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)
+{
+	union forlan_node *np;
+
+	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)
@@ -140,6 +497,7 @@ 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)
 {
@@ -150,32 +508,199 @@ dump_expr(FILE *fp, union forlan_node *p, int *num, int lev)
 	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;
+	
+	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;
+			
+	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_for(union forlan_node *p)
+{
+	forlan_node_free(p->loop.node);
+	forlan_node_free(p->loop.stmt);
+}
+
+void
+dump_for(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 %lu\n", ++*num, lev, lev, "", n);
+	forlan_dump_node(fp, p->loop.stmt, num, lev + 1);
+	fprintf(fp, "%04d: %*.*sEND LOOP %lu\n", ++*num, lev, lev, "", n);
+}
+
+void
+eval_for(forlan_eval_env_t env, union forlan_node *p)
+{
+	jmp_buf save;
+	memcpy(&save, &env->loop_buf, sizeof(save));
+	if (setjmp(env->loop_buf) < 2) {
+		for (;;) {
+			free_value(&env->retval);
+			forlan_eval(env, p->loop.node);
+			free_value(&env->vartab[p->loop.idx]);
+			copy_value(&env->vartab[p->asgn.idx], &env->retval);
+			if (!retval_boolean(env))
+				break;
+			forlan_eval(env, p->loop.stmt);
+		}
+	}
+	memcpy(&env->loop_buf, &save, sizeof(save));
+}
+
+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, /* Unknown/unset type */
-	free_type_comp,  dump_comp, /* A path component */  
-	free_type_test,	 dump_test, /* Value test (f[X]) */ 
-	free_type_func,	 dump_func, /* Function call */     
-	free_type_cond,	 dump_cond, /* Conditional */       
-	free_type_stmt,	 dump_stmt, /* Statement */         
-	free_type_lit,	 dump_lit,  /* Literal */           
-	free_type_expr,	 dump_expr, /* Boolean expression */
-	free_type_last,  dump_last, /* "last" */
+	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_for,   dump_for,  eval_for,  /* Loop */
+	NULL,            dump_continue, eval_continue,  /* continue statement */
+	NULL,            dump_break, eval_break,        /* break statement */
+	NULL,            dump_stop,  eval_stop,         /* stop statement */
 };
 
 void
@@ -209,17 +734,18 @@ forlan_stmt_list()
 union forlan_node *
 forlan_stmt_from_list(struct grecs_list *list)
 {
-	union forlan_node **tail = NULL, *ret = NULL;
+	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 (tail)
-			*tail = sp;
-		else
+		if (prev) {
+			prev->stmt.next = sp;
+			sp->stmt.prev = prev;
+		} else
 			ret = sp;
-		tail = &sp->stmt.next;
+		prev = sp;
 	}
 	list->free_entry = NULL;
 	grecs_list_free(list);
@@ -251,39 +777,68 @@ forlan_dump_node(FILE *fp, union forlan_node *p, int *num, int lev)
 }
 
 void
-forlan_dump_tree(FILE *fp, union forlan_node *node)
+forlan_dump_tree(FILE *fp, forlan_eval_env_t env)
 {
 	int n = 0;
-	forlan_dump_node(fp, node, &n, 0);
+	forlan_dump_node(fp, env->parse_tree, &n, 0);
 }
 
-struct forlan_eval_env {
-	struct grecs_node *tree;
-	struct grecs_node *last;
-};
-
 void
 func_dump(forlan_eval_env_t env, struct grecs_list *list)
 {
-	abort();
+	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:
+			grecs_print_node(val->v.node,
+					 GRECS_NODE_FLAG_VALUE, fp);
+			break;
+		case forlan_value_literal:
+			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)
 {
-	abort();
+	generic_print(env, list, stdout);
 }
 
 void
 func_error(forlan_eval_env_t env, struct grecs_list *list)
 {
-	abort();
+	generic_print(env, list, stderr);
 }
 
 void
 func_parent(forlan_eval_env_t env, struct grecs_list *list)
 {
-	abort();
+	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;
+	}
 }
 
 static struct forlan_function functab[] = {
@@ -304,5 +859,43 @@ forlan_find_function(const char *name)
 	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);
+}
 
+void
+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);
+}
+
+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);
+}
 
diff --git a/lib/forlan.h b/lib/forlan.h
index aa4dbe4..7b511f1 100644
--- a/lib/forlan.h
+++ b/lib/forlan.h
@@ -18,14 +18,16 @@
 #define FORLAN_DBG_GRAM 2
 #define FORLAN_DBG_EVAL 1
 
+typedef struct forlan_eval_env *forlan_eval_env_t;
+
 extern int forlan_dbg;
 
 void forlan_init();
 void forlan_lex_begin(const char *input, size_t length,
 		   struct grecs_locus_point *pt);
 void forlan_lex_end(void);
-int forlan_parse(const char *input, size_t length,
-		 struct grecs_locus_point *pt);
+forlan_eval_env_t forlan_parse(const char *input, size_t length,
+			       struct grecs_locus_point *pt);
 
 union forlan_node; /* Declared below */
 
@@ -37,8 +39,14 @@ enum forlan_type {
 	forlan_type_cond,	/* Conditional */       
 	forlan_type_stmt,	/* Statement */         
 	forlan_type_lit,	/* Literal */           
-	forlan_type_expr,  /* Boolean expression */
-	forlan_type_last   /* Return last evaluated grecs_node */
+	forlan_type_expr,       /* Boolean expression */
+	forlan_type_last,       /* Return last evaluated grecs_node */
+	forlan_type_asgn,       /* Variable assignment */
+	forlan_type_var,        /* Variable reference */
+	forlan_type_loop,       /* Loop */
+	forlan_type_continue,   /* continue statement */
+	forlan_type_break,      /* break statement */
+	forlan_type_stop        /* stop statement */
 };
 
 /* A path component */
@@ -74,7 +82,7 @@ struct forlan_node_cond {
 struct forlan_node_stmt {
 	enum forlan_type type;
 	union forlan_node *stmt;
-	union forlan_node *next;
+	union forlan_node *next, *prev;
 };
 
 /* Literal string */
@@ -83,6 +91,27 @@ struct forlan_node_lit {
 	char *string;
 };
 
+/* Variable assignment */
+struct forlan_node_asgn {
+	enum forlan_type type;
+	size_t idx;
+	union forlan_node *node;
+};
+
+/* Variable reference */
+struct forlan_node_var {
+	enum forlan_type type;
+	size_t idx;
+};
+
+/* Loop */
+struct forlan_node_loop {
+	enum forlan_type type;
+	size_t idx;                 /* index of the controlling variable */
+	union forlan_node *node;    /* controlling expression */
+	union forlan_node *stmt;    /* statement */
+};
+
 /* Boolean opcodes */
 enum forlan_opcode {
 	forlan_opcode_node,  /* Evaluate node, set 'last' */
@@ -109,6 +138,9 @@ union forlan_node {
 	struct forlan_node_lit  lit;  /* Literal */
 	struct forlan_node_expr expr; /* Boolean expression */
 	/* forlan_type_last needs no additional data */
+	struct forlan_node_asgn asgn;
+	struct forlan_node_var var;
+	struct forlan_node_loop loop;
 };
 
 union forlan_node *forlan_node_create(enum forlan_type type);
@@ -117,17 +149,14 @@ struct grecs_list *forlan_stmt_list(void);
 struct grecs_list *forlan_complist(void);
 union forlan_node *forlan_stmt_from_list(struct grecs_list *list);
 
-extern union forlan_node *forlan_parse_tree;
-
 void forlan_dump_node(FILE *fp, union forlan_node *p, int *num, int lev);
-void forlan_dump_tree(FILE *fp, union forlan_node *node);
+void forlan_dump_tree(FILE *fp, forlan_eval_env_t env);
 
-typedef struct forlan_eval_env *forlan_eval_env_t;
-
 enum forlan_value_type {
 	forlan_value_void,
 	forlan_value_node,
-	forlan_value_literal
+	forlan_value_literal,
+	forlan_value_boolean
 };
 
 struct forlan_value {
@@ -135,9 +164,15 @@ struct forlan_value {
 	union {
 		char *string;
 		struct grecs_node *node;
+		int num;
 	} v;
 };
 
+struct forlan_variable {
+	char *name;       /* Variable name */
+	int idx;          /* Offset in the variable segment */ 
+};
+
 struct forlan_function {
 	char *name;
 	enum forlan_value_type rettype;
@@ -148,3 +183,10 @@ struct forlan_function {
 };
 
 struct forlan_function *forlan_find_function(const char *name);
+
+void forlan_eval(struct forlan_eval_env *env, union forlan_node *p);
+void forlan_run(forlan_eval_env_t env, struct grecs_node *tree);
+forlan_eval_env_t forlan_create_environment(union forlan_node *parse_tree,
+					    size_t varcount);
+void forlan_free_environment(forlan_eval_env_t env);
+
diff --git a/lib/forlangrm.y b/lib/forlangrm.y
index d2e0489..cd2fec9 100644
--- a/lib/forlangrm.y
+++ b/lib/forlangrm.y
@@ -23,6 +23,10 @@
 
 static int yyerror(char *);
 union forlan_node *forlan_parse_tree;
+size_t forlan_variable_count;
+static struct grecs_symtab *forlan_symtab;
+
+static size_t find_variable(const char *name);
 %}
 %error-verbose
 %locations
@@ -34,13 +38,14 @@ union forlan_node *forlan_parse_tree;
 };
 
 %token <string> STRING IDENT
-%token LAST IF ELSE
+%token LAST IF ELSE LET FOR IN BREAK CONTINUE STOP
 
 %left OR
 %left AND
 %left NOT
 
 %type <node> stmt stmt_cond stmt_expr stmt_blk cond bool node comp funcall arg
+%type <node> stmt_let stmt_for stmt_ctrl stmt_asgn
 %type <list> stmtlist complist arglist
 %type <string> string
 
@@ -66,6 +71,10 @@ stmtlist  : stmt
 stmt      : stmt_cond
           | stmt_expr
           | stmt_blk
+          | stmt_let
+          | stmt_asgn
+          | stmt_for
+          | stmt_ctrl
           ;
 
 stmt_blk  : '{' stmtlist '}'
@@ -125,12 +134,25 @@ bool      : node
 	    }
           ;
 
-node      : complist
+node      : funcall
             {
 		    $$ = forlan_node_create(forlan_type_comp);
 		    $$->comp.abs = 0;
-		    $$->comp.node = forlan_stmt_from_list($1);
+		    $$->comp.node = $1;
 	    }
+          | funcall '.' complist
+            {
+		    $$ = forlan_node_create(forlan_type_comp);
+		    $$->comp.abs = 0;
+		    grecs_list_push($3, $1);
+		    $$->comp.node = forlan_stmt_from_list($3);
+            }
+/*          | complist
+            {
+		    $$ = forlan_node_create(forlan_type_comp);
+		    $$->comp.abs = 0;
+		    $$->comp.node = forlan_stmt_from_list($1);
+	    } */
           | '.' complist
             {
 		    $$ = forlan_node_create(forlan_type_comp);
@@ -147,6 +169,12 @@ node      : complist
             {
 		    $$ = forlan_node_create(forlan_type_last);
 	    }
+          | IDENT
+            {
+		    $$ = forlan_node_create(forlan_type_var);
+		    $$->var.idx = find_variable($1);
+//		    free($1);
+	    }
           ;
 
 complist  : comp
@@ -172,7 +200,6 @@ comp      : IDENT
 		    $$->test.comp = $1;
 		    $$->test.value = $3;
 	    }
-          | funcall
           ;
 
 string    : IDENT
@@ -255,6 +282,56 @@ arg       : node
 
 stmt_expr : funcall ';'
           ;
+
+stmt_let  : LET IDENT ';'
+            {
+		    find_variable($2);
+	    }
+          | LET IDENT '=' node ';'
+            {
+		    $$ = forlan_node_create(forlan_type_asgn);
+		    $$->asgn.idx = find_variable($2);
+		    $$->asgn.node = $4;
+	    }
+          | LET IDENT '=' funcall ';'
+            {
+		    $$ = forlan_node_create(forlan_type_asgn);
+		    $$->asgn.idx = find_variable($2);
+		    $$->asgn.node = $4;
+	    }
+          ;
+
+stmt_for  : FOR '(' IDENT IN node ')' stmt
+            {
+		    $$ = forlan_node_create(forlan_type_loop);
+		    $$->loop.idx = find_variable($3);
+		    $$->loop.node = $5;
+		    $$->loop.stmt = $7;
+	    }
+          ;
+
+
+stmt_ctrl : BREAK ';'
+            {
+		    $$ = forlan_node_create(forlan_type_break);
+	    }
+          | CONTINUE ';'
+            {
+		    $$ = forlan_node_create(forlan_type_continue);
+	    }
+          | STOP ';' 
+            {
+		    $$ = forlan_node_create(forlan_type_stop);
+	    }
+          ;
+
+stmt_asgn : IDENT '=' node ';'
+            {
+		    $$ = forlan_node_create(forlan_type_asgn);
+		    $$->asgn.idx = find_variable($1);
+		    $$->asgn.node = $3;
+	    }		    
+          ;
 %%
 static int
 yyerror(char *s)
@@ -270,14 +347,45 @@ forlan_parser()
 	return yyparse();
 }
 
-int
+forlan_eval_env_t
 forlan_parse(const char *input, size_t length, struct grecs_locus_point *pt)
 {
 	int rc;
+	forlan_eval_env_t env = NULL;
+	
 	forlan_lex_begin(input, length, pt);
 	rc = forlan_parser();
 	forlan_lex_end();
-	return rc;
+	grecs_symtab_free(forlan_symtab);
+	forlan_symtab = NULL;
+
+	if (rc == 0)
+		env = forlan_create_environment(forlan_parse_tree,
+						forlan_variable_count);
+
+	return env;
 }
 
-		
+static size_t
+find_variable(const char *name)
+{
+	struct forlan_variable key;
+	struct forlan_variable *ent;
+	int install = 1;
+
+	if (!forlan_symtab) {
+		forlan_symtab = grecs_symtab_create_default(
+			              sizeof(struct forlan_variable));
+		if (!forlan_symtab)
+			grecs_alloc_die();
+		forlan_variable_count = 0;
+	}
+  
+	key.name = (char*) name;
+	ent = grecs_symtab_lookup_or_install(forlan_symtab, &key, &install);
+	if (!ent)
+		grecs_alloc_die();
+	if (install)
+		ent->idx = forlan_variable_count++;
+	return ent->idx;
+}
diff --git a/lib/forlanlex.l b/lib/forlanlex.l
index 99966ed..e3f9f26 100644
--- a/lib/forlanlex.l
+++ b/lib/forlanlex.l
@@ -66,6 +66,11 @@ IDC [a-zA-Z_0-9-]
 if                    return IF;
 else                  return ELSE;
 last                  return LAST;
+for                   return FOR;
+let                   return LET;
+in                    return IN;
+break                 return BREAK;
+continue              return CONTINUE;
 !                     return NOT;
 "&&"                  return AND;
 "||"                  return OR;
@@ -98,7 +103,7 @@ last                  return LAST;
          /* Other tokens */
 {WS}     ;
 \n       { grecs_locus_point_advance_line(grecs_current_locus_point); } 
-[.,;{}()\[\]] return yytext[0];
+[.,;{}()\[\]=\*%] return yytext[0];
 .        { if (isascii(yytext[0]) && isprint(yytext[0]))
 		grecs_error(&yylloc, 0,
 			     _("stray character %c"), yytext[0]);
diff --git a/tests/tforlan.c b/tests/tforlan.c
index 9fc3495..550bc03 100644
--- a/tests/tforlan.c
+++ b/tests/tforlan.c
@@ -23,6 +23,7 @@
 #endif
 #include <errno.h>
 #include <sysexits.h>
+#include <expat.h>
 #include <libeclat.h>
 #include "forlan.h"
 #include <sys/stat.h>
@@ -33,6 +34,32 @@ usage()
 	printf("usage: %s [-dD] FILE [INPUT]\n");
 }
 
+struct grecs_node *
+parse_xml(FILE *fp)
+{
+	XML_Parser parser;
+	eclat_partial_tree_t part;
+	size_t size;
+	char buffer[256];
+
+	parser = XML_ParserCreate("UTF-8");
+	if (!parser)
+		die(EX_SOFTWARE, "cannot create XML parser");
+	XML_SetElementHandler(parser,
+			      eclat_partial_tree_start_handler,
+			      eclat_partial_tree_end_handler);
+	XML_SetCharacterDataHandler(pa