Implement variables and loops in forlan.

* lib/forlan.c (free_type_comp): Free labels and argv.
(dump_comp): Rewrite.
(eval_node_finder): Remove.
(eval_comp): Rewrite.
(eval_comp0): New function.
(free_type_loop, dump_loop, eval_loop)
(dump_continue, eval_continue)
(dump_break, eval_break)
(dump_stop,  eval_stop): New methods.
(f_tab): Add new methods.
* lib/forlan.h (forlan_node_comp): Change structure.
* lib/forlangrm.y: Implement loops.
* tests/Makefile.am: Add new tests.
* tests/testsuite.at: Likewise.
* tests/forlan01.at: Update.
* tests/tforlan.c: New option -s (sort tree).
* tests/dump01.at: New file.
* tests/dump02.at: New file.
* tests/last.at: New file.
* tests/let.at: New file.
* tests/listall.at: New file.
* tests/print01.at: New file.
* tests/print02.at: New file.
* tests/print03.at: New file.
* tests/tags.xml: New file.
* tests/tagshairy.at: New file.

3 files changed, 188 insertions, 147 deletions

diff --git a/lib/forlan.c b/lib/forlan.c
index 2f552d1..3f17240 100644
--- a/lib/forlan.c
+++ b/lib/forlan.c
@@ -220,129 +220,74 @@ eval_null(forlan_eval_env_t env, union forlan_node *node)
 static void
 free_type_comp(union forlan_node *p)
 {
-	forlan_node_free(p->comp.node);
+	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)
 {
-	fprintf(fp, "COMP");
-	if (p->comp.abs)
-		fprintf(fp, " ABS");
-	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;
+	int i;
 	
-	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();
+	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, "");
 	}
-
-	if (match && !env->instr->stmt.next) {
-		env->retval.v.node = env->last = node;
-		return grecs_tree_recurse_stop;
+	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);
+		}
 	}
-
-	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;
+	fputc('\n', fp);
 }
 
-static struct grecs_node *
-next_node(struct grecs_node *node)
+grecs_match_buf_t 
+eval_comp0(forlan_eval_env_t env, union forlan_node *p)
 {
-	if (!node)
-		return NULL;
-	while (!node->next) {
-		node = node->up;
-		if (!node || node->type == grecs_node_root)
-			return NULL;
+	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;
+		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 {
+			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);
+		}
 	}
-	return node->next;
+	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 *node)
+eval_comp(forlan_eval_env_t env, union forlan_node *p)
 {
-	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();
-	}
+	free(eval_comp0(env, p));
 }
 
 static void
@@ -605,14 +550,14 @@ eval_var(forlan_eval_env_t env, union forlan_node *p)
 }
 
 static void
-free_type_for(union forlan_node *p)
+free_type_loop(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)
+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);
@@ -624,22 +569,25 @@ dump_for(FILE *fp, union forlan_node *p, int *num, int lev)
 }
 
 void
-eval_for(forlan_eval_env_t env, union forlan_node *p)
+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) {
-		for (;;) {
-			free_value(&env->retval);
-			forlan_eval(env, p->loop.node);
-			free_value(&env->vartab[p->loop.idx]);
+		while (retval_boolean(env)) {
 			copy_value(&env->vartab[p->asgn.idx], &env->retval);
-			if (!retval_boolean(env))
-				break;
 			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
@@ -697,7 +645,7 @@ static struct forlan_node_method f_tab[] = {
 	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 */
+	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 */
diff --git a/lib/forlan.h b/lib/forlan.h
index 7b511f1..b789d7e 100644
--- a/lib/forlan.h
+++ b/lib/forlan.h
@@ -52,8 +52,11 @@ enum forlan_type {
 /* A path component */
 struct forlan_node_comp {
 	enum forlan_type type;
-	int abs;
-	union forlan_node *node;
+	union forlan_node *root;
+	int wildcards;
+	int argc;
+	char **argv;
+	struct grecs_value **labelv;
 };
 
 /* Path test: .path.comp[value] */
diff --git a/lib/forlangrm.y b/lib/forlangrm.y
index cd2fec9..e8e3436 100644
--- a/lib/forlangrm.y
+++ b/lib/forlangrm.y
@@ -27,6 +27,20 @@ size_t forlan_variable_count;
 static struct grecs_symtab *forlan_symtab;
 
 static size_t find_variable(const char *name);
+static union forlan_node *create_comp_node(union forlan_node *root,
+					   struct grecs_list *arglist,
+					   int wildcards);
+
+struct path_component {
+	char *id;
+	char *label;
+};
+
+static void
+free_comp(void *p)
+{
+	free(p);
+}
 %}
 %error-verbose
 %locations
@@ -35,6 +49,14 @@ static size_t find_variable(const char *name);
 	char *string;
 	union forlan_node *node;
 	struct grecs_list *list;
+	struct {
+		struct path_component *comp;
+		int wildcard;
+	} comp;
+	struct {
+		int wildcards;
+		struct grecs_list *list;
+	} complist;
 };
 
 %token <string> STRING IDENT
@@ -44,10 +66,12 @@ static size_t find_variable(const char *name);
 %left AND
 %left NOT
 
-%type <node> stmt stmt_cond stmt_expr stmt_blk cond bool node comp funcall arg
+%type <node> stmt stmt_cond stmt_expr stmt_blk cond bool node funcall arg
 %type <node> stmt_let stmt_for stmt_ctrl stmt_asgn
-%type <list> stmtlist complist arglist
+%type <list> stmtlist arglist
+%type <complist> complist
 %type <string> string
+%type <comp> comp
 
 %%
 input     : stmtlist
@@ -137,33 +161,23 @@ bool      : node
 node      : funcall
             {
 		    $$ = forlan_node_create(forlan_type_comp);
-		    $$->comp.abs = 0;
-		    $$->comp.node = $1;
+		    $$->comp.root = $1;
+		    $$->comp.wildcards = 0;
+		    $$->comp.argc = 0;
+		    $$->comp.argv = NULL;
+		    $$->comp.labelv = NULL;
 	    }
           | funcall '.' complist
             {
-		    $$ = forlan_node_create(forlan_type_comp);
-		    $$->comp.abs = 0;
-		    grecs_list_push($3, $1);
-		    $$->comp.node = forlan_stmt_from_list($3);
+		    $$ = create_comp_node($1, $3.list, $3.wildcards);
             }
-/*          | complist
-            {
-		    $$ = forlan_node_create(forlan_type_comp);
-		    $$->comp.abs = 0;
-		    $$->comp.node = forlan_stmt_from_list($1);
-	    } */
           | '.' complist
             {
-		    $$ = forlan_node_create(forlan_type_comp);
-		    $$->comp.abs = 1;
-		    $$->comp.node = forlan_stmt_from_list($2);
+		    $$ = create_comp_node(NULL, $2.list, $2.wildcards);
 	    }
           | '.'
             {
 		    $$ = forlan_node_create(forlan_type_comp);
-		    $$->comp.abs = 1;
-		    $$->comp.node = NULL;
 	    }
           | LAST
             {
@@ -175,30 +189,53 @@ node      : funcall
 		    $$->var.idx = find_variable($1);
 //		    free($1);
 	    }
+          | IDENT '.' complist
+            {
+		    union forlan_node *node =
+			    forlan_node_create(forlan_type_var);
+		    node->var.idx = find_variable($1);
+		    $$ = create_comp_node(node, $3.list, $3.wildcards);
+            }
           ;
 
 complist  : comp
             {
-		    $$ = forlan_stmt_list();
-		    grecs_list_append($$, $1);
+		    $$.list = grecs_list_create();
+		    grecs_list_append($$.list, $1.comp);
+		    $$.wildcards = $1.wildcard;
 	    }
           | complist '.' comp
 	    {
-		    grecs_list_append($1, $3);
+		    grecs_list_append($1.list, $3.comp);
 		    $$ = $1;
+		    $$.wildcards |= $3.wildcard;
 	    }
           ;
 
 comp      : IDENT
             {
-		    $$ = forlan_node_create(forlan_type_lit);
-		    $$->lit.string = $1;
+		    $$.comp = grecs_zalloc(sizeof(*$$.comp));
+		    $$.comp->id = $1;
+		    $$.wildcard = 0;
 	    }
           | IDENT '[' string ']'
             {
-		    $$ = forlan_node_create(forlan_type_test);
-		    $$->test.comp = $1;
-		    $$->test.value = $3;
+		    $$.comp = grecs_zalloc(sizeof(*$$.comp));
+		    $$.comp->id = $1;
+		    $$.comp->label = $3;
+		    $$.wildcard = 0;
+	    }
+          | '%'
+	    {
+		    $$.comp = grecs_zalloc(sizeof(*$$.comp));
+		    $$.comp->id = grecs_strdup("%");
+		    $$.wildcard = 1;
+	    }
+	  | '*'
+	    {
+		    $$.comp = grecs_zalloc(sizeof(*$$.comp));
+		    $$.comp->id = grecs_strdup("*");
+		    $$.wildcard = 1;
 	    }
           ;
 
@@ -389,3 +426,56 @@ find_variable(const char *name)
 		ent->idx = forlan_variable_count++;
 	return ent->idx;
 }
+
+/* Optimize the content of "comp" node.
+   
+   The grecs_match_buf_create function compresses contiguous occurrences
+   of the "*" wildcard into a single one, shifting the rest of elements in
+   argv and labelv into the freed slots.  This can result in changing the
+   number of arguments.  We create a buffer to let it do its job and update
+   the argc stored in the node, so that subsequent calls to
+   grecs_match_list_create get the correct number of elements.
+ */
+static void
+optimize_comp(union forlan_node *p)
+{
+	grecs_match_buf_t mb;
+
+	mb = grecs_match_buf_create(p->comp.argc, p->comp.argv, p->comp.labelv);
+	p->comp.argc = grecs_match_buf_get_args(mb, NULL);
+	free(mb);
+}
+
+static union forlan_node *
+create_comp_node(union forlan_node *root, struct grecs_list *arglist,
+		 int wildcards)
+{
+	union forlan_node *ret;
+	int i;
+	struct grecs_list_entry *ep;
+		    
+	ret = forlan_node_create(forlan_type_comp);
+	ret->comp.root = root;
+	ret->comp.wildcards = wildcards;
+	ret->comp.argc = arglist->count;
+	ret->comp.argv = grecs_calloc(arglist->count,
+				      sizeof(ret->comp.argv[0]));
+	ret->comp.labelv = grecs_calloc(arglist->count,
+					sizeof(ret->comp.labelv[0]));
+	for (i = 0, ep = arglist->head; ep; i++, ep = ep->next) {
+		struct path_component *comp = ep->data;
+		struct grecs_value *val;
+
+		ret->comp.argv[i] = comp->id;
+		if (comp->label) {
+			val = grecs_malloc(sizeof(*val));
+			val->type = GRECS_TYPE_STRING;
+			val->v.string = comp->label;
+		} else
+			val = NULL;
+		ret->comp.labelv[i] = val;
+	}
+	grecs_list_free(arglist);
+	optimize_comp(ret);
+	return ret;
+}