/*
 * BIG TODO: borrow semantics of OpenGL + GLSL
 * TODO: C syntax for expressions, statements and functions
 * (have to see parser of tcc compiler ?)
 */

#include <v_lib.h>
#include "estring.h"
#include "usl.h"

/*

// Useful hack for tracing memory leaks:
 
#define	memAlloc(block)		allocz(block)
#define	memAllocZ(block)	allocz(block)

void_p allocz(u32_t block)
{
	if(block == 32)
		assert(0);
	return (memAllocZ)(block);
}

*/

/*
 * Helper macros; move them out of here later.
 */

#define STR_COMP		strcasecmp
#define STR_EQ(s1,s2)   (!STR_COMP(s1,s2))
#define MAX_ID		  64

#define SYN_EXPECTED_EXPRESSION(lexer)	SYN_EXPECTED(lexer,"expression")

#define	PARANOID_ASSERT(val)	V_ASSERT(val)

/*
 * Clears result of last string evaluation. Note: bug-free code should
 * _assert_ on STRING_EXIT instead of checking and setting it to NULL.
 */

#define	CLEAR_STRING_EXIT(ctx) \
	if(STRING_EXIT(ctx)) { \
		memFree(STRING_EXIT(ctx)); \
		STRING_EXIT(ctx) = NULL; \
	}

#define	PARANOID_RTTC(node,id)	PARANOID_ASSERT((node)->typeid == id)
#define	RANGE_ASSERT(val) \
	if(!(val)) { \
		conlPrintf(LOG_ERROR,"RANGE ERROR\n"); \
		V_ASSERT(0); \
	}

/*
 * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 * Part 1: expressons.
 * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 */

/*
 * Access and assignment: 'int' type
 */
#include <../source/PAL/argsused.h>
V_LOCAL void V_CALL
op_int_const(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_INT);
	INT_EXIT(ctx) = root->constant.int_const;
}

V_LOCAL void V_CALL
op_int_access(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_INT);
	INT_EXIT(ctx) = *NODAL_INT(root);
}

V_LOCAL void V_CALL
op_int_access_1d(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	ET_EVAL(root->left,ctx);
	PARANOID_ASSERT(root->dimension == 1);
	RANGE_ASSERT(INT_EXIT(ctx) >= 0 && (u32_t)INT_EXIT(ctx) < root->dim1);
	INT_EXIT(ctx) = NODAL_INT(root)[INT_EXIT(ctx)];
}

V_LOCAL void V_CALL
op_int_access_2d(etree_node_p root,etree_context_p ctx)
{
	int row_offs;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	PARANOID_ASSERT(root->dimension == 2);
	ET_EVAL(root->left,ctx); /* row */
	RANGE_ASSERT(INT_EXIT(ctx) >= 0 && (u32_t)INT_EXIT(ctx) < root->dim2);
	row_offs = INT_EXIT(ctx) * root->dim1;
	ET_EVAL(root->right,ctx); /* column */
	RANGE_ASSERT(INT_EXIT(ctx) >= 0 && (u32_t)INT_EXIT(ctx) < root->dim1);
	INT_EXIT(ctx) = NODAL_INT(root)[row_offs + INT_EXIT(ctx)];
}

V_LOCAL void V_CALL
op_int_assign(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_INT);
	*NODAL_INT(root) = INT_EXIT(ctx);
}

V_LOCAL void V_CALL
op_int_assign_1d(etree_node_p root,etree_context_p ctx)
{
	USL_INT val = INT_EXIT(ctx);
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	ET_EVAL(root->left,ctx);
	PARANOID_ASSERT(root->dimension == 1);
	RANGE_ASSERT(INT_EXIT(ctx) >= 0 && (u32_t)INT_EXIT(ctx) < root->dim1);
	NODAL_INT(root)[INT_EXIT(ctx)] = val;
}

V_LOCAL void V_CALL
op_int_assign_2d(etree_node_p root,etree_context_p ctx)
{
	USL_INT val = INT_EXIT(ctx);
	int row_offs;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	PARANOID_ASSERT(root->dimension == 2);
	ET_EVAL(root->left,ctx); /* row */
	RANGE_ASSERT(INT_EXIT(ctx) >= 0 && (u32_t)INT_EXIT(ctx) < root->dim2);
	row_offs = INT_EXIT(ctx) * root->dim1;
	ET_EVAL(root->right,ctx); /* column */
	RANGE_ASSERT(INT_EXIT(ctx) >= 0 && (u32_t)INT_EXIT(ctx) < root->dim1);
	NODAL_INT(root)[row_offs + INT_EXIT(ctx)] = val;
}

/*
 * Access and assignment: 'real' type
 */

#include <../source/PAL/argsused.h>
V_LOCAL void V_CALL
op_real_const(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_REAL);
	REAL_EXIT(ctx) = root->constant.real_const;
}

V_LOCAL void V_CALL
op_real_access(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_REAL);
	REAL_EXIT(ctx) = *NODAL_REAL(root);
}

V_LOCAL void V_CALL
op_real_access_1d(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_INT);
	ET_EVAL(root->left,ctx);
	PARANOID_ASSERT(root->dimension == 1);
	RANGE_ASSERT(INT_EXIT(ctx) >=0 && (u32_t)INT_EXIT(ctx) < root->dim1);
	REAL_EXIT(ctx) = NODAL_REAL(root)[INT_EXIT(ctx)];
}

V_LOCAL void V_CALL
op_real_access_2d(etree_node_p root,etree_context_p ctx)
{
	int row_offs;
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	PARANOID_ASSERT(root->dimension == 2);
	ET_EVAL(root->left,ctx); /* row */
	RANGE_ASSERT(INT_EXIT(ctx) >= 0 && (u32_t)INT_EXIT(ctx) < root->dim2);
	row_offs = INT_EXIT(ctx) * root->dim1;
	ET_EVAL(root->right,ctx); /* column */
	RANGE_ASSERT(INT_EXIT(ctx) >= 0 && (u32_t)INT_EXIT(ctx) < root->dim1);
	REAL_EXIT(ctx) = NODAL_REAL(root)[row_offs + INT_EXIT(ctx)];
}

V_LOCAL void V_CALL
op_real_assign(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_REAL);
	*NODAL_REAL(root) = REAL_EXIT(ctx);
}

V_LOCAL void V_CALL
op_real_assign_1d(etree_node_p root,etree_context_p ctx)
{
	USL_REAL val = REAL_EXIT(ctx);
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_INT);
	ET_EVAL(root->left,ctx);
	PARANOID_ASSERT(root->dimension == 1);
	RANGE_ASSERT(INT_EXIT(ctx) >=0 && (u32_t)INT_EXIT(ctx) < root->dim1);
	NODAL_REAL(root)[INT_EXIT(ctx)] = val;
}

V_LOCAL void V_CALL
op_real_assign_2d(etree_node_p root,etree_context_p ctx)
{
	USL_REAL val = REAL_EXIT(ctx);
	int row_offs;
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	PARANOID_ASSERT(root->dimension == 2);
	ET_EVAL(root->left,ctx); /* row */
	RANGE_ASSERT(INT_EXIT(ctx) >= 0 && (u32_t)INT_EXIT(ctx) < root->dim2);
	row_offs = INT_EXIT(ctx) * root->dim1;
	ET_EVAL(root->right,ctx); /* column */
	RANGE_ASSERT(INT_EXIT(ctx) >= 0 && (u32_t)INT_EXIT(ctx) < root->dim1);
	NODAL_REAL(root)[row_offs + INT_EXIT(ctx)] = val;
}

/*
 * Access and assignment: 'string' type
 */

#include <../source/PAL/argsused.h>
V_LOCAL void V_CALL
op_string_const(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_STRING);
	PARANOID_ASSERT(root->constant.string_const);
	STRING_EXIT(ctx) = esCopyString(STRING_EXIT(ctx),
		root->constant.string_const);
}

V_LOCAL void V_CALL
op_string_access(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_STRING);
	STRING_EXIT(ctx) = esCopyString(STRING_EXIT(ctx),*NODAL_STRING(root));
}

V_LOCAL void V_CALL
op_string_assign(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_STRING);
	*NODAL_STRING(root) = esCopyString(*NODAL_STRING(root),STRING_EXIT(ctx));
}

V_LOCAL void V_CALL
op_string_destruct(etree_node_p root)
{
	if(root->constant.string_const)
		memFree(root->constant.string_const);
	if(root->base && *NODAL_STRING(root))
	{
		memFree(*NODAL_STRING(root));
		*NODAL_STRING(root) = NULL;
	}
}

/*
 * Known types
 */
V_LOCAL typeinfo_t usl_type_list[MAX_TYPES] = 
{
	/* integer */
	{
		TYPEID_INT,
		sizeof(USL_INT),
		{
			NULL,
			op_int_const,
			op_int_access,op_int_access_1d,op_int_access_2d,
			op_int_assign,op_int_assign_1d,op_int_assign_2d
		},
		"int"
	},
	/* floating-point */
	{
		TYPEID_REAL,
		sizeof(USL_REAL),
		{
			NULL,
			op_real_const,
			op_real_access,op_real_access_1d,op_real_access_2d,
			op_real_assign,op_real_assign_1d,op_real_assign_2d
		},
		"real"
	},
	/* string */
	{
		TYPEID_STRING,
		sizeof(USL_REAL),
		{
			op_string_destruct,
			op_string_const,
			op_string_access,NULL,NULL,
			op_string_assign,NULL,NULL
		},
		"string"
	},
	/* termination entry (must be last) */
	{
		TYPEID_NULL,
		0,
		{
			NULL,
			NULL,
			NULL,NULL,NULL,
			NULL,NULL,NULL
		},
		"void"
	}
};

V_LOCAL typeinfo_p
typeGetInfo(u32_t id)
{
	typeinfo_p ptr = usl_type_list;
	/* assume the termination 'id' has zero value */
	while(ptr->typeid)
	{
		if(ptr->typeid == id)
			return ptr;
		ptr++;
	}
	return NULL;
}

V_LOCAL typeinfo_p
typeFindInfo(char *type_name)
{
	typeinfo_p ptr = usl_type_list;
	if(!type_name)
		return NULL;
	/* assume the termination 'id' has zero value */
	while(ptr->typeid)
	{
		if(STR_EQ(ptr->type_name,type_name))
			return ptr;
		ptr++;
	}
	return NULL;
}

V_LOCAL char_p
typeGetName(u32_t id)
{
	static char *null_name = "NULL";
	typeinfo_p ptr = typeGetInfo(id);
	if(!ptr)
		return null_name;
	return strSafe(ptr->type_name);
}

V_LOCAL u32_t
typeGetSize(u32_t id)
{
	typeinfo_p ptr = typeGetInfo(id);
	if(!ptr)
		return 0;
	return ptr->size_of;
}

/* -------------------------------------------------------------------- *\
							   Identifier
\* -------------------------------------------------------------------- */

/* used at parsing and relocation stages */
typedef struct etree_operand_s
{
	struct	etree_operand_s *next;
	char	*identifier;
	u32_t	typeid;
	u32_t	dimension;
	u32_t	dim1; /* == 1 for scalars */
	u32_t	dim2; /* == 1 for scalars */
	u32_t	size; /* size of actual operand in bytes: for relocation */
	u32_t	scope; /* 0 - global; 1 and above - function */
	vboolean visible; /* == hide at exit of compound with same scope */
}	etree_operand_t, *etree_operand_p;

/*
 * etreeFindNextIdentifier()
 */
V_LOCAL etree_operand_p
etreeFindNextIdentifier(etree_operand_p head,char *name)
{
	while(head)
	{
		if(STR_EQ(head->identifier,name))
			break;
		head = head->next;
	}
	return head;
}

/*
 * etreeInsertIdentifier()
 */
V_LOCAL vboolean
etreeInsertIdentifier(etree_operand_p *head,
	char *identifier,
	u32_t typeid,
	u32_t dimension,
	u32_t dim1,u32_t dim2,
	u32_t scope)
{
	CALLER_NAME(etreeInsertIdentifier)
	DEBUG_MESSAGE(unknown_type,"unknown typeid")
	DEBUG_MESSAGE(already_defined,"%s(): variable \"%s\" already defined")
	DEBUG_MESSAGE(not_scalar,"only real and int arrays supported")
	DEBUG_MESSAGE(inconsistent_dimension,"inconsistent dimension")
	DEBUG_MESSAGE(dimension_too_high,"dimension too high")
	etree_operand_p self;
	typeinfo_p type_info;
	type_info = typeGetInfo(typeid);
	if(!type_info)
	{
		ERROR_GENERIC(unknown_type);
		return false;
	}
	/* check for possible redefinition */
	self = etreeFindNextIdentifier(*head,identifier);
	while(self)
	{
		/*
		 * Redefinition occurs only for visible variable with _same_
		 * scope (strictly, the scope of already defined variable 
		 * must not be _greater or equal_ to scope of new one; but
		 * at this point all variables with greater scope are hidden).
		 */
		if(self->visible && (self->scope == scope))
		{
#ifdef	CHECKED_BUILD
			conlPrintf(LOG_ERROR,already_defined,caller_name,identifier);
#endif	/* CHECKED_BUILD */
			return false;
		}
		self = etreeFindNextIdentifier(self->next,identifier);
	}
	self = NULL;
	/* check the consistency of the 'dimension' parameter */
	if(((dim2 > 1) && (dimension < 2)) ||
		((dim1 > 1) && (dimension < 1)))
	{
		ERROR_GENERIC(inconsistent_dimension);
		return false;
	}
	if(dimension > 2)
	{
		ERROR_GENERIC(dimension_too_high);
		return false;
	}
	if((dim1 * dim2 > 1) && typeid != TYPEID_INT && typeid != TYPEID_REAL)
	{
		ERROR_GENERIC(not_scalar);
		return false;
	}
	self = (etree_operand_p)memAllocZ(sizeof(etree_operand_t));
	self->identifier = strDup(identifier);
	self->typeid = typeid;
	self->dim1 = dim1;
	self->dim2 = dim2;
	self->dimension = dimension;
	self->size = type_info->size_of * dim1 * dim2;
	self->scope = scope;
	self->visible = true;
	self->next = *head;
	*head = self;
	return true;
}

/*
 * etreeFindIdentifier()
 */
V_LOCAL etree_operand_p
etreeFindIdentifier(etree_operand_p head,char *identifier)
{
	CALLER_NAME(etreeFindIdentifier)
	DEBUG_MESSAGE(outer_hidden,
		"%s(): variable \"%s\" with scope %u hides one with scope %u.\n")
	etree_operand_p ptr = NULL;
	head = etreeFindNextIdentifier(head,identifier);
	while(head)
	{
		if(head->visible)
		{
			if(!ptr)
				ptr = head;
			else
			{
#ifdef	CHECKED_BUILD
				u32_t min, max;
#endif	/* CHECKED_BUILD */
				PARANOID_ASSERT(ptr->scope != head->scope);
				if(head->scope < ptr->scope)
				{
					ptr = head;
#ifdef	CHECKED_BUILD
					min = head->scope;
					max = ptr->scope;
				}
				else
				{
					max = head->scope;
					min = ptr->scope;
#endif	/* CHECKED_BUILD */
				}
#ifdef	CHECKED_BUILD
				conlPrintf(LOG_ERROR,outer_hidden,caller_name,identifier,min,max);
#endif	/* CHECKED_BUILD */
			}
		}
		head = etreeFindNextIdentifier(head->next,identifier);
	}
	return ptr;
}

/*
 * etreeFreeIdentifiers()
 */
V_LOCAL void
etreeFreeIdentifiers(etree_operand_p head)
{
	etree_operand_p next;
	while(head)
	{
		if(head->identifier)
			memFree(head->identifier);
		next = head->next;
		memFree(head);
		head = next;
	}
}

/*
 * etreeHideIdentifiers()
 */
V_LOCAL void
etreeHideIdentifiers(etree_operand_p head,u32_t scope)
{
	while(head)
	{
		if(head->visible && (head->scope > scope))
			head->visible = false;
		head = head->next;
	}
}

/* -------------------------------------------------------------------- *\
						   Integer operations
\* -------------------------------------------------------------------- */

/*
 * Unary operations
 */
V_LOCAL void V_CALL
op_int_neg(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = - INT_EXIT(ctx);
}

/* type conversions */

V_LOCAL void V_CALL
op_real2int(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = (int)floor(REAL_EXIT(ctx));
}

V_LOCAL void V_CALL
op_string2int(etree_node_p root,etree_context_p ctx)
{
	s32_t ret;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_STRING);
	ET_EVAL(root->left,ctx);
	if(!esStringToInt(STRING_EXIT(ctx),&ret))
	{
#ifdef	CHECKED_BUILD
		conlPrintf(LOG_ERROR,
			"op_string2int(): unable to convert '%s'.\n",
			C_STR(STRING_EXIT(ctx)));
#endif	/* CHECKED_BUILD */
		INT_EXIT(ctx) = 0;
		ctx->conversion_error = true;
	}
	INT_EXIT(ctx) = (USL_INT)ret;
	CLEAR_STRING_EXIT(ctx);
}

/*
 * Binary operations
 */

V_LOCAL void V_CALL
op_int_add(etree_node_p root,etree_context_p ctx)
{
	int right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	ET_EVAL(root->right,ctx);
	right_val = INT_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) += right_val;
}

V_LOCAL void V_CALL
op_int_sub(etree_node_p root,etree_context_p ctx)
{
	int right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	ET_EVAL(root->right,ctx);
	right_val = INT_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) -= right_val;
}

V_LOCAL void V_CALL
op_int_mul(etree_node_p root,etree_context_p ctx)
{
	int right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	ET_EVAL(root->right,ctx);
	right_val = INT_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) *= right_val;
}

V_LOCAL void V_CALL
op_int_div(etree_node_p root,etree_context_p ctx)
{
	int right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	ET_EVAL(root->right,ctx);
	right_val = INT_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) /= right_val;
}

V_LOCAL void V_CALL
op_int_mod(etree_node_p root,etree_context_p ctx)
{
	int right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	ET_EVAL(root->right,ctx);
	right_val = INT_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) %= right_val;
}

/*
 * Boolean operations (int args).
 */

V_LOCAL void V_CALL
op_int_less(etree_node_p root,etree_context_p ctx)
{
	int right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	ET_EVAL(root->right,ctx);
	right_val = INT_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = (INT_EXIT(ctx) < right_val) ? 1 : 0;
}

V_LOCAL void V_CALL
op_int_greater(etree_node_p root,etree_context_p ctx)
{
	int right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	ET_EVAL(root->right,ctx);
	right_val = INT_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = (INT_EXIT(ctx) > right_val) ? 1 : 0;
}

V_LOCAL void V_CALL
op_int_equal(etree_node_p root,etree_context_p ctx)
{
	int right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	ET_EVAL(root->right,ctx);
	right_val = INT_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = (INT_EXIT(ctx) == right_val) ? 1 : 0;
}

V_LOCAL void V_CALL
op_int_not_equal(etree_node_p root,etree_context_p ctx)
{
	int right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	ET_EVAL(root->right,ctx);
	right_val = INT_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = (INT_EXIT(ctx) != right_val) ? 1 : 0;
}

V_LOCAL void V_CALL
op_int_less_or_equal(etree_node_p root,etree_context_p ctx)
{
	int right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	ET_EVAL(root->right,ctx);
	right_val = INT_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = (INT_EXIT(ctx) <= right_val) ? 1 : 0;
}

V_LOCAL void V_CALL
op_int_greater_or_equal(etree_node_p root,etree_context_p ctx)
{
	int right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_INT);
	PARANOID_RTTC(root->right,TYPEID_INT);
	ET_EVAL(root->right,ctx);
	right_val = INT_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = (INT_EXIT(ctx) >= right_val) ? 1 : 0;
}

/*
 * Boolean operations (real args).
 */

V_LOCAL void V_CALL
op_int_less_of_reals(etree_node_p root,etree_context_p ctx)
{
	USL_REAL right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->right,ctx);
	right_val = REAL_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = (REAL_EXIT(ctx) < right_val) ? 1 : 0;
}

V_LOCAL void V_CALL
op_int_greater_of_reals(etree_node_p root,etree_context_p ctx)
{
	USL_REAL right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->right,ctx);
	right_val = REAL_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = (REAL_EXIT(ctx) > right_val) ? 1 : 0;
}

V_LOCAL void V_CALL
op_int_equal_of_reals(etree_node_p root,etree_context_p ctx)
{
	USL_REAL right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->right,ctx);
	right_val = REAL_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = IsZero(REAL_EXIT(ctx) - right_val) ? 1 : 0;
}

V_LOCAL void V_CALL
op_int_not_equal_of_reals(etree_node_p root,etree_context_p ctx)
{
	USL_REAL right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->right,ctx);
	right_val = REAL_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = IsZero(REAL_EXIT(ctx) - right_val) ? 0 : 1;
}

V_LOCAL void V_CALL
op_int_greater_or_equal_of_reals(etree_node_p root,etree_context_p ctx)
{
	USL_REAL right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->right,ctx);
	right_val = REAL_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = ((REAL_EXIT(ctx) + FLOAT_ZERO_EPSILON) > right_val) ? 1 : 0;
}

V_LOCAL void V_CALL
op_int_less_or_equal_of_reals(etree_node_p root,etree_context_p ctx)
{
	USL_REAL right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->right,ctx);
	right_val = REAL_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = (REAL_EXIT(ctx) < (right_val + FLOAT_ZERO_EPSILON)) ? 1 : 0;
}

/*
 * Boolean operations (string args).
 */

V_LOCAL void V_CALL
op_int_equal_of_strings(etree_node_p root,etree_context_p ctx)
{
	estr_p right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_STRING);
	PARANOID_RTTC(root->right,TYPEID_STRING);
	ET_EVAL(root->right,ctx);
	right_val = STRING_EXIT(ctx);
	STRING_EXIT(ctx) = NULL; /* don't free it now */
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = strcmp(C_STR(STRING_EXIT(ctx)),C_STR(right_val)) ? 0 : 1;
	memFree(right_val);
	CLEAR_STRING_EXIT(ctx);
}

V_LOCAL void V_CALL
op_int_not_equal_of_strings(etree_node_p root,etree_context_p ctx)
{
	estr_p right_val;
	PARANOID_RTTC(root,TYPEID_INT);
	PARANOID_RTTC(root->left,TYPEID_STRING);
	PARANOID_RTTC(root->right,TYPEID_STRING);
	ET_EVAL(root->right,ctx);
	right_val = STRING_EXIT(ctx);
	STRING_EXIT(ctx) = NULL;
	ET_EVAL(root->left,ctx);
	INT_EXIT(ctx) = strcmp(C_STR(STRING_EXIT(ctx)),C_STR(right_val)) ? 1 : 0;
	memFree(right_val);
	CLEAR_STRING_EXIT(ctx);
}

/* -------------------------------------------------------------------- *\
						   Real operations
\* -------------------------------------------------------------------- */

/*
 * Unary operations
 */
V_LOCAL void V_CALL
op_real_neg(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) = - REAL_EXIT(ctx);
}

/* type conversions */

V_LOCAL void V_CALL
op_int2real(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_INT);
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) = (USL_REAL)INT_EXIT(ctx);
}

V_LOCAL void V_CALL
op_string2real(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_STRING);
	ET_EVAL(root->left,ctx);
	if(!esStringToFloat(STRING_EXIT(ctx),&REAL_EXIT(ctx)))
	{
#ifdef	CHECKED_BUILD
		conlPrintf(LOG_ERROR,
			"op_string2real(): unable to convert '%s'.\n",
			STRING_EXIT(ctx)->data);
#endif	/* CHECKED_BUILD */
		REAL_EXIT(ctx) = 0;
		ctx->conversion_error = true;
	}
	CLEAR_STRING_EXIT(ctx);
}

/*
 * Math functions
 */
V_LOCAL void V_CALL
op_real_sin(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) = (USL_REAL)sin(REAL_EXIT(ctx));
}

V_LOCAL void V_CALL
op_real_cos(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) = (USL_REAL)cos(REAL_EXIT(ctx));
}

V_LOCAL void V_CALL
op_real_exp(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) = (USL_REAL)exp(REAL_EXIT(ctx));
}

V_LOCAL void V_CALL
op_real_ln(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) = (USL_REAL)log(REAL_EXIT(ctx));
}

#define	RLN_10	(USL_REAL)(0.43429448190325182765112891891661)

V_LOCAL void V_CALL
op_real_lg(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) = RLN_10 * (USL_REAL)log(REAL_EXIT(ctx));
}

/*
 * Binary operations
 */

V_LOCAL void V_CALL
op_real_add(etree_node_p root,etree_context_p ctx)
{
	USL_REAL right_val;
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->right,ctx);
	right_val = REAL_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) += right_val;
}

V_LOCAL void V_CALL
op_real_sub(etree_node_p root,etree_context_p ctx)
{
	USL_REAL right_val;
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->right,ctx);
	right_val = REAL_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) -= right_val;
}

V_LOCAL void V_CALL
op_real_mul(etree_node_p root,etree_context_p ctx)
{
	USL_REAL right_val;
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->right,ctx);
	right_val = REAL_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) *= right_val;
}

V_LOCAL void V_CALL
op_real_div(etree_node_p root,etree_context_p ctx)
{
	USL_REAL right_val;
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->right,ctx);
	right_val = REAL_EXIT(ctx);
 /* fixme: must we catch zero-divide ? */
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) /= right_val;
}

V_LOCAL void V_CALL
op_real_mod(etree_node_p root,etree_context_p ctx)
{
	USL_REAL right_val;
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->right,ctx);
	right_val = REAL_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) = (USL_REAL)fmod(REAL_EXIT(ctx),right_val);
}

V_LOCAL void V_CALL
op_real_pow(etree_node_p root,etree_context_p ctx)
{
	USL_REAL right_val;
	PARANOID_RTTC(root,TYPEID_REAL);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->right,ctx);
	right_val = REAL_EXIT(ctx);
	ET_EVAL(root->left,ctx);
	REAL_EXIT(ctx) = (USL_REAL)pow(REAL_EXIT(ctx),right_val);
}

/* -------------------------------------------------------------------- *\
						   String operations
\* -------------------------------------------------------------------- */

/*
 * Type conversions
 */

V_LOCAL void V_CALL
op_int2string(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_STRING);
	PARANOID_RTTC(root->left,TYPEID_INT);
	ET_EVAL(root->left,ctx);
	STRING_EXIT(ctx) = esIntToString(INT_EXIT(ctx));
}

V_LOCAL void V_CALL
op_real2string(etree_node_p root,etree_context_p ctx)
{
	PARANOID_RTTC(root,TYPEID_STRING);
	PARANOID_RTTC(root->left,TYPEID_REAL);
	ET_EVAL(root->left,ctx);
	STRING_EXIT(ctx) = esRealToString(REAL_EXIT(ctx));
}

/*
 * Binary operations
 */

V_LOCAL void V_CALL
op_int2string_fmt(etree_node_p root,etree_context_p ctx)
{
	estr_p fmt;
	PARANOID_RTTC(root,TYPEID_STRING);
	PARANOID_RTTC(root->left,TYPEID_STRING);
	PARANOID_RTTC(root->right,TYPEID_INT);
	ET_EVAL(root->left,ctx);
	fmt = STRING_EXIT(ctx);
	STRING_EXIT(ctx) = NULL;
	ET_EVAL(root->right,ctx);
	STRING_EXIT(ctx) = esIntToStringEx(C_STR(fmt),INT_EXIT(ctx));
	memFree(fmt);
}

V_LOCAL void V_CALL
op_real2string_fmt(etree_node_p root,etree_context_p ctx)
{
	estr_p fmt;
	PARANOID_RTTC(root,TYPEID_STRING);
	PARANOID_RTTC(root->left,TYPEID_STRING);
	PARANOID_RTTC(root->right,TYPEID_REAL);
	ET_EVAL(root->left,ctx);
	fmt = STRING_EXIT(ctx);
	STRING_EXIT(ctx) = NULL;
	ET_EVAL(root->right,ctx);
	STRING_EXIT(ctx) = esRealToStringEx(C_STR(fmt),REAL_EXIT(ctx));
	memFree(fmt);
}

V_LOCAL void V_CALL
op_string_cat(etree_node_p root,etree_context_p ctx)
{ 
	estr_p right;
	PARANOID_RTTC(root,TYPEID_STRING);
	PARANOID_RTTC(root->left,TYPEID_STRING);
	PARANOID_RTTC(root->right,TYPEID_STRING);
	ET_EVAL(root->right,ctx);
	right = STRING_EXIT(ctx);
	STRING_EXIT(ctx) = NULL;
	ET_EVAL(root->left,ctx);
	STRING_EXIT(ctx) = esCatenateString(STRING_EXIT(ctx),right);
	memFree(right);
}

/*
 * Destructor of evaluation tree
 */
V_LOCAL void
etreeDestroy(etree_node_p root)
{
	typeinfo_p root_info;
	if(root->left)
		etreeDestroy(root->left);
	if(root->right)
		etreeDestroy(root->right);
	root_info = typeGetInfo(root->typeid);
	PARANOID_ASSERT(root_info);
	if(root_info->specific.destruct)
		(*root_info->specific.destruct)(root);
	memFree(root);
}

/*
 * Constants and variables, arrays
 */

V_LOCAL etree_node_p
etreeAllocVarNode(etree_operand_p var_ptr)
{
	etree_node_p node = (etree_node_p)memAllocZ(sizeof(etree_node_t));
	if(var_ptr)
	{
		node->var_ptr = var_ptr;
		node->typeid = var_ptr->typeid;
		node->dimension = var_ptr->dimension;
		node->dim1 = var_ptr->dim1;
		node->dim2 = var_ptr->dim2;
	}
	node->base = NULL;
	node->relocated = false;
	return node;
}

/*
 * Leaf: constant
 */
V_LOCAL etree_node_p
etreeConstantLeaf(u32_t typeid,void *data)
{
	CALLER_NAME(etreeConstantLeaf)
	typeinfo_p info;
	etree_node_p leaf;
	info = typeGetInfo(typeid);
	if(!info)
	{
		ERROR_GENERIC("constant of unknown type");
		return NULL;
	}
	leaf = etreeAllocVarNode(NULL);
	leaf->typeid = typeid;
	leaf->dimension = 0;
	leaf->dim1 = leaf->dim2 = 1;
	leaf->op_ptr = info->specific.op_const;
	leaf->relocated = true; /* don't need to be relocated */
	memCopy(leaf->constant.const_data,data,info->size_of);
	/* fixme: should we call constructor ? */
	return leaf;
}

/*
 * Integer constant (leaf)
 */
V_LOCAL etree_node_p
etreeIntConst(int constant)
{
	return etreeConstantLeaf(TYPEID_INT,&constant);
}

/*
 * Real constant (leaf)
 */
V_LOCAL etree_node_p
etreeRealConst(USL_REAL constant)
{
	return etreeConstantLeaf(TYPEID_REAL,&constant);
}

/*
 * String constant (leaf)
 */
V_LOCAL etree_node_p
etreeStringConst(char *constant)
{
	estr_p str = esNewString(constant);
	return etreeConstantLeaf(TYPEID_STRING,&str);
}

/*
 * Variable (leaf / node)
 */
V_LOCAL etree_node_p
etreeVariableNodeOrLeaf(etree_operand_p var_ptr)
{
	CALLER_NAME(etreeVariableNodeOrLeaf)
	typeinfo_p info;
	etree_node_p node;
	info = typeGetInfo(var_ptr->typeid);
	if(!info)
	{
		ERROR_GENERIC("unknown type");
		return NULL;
	}
	node = etreeAllocVarNode(var_ptr);
	PARANOID_ASSERT(node->dimension <= 2);
	switch(node->dimension)
	{
		case 2:
			node->op_ptr = info->specific.op_access_2d;
			break;
		case 1:
			node->op_ptr = info->specific.op_access_1d;
			break;
		default:
			node->op_ptr = info->specific.op_access_scalar;
	}
	return node;
}

V_LOCAL vboolean
etreeConvertToLValue(etree_node_p node)
{
	CALLER_NAME(etreeConvertToLValue)
	typeinfo_p info;
	info = typeGetInfo(node->typeid);
	if(!info)
	{
		ERROR_GENERIC("unable to convert variable of unknown type to lvalue");
		return false;
	}
	if(ETREE_CONST(node))
	{
		ERROR_GENERIC("unable to convert constant to lvalue");
		return false;
	}
	switch(node->dimension)
	{
		case 2:
			node->op_ptr = info->specific.op_assign_2d;
			break;
		case 1:
			node->op_ptr = info->specific.op_assign_1d;
			break;
		default:
			node->op_ptr = info->specific.op_assign_scalar;
	}
	return true;
}

/*
 * etreeGetTosTypeIds()
 * Stores typeid of TOS[0] in ids_ret[0], of TOS[1] - in ids_ret[1].
 * Returns number of stored typeids.
 */
V_LOCAL u32_t
etreeGetTosTypeIds(vp_stack_p parse_op_stack,u32_t ids_ret[])
{
	u32_t i, ps_len, limit;
	ps_len = vpsCount(parse_op_stack);
	ids_ret[0] = ids_ret[1] = TYPEID_NULL;
	limit = (ps_len > 2) ? 2 : ps_len;
	for(i = 0;i < limit;i++)
		ids_ret[i] = ((etree_node_p)vpsGet(parse_op_stack,ps_len - 1 - i))->typeid;
	return limit;
}

/*
 * etreeNewVariable()
 * Int / real / string variable / array access
 */
V_LOCAL vboolean
etreeNewVariable(etree_operand_p var_ptr,vp_stack_p parse_op_stack)
{
	CALLER_NAME(etreeNewVariable)
	u32_t tos_len;
	etree_node_p this_node;
	u32_t tos_typeids[2];
	this_node = etreeVariableNodeOrLeaf(var_ptr);
	PARANOID_ASSERT(this_node);
	if(!this_node->dimension)
	{
		/* scalar variable */
		vpsPush(parse_op_stack,this_node);
		return true;
	}
	/* try to get operands */
	tos_len = etreeGetTosTypeIds(parse_op_stack,tos_typeids);
	if(this_node->dimension > tos_len)
	{
		ERROR_GENERIC("not enought indices to access element of array");
		goto err_exit;
	}
	switch(this_node->dimension)
	{
		case 1:
			if(tos_typeids[0] != TYPEID_INT)
			{
				ERROR_GENERIC("type mismatch (array index has to be integer)");
				goto err_exit;
			}
			vpsPop(parse_op_stack,&this_node->left);
			vpsPush(parse_op_stack,this_node);
			return true;
		case 2:
			if(tos_typeids[0] != TYPEID_INT)
			{
				ERROR_GENERIC("type mismatch (column index has to be integer)");
				goto err_exit;
			}
			if(tos_typeids[1] != TYPEID_INT)
			{
				ERROR_GENERIC("type mismatch (row index has to be integer)");
				goto err_exit;
			}
			vpsPop(parse_op_stack,&this_node->right);
			vpsPop(parse_op_stack,&this_node->left);
			vpsPush(parse_op_stack,this_node);
			return true;
		default:
			/* arrays of other types not supported */
			PARANOID_ASSERT(0);
			break;
	}
err_exit:;
	etreeDestroy(this_node);
	return false;
}

/*
 * Known nodal operations (requires no 'constant' field in etree_node_t)
 */
V_LOCAL nodal_operation_t known_nodal_operations[] =
{
	{"neg",op_int_neg,TYPEID_INT,TYPEID_INT,TYPEID_NULL,"negates int tos[0]"},
	{"int",op_real2int,TYPEID_INT,TYPEID_REAL,TYPEID_NULL,"real->int conversion"},
	{"int",op_string2int,TYPEID_INT,TYPEID_STRING,TYPEID_NULL,"string->int conversion"},
	{"+",op_int_add,TYPEID_INT,TYPEID_INT,TYPEID_INT,"int tos[0] = int tos[1] + int tos[0]"},
	{"-",op_int_sub,TYPEID_INT,TYPEID_INT,TYPEID_INT,"int tos[0] = int tos[1] - int tos[0]"},
	{"*",op_int_mul,TYPEID_INT,TYPEID_INT,TYPEID_INT,"int tos[0] = int tos[1] * int tos[0]"},
	{"/",op_int_div,TYPEID_INT,TYPEID_INT,TYPEID_INT,"int tos[0] = int tos[1] / int tos[0]"},
	{"%",op_int_mod,TYPEID_INT,TYPEID_INT,TYPEID_INT,"int tos[0] = int tos[1] % int tos[0]"},
	{"<",op_int_less,TYPEID_INT,TYPEID_INT,TYPEID_INT,"int tos[0] = (int tos[0] < int tos[1]) ? 1 : 0"},
	{">",op_int_greater,TYPEID_INT,TYPEID_INT,TYPEID_INT,"int tos[0] = (int tos[0] > int tos[1]) ? 1 : 0"},
	{"==",op_int_equal,TYPEID_INT,TYPEID_INT,TYPEID_INT,"int tos[0] = (int tos[0] == int tos[1]) ? 1 : 0"},
	{"!=",op_int_not_equal,TYPEID_INT,TYPEID_INT,TYPEID_INT,"int tos[0] = (int tos[0] != int tos[1]) ? 1 : 0"},
	{"<=",op_int_less_or_equal,TYPEID_INT,TYPEID_INT,TYPEID_INT,"int tos[0] = (int tos[0] <= int tos[1]) ? 1 : 0"},
	{">=",op_int_greater_or_equal,TYPEID_INT,TYPEID_INT,TYPEID_INT,"int tos[0] = (int tos[0] >= int tos[1]) ? 1 : 0"},
	{"<",op_int_less_of_reals,TYPEID_INT,TYPEID_REAL,TYPEID_REAL,"int tos[0] = (real tos[0] < real tos[1]) ? 1 : 0"},
	{">",op_int_greater_of_reals,TYPEID_INT,TYPEID_REAL,TYPEID_REAL,"int tos[0] = (real tos[0] > real tos[1]) ? 1 : 0"},
	{"==",op_int_equal_of_reals,TYPEID_INT,TYPEID_REAL,TYPEID_REAL,"int tos[0] = (real tos[0] almost_equal_to real tos[1]) ? 1 : 0"},
	{"!=",op_int_not_equal_of_reals,TYPEID_INT,TYPEID_REAL,TYPEID_REAL,"int tos[0] = (real tos[0] almost_equal_to real tos[1]) ? 0 : 1"},
	{">=",op_int_greater_or_equal_of_reals,TYPEID_INT,TYPEID_REAL,TYPEID_REAL,"int tos[0] = (real tos[0] >= real tos[1]) ? 1 : 0"},
	{"<=",op_int_less_or_equal_of_reals,TYPEID_INT,TYPEID_REAL,TYPEID_REAL,"int tos[0] = (real tos[0] <= real tos[1]) ? 1 : 0"},
	{"==",op_int_equal_of_strings,TYPEID_INT,TYPEID_STRING,TYPEID_STRING,"int tos[0] = (string tos[0] == string tos[1]) ? 1 : 0"},
	{"!=",op_int_not_equal_of_strings,TYPEID_INT,TYPEID_STRING,TYPEID_STRING,"int tos[0] = (string tos[0] != string tos[1]) ? 1 : 0"},
	{"neg",op_real_neg,TYPEID_REAL,TYPEID_REAL,TYPEID_NULL,"negates real tos[0]"},
	{"real",op_int2real,TYPEID_REAL,TYPEID_INT,TYPEID_NULL,"int->real conversion"},
	{"real",op_string2real,TYPEID_REAL,TYPEID_STRING,TYPEID_NULL,"string->real conversion"},
	{"sin",op_real_sin,TYPEID_REAL,TYPEID_REAL,TYPEID_NULL,"real sin(real tos[0])"},
	{"cos",op_real_cos,TYPEID_REAL,TYPEID_REAL,TYPEID_NULL,"real cos(real tos[0])"},
	{"exp",op_real_exp,TYPEID_REAL,TYPEID_REAL,TYPEID_NULL,"real exp(real tos[0])"},
	{"ln",op_real_ln,TYPEID_REAL,TYPEID_REAL,TYPEID_NULL,"real (base e) ln(real tos[0])"},
	{"lg",op_real_lg,TYPEID_REAL,TYPEID_REAL,TYPEID_NULL,"real (base 10) lg(real tos[0])"},
	{"+",op_real_add,TYPEID_REAL,TYPEID_REAL,TYPEID_REAL,"real tos[0] = real tos[1] + real tos[0]"},
	{"-",op_real_sub,TYPEID_REAL,TYPEID_REAL,TYPEID_REAL,"real tos[0] = real tos[1] - real tos[0]"},
	{"*",op_real_mul,TYPEID_REAL,TYPEID_REAL,TYPEID_REAL,"real tos[0] = real tos[1] * real tos[0]"},
	{"/",op_real_div,TYPEID_REAL,TYPEID_REAL,TYPEID_REAL,"real tos[0] = real tos[1] / real tos[0]"},
	{"%",op_real_mod,TYPEID_REAL,TYPEID_REAL,TYPEID_REAL,"real tos[0] = real tos[1] % real tos[0]"},
	{"^",op_real_pow,TYPEID_REAL,TYPEID_REAL,TYPEID_REAL,"real tos[0] = real tos[1] ^ real tos[0]"},
	{"string",op_int2string,TYPEID_STRING,TYPEID_INT,TYPEID_NULL,"int->string conversion"},
	{"string",op_real2string,TYPEID_STRING,TYPEID_REAL,TYPEID_NULL,"real->string conversion"},
	{"format",op_int2string_fmt,TYPEID_STRING,TYPEID_STRING,TYPEID_INT,"int->string conversion using format in tos[1]"},
	{"format",op_real2string_fmt,TYPEID_STRING,TYPEID_STRING,TYPEID_REAL,"real->string conversion using format in tos[1]"},
	{"+",op_string_cat,TYPEID_STRING,TYPEID_STRING,TYPEID_STRING,"string tos[0] = string tos[1] catenate string tos[0]"},
	{NULL,NULL,TYPEID_NULL,TYPEID_NULL,TYPEID_NULL,NULL}
};

/*
 * Returns: -1: operation not found.
 */
V_LOCAL int
etreeFindOpIndex(nodal_operation_p ops,char *op_name,
	u32_t typeid_left,u32_t typeid_right)
{
	CALLER_NAME(etreeFindOpNode)
	int i, idx = -1;
	for(i = 0;ops[i].op_name;i++)
	{
		if(STR_EQ(ops[i].op_name,op_name) &&
			(ops[i].typeid_left == typeid_left) &&
			(ops[i].typeid_right == typeid_right))
		{
			if(idx != -1)
			{
#ifdef	CHECKED_BUILD
				conlPrintf(LOG_WARNING,
					"%s():operation\n\"%s\" (%s);\nhides operation\n\"%s\" (%s).\n",
					caller_name,
					ops[i].op_name,ops[i].op_desc,
					ops[idx].op_name,ops[idx].op_desc);
#endif	/* CHECKED_BUILD */
			}
			idx = i;
			/* don't break the loop since we want to see all possible warnings */
		}
	}
	return idx;
}

V_LOCAL etree_node_p
etreeAllocOpNode(nodal_operation_p ops,int idx)
{
	etree_node_p node = (etree_node_p)memAllocZ(sizeof(etree_node_t));
	PARANOID_ASSERT(ops);
	node->typeid = ops[idx].typeid_self;
	node->op_ptr = ops[idx].op_func;
	node->relocated = true;
	return node;
}

V_LOCAL vboolean
etreeNewOperation(nodal_operation_p ops,char *op_name,vp_stack_p parse_op_stack)
{
	CALLER_NAME(etreeNewOperation)
	DEBUG_MESSAGE(unknown_unary_op,
		"%s(): no \"%s\" operation defined for \"%s\" argument.\n")
	DEBUG_MESSAGE(unknown_binary_op,
		"%s(): ERROR: no \"%s\" operation defined for "
		"\"%s\" and \"%s\" arguments.\n")
	int idx;
	etree_node_p this_node;
	u32_t tos_typeids[2];
	u32_t tos_len = etreeGetTosTypeIds(parse_op_stack,tos_typeids);
	if(tos_len < 1)
	{
		ERROR_GENERIC("not enought operands");
		/* no operands available on the stack: there can be no operation */
		return false;
	}
	/*
	 * Try to find unary operation; if not found, try binary.
	 * Note that for unary operation we use tos[0] as _left_ child;
	 * for binary one, the first operand is tos[1] and it has to
	 * become _left_ child, while tos[0] has to become _right_.
	 */
	idx = etreeFindOpIndex(ops,op_name,tos_typeids[0],TYPEID_NULL);
	if(idx != -1)
	{
		this_node = etreeAllocOpNode(ops,idx);
		vpsPop(parse_op_stack,&this_node->left);
		vpsPush(parse_op_stack,this_node);
		return true;
	}
	if(tos_typeids[1] != TYPEID_NULL)
		idx = etreeFindOpIndex(ops,op_name,tos_typeids[1],tos_typeids[0]);
	if(idx == -1)
	{
#ifdef	CHECKED_BUILD
		if(tos_typeids[1] != TYPEID_NULL)
			conlPrintf(LOG_ERROR,unknown_binary_op,caller_name,op_name,
				typeGetName(tos_typeids[1]),typeGetName(tos_typeids[0]));
		else
			conlPrintf(LOG_ERROR,unknown_unary_op,caller_name,op_name,
				typeGetName(tos_typeids[0]));
#endif	/* CHECKED_BUILD */
		return false;
	}
	this_node = etreeAllocOpNode(ops,idx);
	vpsPop(parse_op_stack,&this_node->right);
	vpsPop(parse_op_stack,&this_node->left);
	vpsPush(parse_op_stack,this_node);
	return true;
}

/*
 * etreeCreateNodeOrLeaf()
 * Reads description of the next operation / operand, creates new
 * etree_node, connects children to it, removes children from stack
 * and replaces TOS with newly created node.
 */
V_LOCAL vboolean
etreeCreateNodeOrLeaf(nodal_operation_p ops, /* known nodal operations */
	vhandle_t lexer, /* input script */
	etree_operand_p variables, /* known identifiers (no relocation information necessary) */
	vp_stack_p parse_op_stack) /* stack of nodes / leafs */
{
	CALLER_NAME(etreeCreateNodeOrLeaf)
	s32_t int_val;
	USL_REAL real_val;
	char *token;
	etree_operand_p var_ptr;
	etree_node_p this_node = NULL;
	/* we need it to decide wheither or not token is a string constant */
	PARANOID_ASSERT(lexIsEnabled(lexer,LEX_QUOTES_RETURNING));
	token = lexLast(lexer);
	PARANOID_ASSERT(token);
	/* is it a direct string constant ? */
	if(token[0] == '"' && !token[1])
	{
		token = lexNext(lexer);
		if(token)
		{
			this_node = etreeStringConst(token);
			vpsPush(parse_op_stack,this_node);
			/* skip closing quote (it always present or the token == NULL) */
			lexNext(lexer);
			return true;
		}
		SYN_UNEXPECTED_EOF(lexer);
		return false;
	}
	/* is it a direct int / real constant ? */
	if(strToInt(token,&int_val))
	{
		this_node = etreeIntConst(int_val);
		vpsPush(parse_op_stack,this_node);
		return true;
	}
	if(strToFloat(token,&real_val))
	{
		this_node = etreeRealConst(real_val);
		vpsPush(parse_op_stack,this_node);
		return true;
	}
	/* is it a variable ? */
	var_ptr = etreeFindIdentifier(variables,token);
	if(var_ptr)
	{
		if(!etreeNewVariable(var_ptr,parse_op_stack))
			return false;
		return true;
	}
	/* all failed; it has to be an operation */
	if(!etreeNewOperation(ops,token,parse_op_stack))
		return false;
	return true;
}

/* -------------------------------------------------------------------- */

/*
 * etreeParseRPN()
 *
 * Using 'lexer' as a lexer, constructs expression tree
 * from its reverse polish notation. All known variables
 * had to be stored in 'known_variables' _prior_ to this call.
 *
 * Fixme: we have to merge all tokens between commas and threat them as
 * _one_ single token (though, this is unimportant for C syntax, so
 * I don't bother)
 */

V_LOCAL etree_node_p
etreeParseRPN(nodal_operation_p ops, /* known nodal operations */
	vhandle_t lexer, /* input script */
	etree_operand_p known_variables) /* known identifiers (no relocation information */
{
	CALLER_NAME(etreeParseRPN)
	char *token;
	etree_node_p self, dummy;
	vp_stack_t nodes = TYPED_STACK_EMPTY_INITIALIZER;
	vboolean expect_token = true;
	vboolean parse_error = false;
	for(;;)
	{
		token = lexNext(lexer);
		if(!token || STR_EQ(token,")"))
		{
			if(expect_token)
			{
				SYN_EXPECTED(lexer,"<variable> | <constant> | <operator>");
				parse_error = true;
			}
			break;
		}
		if(STR_EQ(token,",")) /* delimiter */
		{
			if(expect_token)
			{
				SYN_EXPECTED(lexer,"<variable> | <constant> | <operator>");
				parse_error = true;
				break;
			}
			expect_token = true;
			continue;
		}
		expect_token = false;
		if(!etreeCreateNodeOrLeaf(ops,lexer,known_variables,&nodes))
		{
			parse_error = true;
			break;
		}
	}
	if(parse_error)
	{
		while(vpsPop(&nodes,(void_p)&dummy))
			etreeDestroy(dummy);
		return NULL;
	}
	if(vpsCount(&nodes) > 1)
	{
		conlPrintf(LOG_WARNING,"%s(): %u unused operand(s).\n",
			caller_name,vpsCount(&nodes) - 1);
	} else if(vpsCount(&nodes) == 0)
	{
		PARSE_ERROR(lexer,"empty expression");
		return NULL;
	}
	vpsPop(&nodes,(void_p)&self);
	while(vpsPop(&nodes,(void_p)&dummy))
		etreeDestroy(dummy);
	vpsClear(&nodes);
	return self;
}

/*
 * Wrapper for the above routine.
 * Note: assumes the first token (usually, but not always, it is '(')
 * was already read in.
 */
V_LOCAL etree_node_p
etreeParseExpression(nodal_operation_p ops,
	vhandle_t lexer,
	etree_operand_p variables)
{
	CALLER_NAME(etreeParseExpression)
	char *token;
	etree_node_p expr;
	etree_operand_p var_ptr;
	s32_t int_val;
	vec_t real_val;
	token = lexLast(lexer);
	if(!token)
	{
		SYN_UNEXPECTED_EOF(lexer);
		return NULL;
	}
	if(STR_EQ(token,"("))
	{
		/* RPN expression */
		expr = etreeParseRPN(ops,lexer,variables);
		if(expr && !lexLastWas(lexer,")"))
		{
			SYN_EXPECTED(lexer,")");
			etreeDestroy(expr);
			expr = NULL;
		}
	}
	else
	{
		/* big todo: reparse infix notation to RPN */
		var_ptr = etreeFindIdentifier(variables,token);
		if(var_ptr) {
			/* variable */
			vp_stack_t tmp = TYPED_STACK_EMPTY_INITIALIZER;
			if(etreeNewVariable(var_ptr,&tmp) && vpsCount(&tmp))
			{
				vpsPop(&tmp,&expr);
				vpsClear(&tmp);
				return expr;
			}
			return NULL;
		} else if(token[0] == '"' && !token[1]) {
			/* string constant */
			token = lexNext(lexer);
			if(!token)
			{
				SYN_UNEXPECTED_EOF(lexer);
				return NULL;
			}
			expr = etreeStringConst(token);
			/* skip closing quote (it always present or the token == NULL) */
			lexNext(lexer);
		} else if(strToInt(token,&int_val)) {
			/* integer constant */
			expr = etreeIntConst((USL_INT)int_val);
		} else if(strToFloat(token,&real_val)) {
			/* real constant */
			expr = etreeRealConst((USL_REAL)real_val);
		} else {
			/* unknown token */
			SYN_EXPECTED(lexer,"(");
			return NULL;
		}
	}
	return expr;
}

/*
 * Finds offset of the variable corresponding to 'var_ptr' in pool
 * and stores it in 'base' field of the node.
 */
V_LOCAL vboolean
etreeRelocateNode(etree_node_p node,etree_operand_p head,etree_context_p ctx)
{
	CALLER_NAME(etreeRelocateNode)
	DEBUG_MESSAGE(unknown_type,"unable to relocate variable of unknown type")
	u32_t offset;
	PARANOID_ASSERT(node->var_ptr); /* should be variable */
	/* reserve space for scalar exit code */
	offset = typeGetSize(node->var_ptr->typeid);
	if(!offset)
	{
		ERROR_GENERIC(unknown_type);
		return false;
	}
	if(node->relocated)
		return true;
	while(head != node->var_ptr)
	{
		if(head->typeid == node->var_ptr->typeid)
			offset += head->size;
		head = head->next;
	}
	if(head == node->var_ptr)
	{
		/* note: don't set the 'relocated' flag */
		node->base = (u8_p)(ctx->pools[node->typeid]) + offset;
		return true;
	}
	return false;
}

/*
 * Relocation routine. Traverses the tree computing offsets of variables.
 * Assumes that for each varibale 'size' field is correct.
 */
V_LOCAL vboolean
etreeRelocateExpression(etree_node_p root,etree_operand_p variables,
	etree_context_p ctx)
{
	if(root->left && !etreeRelocateExpression(root->left,variables,ctx))
		return false;
	if(root->right && !etreeRelocateExpression(root->right,variables,ctx))
		return false;
	if(root->var_ptr && !etreeRelocateNode(root,variables,ctx))
		return false;
	return true;
}

/*
 * Initializes evaluation context for given set of variables
 */
V_LOCAL etree_context_p
etreeCreateContext(etree_operand_p variables)
{
	u32_t pool_size;
	u32_t typeid = 1; /* zero position is reserved */
	typeinfo_p info;
	etree_operand_p ptr;
	etree_context_p ctx = (etree_context_p)memAllocZ(sizeof(etree_context_t));
	EVAL_CONTEXT_DEFAULT_STATE(ctx);
	for(;(info = typeGetInfo(typeid)) != NULL;typeid++)
	{
		pool_size = info->size_of; /* reserve space for exit code */
		ptr = variables;
		while(ptr)
		{
			if(ptr->typeid == typeid)
				pool_size += ptr->size;
			ptr = ptr->next;
		}
		ctx->pools[typeid] = memAllocZ(pool_size);
	}
	/* string variables will be created at first access */
	return ctx;
}

V_LOCAL void
etreeFreeContext(etree_context_p ctx)
{
	u32_t typeid = 1;
	typeinfo_p info;
	CLEAR_STRING_EXIT(ctx);
	/* at this point all string variables must be free()d */
	for(;(info = typeGetInfo(typeid)) != NULL;typeid++)
	{
		memFree(ctx->pools[typeid]);
	}
	memFree(ctx);
}

/*
 * etreeOptimizeUnary()
 */
V_LOCAL void
etreeOptimizeUnary(etree_node_p node,etree_context_p ctx)
{
	typeinfo_p info = typeGetInfo(node->typeid);
	if(!info)
		return;
	if(!ETREE_CONST(node->left))
		return;
	ET_EVAL(node,ctx);
	node->op_ptr = info->specific.op_const;
	memCopy(node->constant.const_data,ctx->pools[node->typeid],info->size_of);
	memZero(ctx->pools[node->typeid],info->size_of);
	etreeDestroy(node->left);
	node->left = NULL;
}

/*
 * etreeOptimize1DArrayAccess()
 */
V_LOCAL void
etreeOptimize1DArrayAccess(etree_node_p node)
{
	typeinfo_p info = typeGetInfo(node->typeid);
	if(!info)
		return;
	if(!ETREE_CONST(node->left))
		return;
	if((node->op_ptr != info->specific.op_access_1d) &&
		(node->op_ptr != info->specific.op_assign_1d))
		return;
	PARANOID_ASSERT(node->left->typeid == TYPEID_INT);
	etreeDestroy(node->left);
	node->left = NULL;
	node->dimension = 0;
	node->dim1 = 1;
	if(node->op_ptr == info->specific.op_access_1d)
		node->op_ptr = info->specific.op_access_scalar;
	else
		node->op_ptr = info->specific.op_assign_scalar;
	node->base = (u8_p)node->base +
		node->left->constant.int_const * info->size_of;
}

/*
 * etreeOptimize2DArrayAccess()
 */
V_LOCAL void
etreeOptimize2DArrayAccess(etree_node_p node)
{
	u32_t delta;
	typeinfo_p info = typeGetInfo(node->typeid);
	if(!info)
		return;
	if((node->op_ptr != info->specific.op_access_2d) &&
		(node->op_ptr != info->specific.op_assign_2d))
		return;
	if(ETREE_CONST(node->left) && ETREE_CONST(node->right))
	{
		PARANOID_ASSERT(node->left->typeid == TYPEID_INT);
		PARANOID_ASSERT(node->right->typeid == TYPEID_INT);
		delta = node->left->constant.int_const * node->dim1 + 
			node->right->constant.int_const;
		etreeDestroy(node->left);
		etreeDestroy(node->right);
		node->left = node->right = NULL;
		node->dimension = 0;
		node->dim1 = node->dim2 = 1;
		if(node->op_ptr == info->specific.op_access_2d)
			node->op_ptr = info->specific.op_access_scalar;
		else
			node->op_ptr = info->specific.op_assign_scalar;
		node->base = (u8_p)node->base + delta * info->size_of;
		return;
	}
	if(ETREE_CONST(node->left))
	{
		/* convert to 1D array access */
		PARANOID_ASSERT(node->left->typeid == TYPEID_INT);
		delta = node->left->constant.int_const * node->dim1;
		etreeDestroy(node->left);
		node->left = node->right;
		node->right = NULL;
		node->dimension = 1;
		node->dim1 = node->dim2;
		node->dim2 = 1;
		if(node->op_ptr == info->specific.op_access_2d)
			node->op_ptr = info->specific.op_access_1d;
		else
			node->op_ptr = info->specific.op_assign_1d;
		node->base = (u8_p)node->base + delta * info->size_of;
	}
}

/*
 * etreeOptimizeBinary()
 */
V_LOCAL void
etreeOptimizeBinary(etree_node_p node,etree_context_p ctx)
{
	typeinfo_p info = typeGetInfo(node->typeid);
	if(!info)
		return;
	if(!ETREE_CONST(node->left) || !ETREE_CONST(node->right))
		return;
	ET_EVAL(node,ctx);
	node->op_ptr = info->specific.op_const;
	memCopy(node->constant.const_data,ctx->pools[node->typeid],info->size_of);
	memZero(ctx->pools[node->typeid],info->size_of);
	etreeDestroy(node->left);
	etreeDestroy(node->right);
	node->left = node->right = NULL;
}

/*
 * etreeOptimizeExpression_r()
 * Requires relocation information, but do _not_ requires full-sized pools.
 */
V_LOCAL void
etreeOptimizeExpression_r(etree_node_p root,etree_context_p ctx)
{
	if(!root->left /* && !root->right */)
		return; /* constant or scalar variable - nothing to do */
	/* optimize children first */
	etreeOptimizeExpression_r(root->left,ctx);
	if(!root->right)
	{
		/* unary /  1D array access */
		if(root->var_ptr)
			etreeOptimize1DArrayAccess(root);
		else
			etreeOptimizeUnary(root,ctx);
		return;
	}
	/* binary /  2D array access */
	etreeOptimizeExpression_r(root->right,ctx);
	if(root->var_ptr)
		etreeOptimize2DArrayAccess(root);
	else
		etreeOptimizeBinary(root,ctx);
}

/*
 * etreeOptimizeExpression()
 */
V_LOCAL void
etreeOptimizeExpression(etree_node_p root)
{
	CALLER_NAME(etreeOptimizeExpression)
	typeinfo_p info;
	etree_context_p ctx;
	info = typeGetInfo(root->typeid);
	if(!info)
	{
		ERROR_GENERIC("unable to optimize expression of unknown type");
		return;
	}
	ctx = etreeCreateContext(NULL);
	etreeOptimizeExpression_r(root,ctx);
	etreeFreeContext(ctx);
}

/*
 * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 * Part 2: statements.
 * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 */

typedef struct usl_statement_s
{
	/*
	 * The 'relocate' routine should be called after the creation of
	 * evaluation context.
	 */
	void		(*relocate)(struct usl_statement_s *self,
		etree_operand_p variables,etree_context_p ctx);
	/*
	 * Execution of the compound statement continues while
	 * op[]->operate() routines return 'true'. Currently,
	 * only the 'return' operator returns 'false'.
	 */
	vboolean	(*operate)(struct usl_statement_s *self,etree_context_p ctx);
	void		(*destroy)(struct usl_statement_s *self);
}   usl_statement_t, *usl_statement_p;

#define SYN_KEYWORD				0   /* start of ordinary operator */
#define SYN_LVALUE				1   /* start of assignment operator */
#define SYN_TYPE_NAME			2   /* start of variable definition */

typedef struct statement_start_id_s
{
	u32_t   token_type;
	char	*token_value;
}   statement_start_id_t, *statement_start_id_p;

struct statement_parse_entry_s;

typedef struct statement_parse_context_s
{
	vhandle_t lexer;
	struct statement_parse_entry_s *statements;
	nodal_operation_p operations;
	etree_operand_p variables; /* can be extended */
	u32_t scope;
	usl_statement_p statement_ret;
	u32_t return_typeid;
	vboolean return_parsed;
}	statement_parse_context_t, *statement_parse_context_p;

typedef struct statement_parse_entry_s
{
	vboolean (*parse)(statement_parse_context_p ctx);
	statement_start_id_t syntax;
	char *syntaxt_desc;
}   statement_parse_entry_t, *statement_parse_entry_p;

V_LOCAL vboolean
uslRelocateCompound(vp_stack_p body,etree_operand_p variables,
	etree_context_p ctx)
{
	usl_statement_p ptr;
	u32_t i, nops = vpsCount(body);
	for(i = 0;i < nops;i++)
	{
		ptr = (usl_statement_p)vpsGet(body,i);
		ptr->relocate(ptr,variables,ctx);
	}
	return true;
}

V_LOCAL vboolean
uslExecuteCompound(vp_stack_p body,etree_context_p ctx)
{
	usl_statement_p ptr;
	u32_t i, nops = vpsCount(body);
	for(i = 0;i < nops;i++)
	{
		ptr = (usl_statement_p)vpsGet(body,i);
		if(!ptr->operate(ptr,ctx))
			return false;
	}
	return true;
}

V_LOCAL void
uslDestroyCompound(vp_stack_p body)
{
	usl_statement_p ptr;
	while(vpsPop(body,(void_p)&ptr))
		ptr->destroy(ptr);
	vpsClear(body);
}

V_LOCAL vboolean
uslParseStatement(statement_parse_context_p ctx)
{
	CALLER_NAME(bcodeParseStatement)
	DEBUG_MESSAGE(unknown_statement,"unknown statement")
	char *token;
	vboolean res = false;
	statement_parse_entry_p ptr;
	/* assume first token of statement is already read in */
	token = lexLast(ctx->lexer);
	PARANOID_ASSERT(token);
	if(token[0] == ';' && !token[1]) /* empty */
	{
		ctx->statement_ret = NULL;
		return true;
	}
	for(ptr = ctx->statements;ptr->parse;ptr++)
	{
		switch(ptr->syntax.token_type)
		{
			case SYN_KEYWORD:
				if(STR_EQ(token,ptr->syntax.token_value))
				{
					res = ptr->parse(ctx);
					goto outer_break;
				}
				continue;
			case SYN_LVALUE:
				if(etreeFindIdentifier(ctx->variables,token) ||
					(token[0] == '(' && !token[1]))
				{
					res = ptr->parse(ctx);
					goto outer_break;
				}
				continue;
			case SYN_TYPE_NAME:
				if(typeFindInfo(token))
				{
					res = ptr->parse(ctx);
					goto outer_break;
				}
				continue;
			default:
				break;
		}
	}
	PARSE_ERROR(ctx->lexer,unknown_statement);
	return false;
outer_break:;
	if(res)
		return true;
	if(ctx->statement_ret && ctx->statement_ret->destroy)
		(*(ctx->statement_ret->destroy))(ctx->statement_ret);
	ctx->statement_ret = NULL;
	return false;
}

V_LOCAL vboolean
uslParseCompound(vp_stack_p body,statement_parse_context_p ctx)
{
	vpsClear(body);
	if(!lexNext(ctx->lexer))
		return false;
	if(lexLastWas(ctx->lexer,"{")) /* compound statement */
	{
		ctx->scope++;
		for(;;)
		{
			ctx->statement_ret = NULL;
			if(lexNextIs(ctx->lexer,"}"))
			{
				ctx->scope--;
				etreeHideIdentifiers(ctx->variables,ctx->scope);
				break;
			}
			if(uslParseStatement(ctx))
			{
				if(ctx->statement_ret)
					vpsPush(body,ctx->statement_ret);
				continue;
			}
			uslDestroyCompound(body);
			return false;
		}
	}
	else /* single statement */
	{
		ctx->statement_ret = NULL;
		if(!uslParseStatement(ctx))
			return false;
		if(ctx->statement_ret)
			vpsPush(body,ctx->statement_ret);
	}
	return true;
}

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */

/*
 * Declaration of variables.
 *
 * It starts by keyword identical to 'typeinfo->type_name' and requires
 * _no_ operation at execution time (all that have to be done is to extend
 * the list of variables).
 */
V_LOCAL vboolean
uslParseVarList(statement_parse_context_p ctx)
{
	typeinfo_p info;
	s32_t dim1, dim2; /* for strToInt() */
	char_p id = NULL;
	char_p delim;
	CALLER_NAME(uslParseVarList)
	DEBUG_MESSAGE(arrays_unsupported,"arrays not supported")
	DEBUG_MESSAGE(arrays2d_unsupported,"2D arrays not supported")
	DEBUG_MESSAGE(dim1_expected,"size of 1D array or number of rows of 2D array")
	DEBUG_MESSAGE(dim2_expected,"number of columns of 2D array")
	DEBUG_MESSAGE(wrong_after_2D,"unknown token after definition of 2D array")
	DEBUG_MESSAGE(wrong_after_1D,"unknown token after definition of 1D array")
	DEBUG_MESSAGE(wrong_after_scalar,"unknown token after definition of variable")
	info = typeFindInfo(lexLast(ctx->lexer));
	PARANOID_ASSERT(info);
	for(;;)
	{
		if(!lexNext(ctx->lexer))
		{
			SYN_EXPECTED(ctx->lexer,"<identifier>");
			break;
		}
		id = strDup(lexLast(ctx->lexer));
		delim = lexNext(ctx->lexer);
		if(!delim)
			break;
		if(((delim[0] == ',') || (delim[0] == ';')) && !delim[1])
		{
			/* scalar variable */
			etreeInsertIdentifier(&ctx->variables,id,info->typeid,
				0,1,1,ctx->scope);
			memFree(id);
			id = NULL;
			if(delim[0] == ';')
				return true;
			continue;
		}
		if((delim[0] == '[') && !delim[1])
		{
			/* al least, 1D array */
			if(!info->specific.op_access_1d || 
				!info->specific.op_assign_1d)
			{
   				PARSE_ERROR(ctx->lexer,arrays_unsupported);
				break;
			}
			/* get size / number of rows */
			if(!strToInt(lexNext(ctx->lexer),&dim1))
			{
				SYN_EXPECTED(ctx->lexer,dim1_expected);
				break;
			}
			if(!lexNextIs(ctx->lexer,"]"))
			{
				SYN_EXPECTED(ctx->lexer,"]");
				break;
			}
			delim = lexNext(ctx->lexer);
			if(!delim)
				break;
			if(((delim[0] == ',') || (delim[0] == ';')) && !delim[1])
			{
				/* 1D array */
				etreeInsertIdentifier(&ctx->variables,id,info->typeid,
					1,(u32_t)dim1,1,ctx->scope);
				memFree(id);
				id = NULL;
				if(delim[0] == ';')
					return true;
				continue;
			}
			if((delim[0] == '[') && !delim[1])
			{
				/* 2D array */
				if(!info->specific.op_access_2d || 
					!info->specific.op_assign_2d)
				{
	   				PARSE_ERROR(ctx->lexer,arrays2d_unsupported);
					break;
				}
				/* get number of columns */
				if(!strToInt(lexNext(ctx->lexer),&dim2))
				{
					SYN_EXPECTED(ctx->lexer,dim2_expected);
					break;
				}
				if(!lexNextIs(ctx->lexer,"]"))
				{
					SYN_EXPECTED(ctx->lexer,"]");
					break;
				}
				delim = lexNext(ctx->lexer);
				if(!delim)
					break;
				if(((delim[0] == ',') || (delim[0] == ';')) && !delim[1])
				{
					etreeInsertIdentifier(&ctx->variables,id,info->typeid,
						2,(u32_t)dim1,(u32_t)dim2,ctx->scope);
					memFree(id);
					id = NULL;
					if(delim[0] == ';')
						return true;
					continue;
				}
				PARSE_ERROR(ctx->lexer,wrong_after_2D);
				break;
			}
			PARSE_ERROR(ctx->lexer,wrong_after_1D);
			break;
		}
		PARSE_ERROR(ctx->lexer,wrong_after_scalar);
		break;
	}
	if(id)
		memFree(id);
	return false;
}

#define VAR_PARSE_ENTRY \
	{uslParseVarList,{SYN_TYPE_NAME,NULL}, \
	"<type> identifier|identifier[len]|identifier[rows][cols],...;"}

/*
 * Return operator
 */
typedef struct st_return_s
{
	usl_statement_t	head;
	etree_node_p	right_side; /* tree of right-side expression */
}   st_return_t, *st_return_p;

V_LOCAL void
return_relocate(struct usl_statement_s *self,etree_operand_p variables,
	etree_context_p ctx)
{
	st_return_p st = (st_return_p)self;
	etreeRelocateExpression(st->right_side,variables,ctx);
	etreeOptimizeExpression(st->right_side);
}

V_LOCAL vboolean
return_operate(struct usl_statement_s *self,etree_context_p ctx)
{
	st_return_p st = (st_return_p)self;
	ET_EVAL(st->right_side,ctx);
	return false;
}

V_LOCAL void
return_destroy(struct usl_statement_s *self)
{
	st_return_p st = (st_return_p)self;
	etreeDestroy(st->right_side);
	memFree(st);
}

V_LOCAL vboolean
return_parse(statement_parse_context_p ctx)
{
	CALLER_NAME(return_parse)
	etree_node_p rs;
	st_return_p st;
	ctx->statement_ret = NULL;
	/* assume that keyword 'return' is already read in */
	/* PARANOID_ASSERT(lexLastWas(ctx->lexer,"return")); */
	lexNext(ctx->lexer);
	rs = etreeParseExpression(ctx->operations,ctx->lexer,ctx->variables);
	if(!rs)
	{
		SYN_EXPECTED_EXPRESSION(ctx->lexer);
		return false;
	}
	if(ctx->return_typeid != rs->typeid)
	{
		PARSE_ERROR(ctx->lexer,"type mismatch");
		etreeDestroy(rs);
		return false;
	}
	if(!lexNextIs(ctx->lexer,";"))
	{
		SYN_EXPECTED(ctx->lexer,";");
		etreeDestroy(rs);
		return false;
	}
	st = (st_return_p)memAllocZ(sizeof(st_return_t));
	st->head.relocate = return_relocate;
	st->head.operate = return_operate;
	st->head.destroy = return_destroy;
	st->right_side = rs;
	ctx->statement_ret = (usl_statement_p)st;
	ctx->return_parsed = true;
	return true;
}

#define RETURN_PARSE_ENTRY \
	{return_parse,{SYN_KEYWORD,"return"},"return <expression>;"}

/*
 * Assignment operator
 */
typedef struct st_assign_s
{
	usl_statement_t	head;
	etree_node_p	left_side;	/* lvalue */
	etree_node_p	right_side; /* tree of right-side expression */
}   st_assign_t, *st_assign_p;

V_LOCAL void
assign_relocate(struct usl_statement_s *self,etree_operand_p variables,
	etree_context_p ctx)
{
	st_assign_p st = (st_assign_p)self;
	etreeRelocateExpression(st->right_side,variables,ctx);
	etreeRelocateExpression(st->left_side,variables,ctx);
	etreeOptimizeExpression(st->right_side);
	etreeOptimizeExpression(st->left_side);
}

V_LOCAL vboolean
assign_operate(struct usl_statement_s *self,etree_context_p ctx)
{
	st_assign_p st = (st_assign_p)self;
	ET_EVAL(st->right_side,ctx);
	ET_EVAL(st->left_side,ctx);
	return true;
}

V_LOCAL void
assign_destroy(struct usl_statement_s *self)
{
	st_assign_p st = (st_assign_p)self;
	etreeDestroy(st->right_side);
	etreeDestroy(st->left_side);
	memFree(st);
}

V_LOCAL vboolean
assign_parse(statement_parse_context_p ctx)
{
	CALLER_NAME(assign_parse)
	etree_node_p ls, rs;
	st_assign_p st;
	ctx->statement_ret = NULL;
	ls = etreeParseExpression(ctx->operations,ctx->lexer,ctx->variables);
	if(!ls)
	{
		SYN_EXPECTED_EXPRESSION(ctx->lexer);
		return false;
	}
	if(!etreeConvertToLValue(ls))
	{
		etreeDestroy(ls);
		return false;
	}
	if(!lexNextIs(ctx->lexer,"="))
	{
		SYN_EXPECTED(ctx->lexer,"=");
		etreeDestroy(ls);
		return false;
	}
	lexNext(ctx->lexer);
	rs = etreeParseExpression(ctx->operations,ctx->lexer,ctx->variables);
	if(!rs)
	{
		SYN_EXPECTED_EXPRESSION(ctx->lexer);
		etreeDestroy(ls);
		return false;
	}
	if(ls->typeid != rs->typeid)
	{
		PARSE_ERROR(ctx->lexer,"type mismatch");
		etreeDestroy(ls);
		etreeDestroy(rs);
		return false;
	}
	if(!lexNextIs(ctx->lexer,";"))
	{
		SYN_EXPECTED(ctx->lexer,";");
		etreeDestroy(ls);
		etreeDestroy(rs);
		return false;
	}
	st = (st_assign_p)memAllocZ(sizeof(st_assign_t));
	st->head.relocate = assign_relocate;
	st->head.operate = assign_operate;
	st->head.destroy = assign_destroy;
	st->left_side = ls;
	st->right_side = rs;
	ctx->statement_ret = (usl_statement_p)st;
	return true;
}

#define ASSIGN_PARSE_ENTRY \
	{assign_parse,{SYN_LVALUE,NULL},"<lvalue> = <expression>;"}

/*
 * Conditional operator
 */
typedef struct st_if_s
{
	usl_statement_t	head;
	etree_node_p	control;
	vp_stack_t		true_clause;	/* each of usl_statement_p */
	vp_stack_t		false_clause;	/* each of usl_statement_p */
}   st_if_t, *st_if_p;

V_LOCAL void
if_relocate(struct usl_statement_s *self,etree_operand_p variables,
	etree_context_p ctx)
{
	st_if_p st = (st_if_p)self;
	etreeRelocateExpression(st->control,variables,ctx);
	uslRelocateCompound(&st->true_clause,variables,ctx);
	uslRelocateCompound(&st->false_clause,variables,ctx);
}

V_LOCAL vboolean
if_operate(struct usl_statement_s *self,etree_context_p ctx)
{
	st_if_p st = (st_if_p)self;
	ET_EVAL(st->control,ctx);
	if(INT_EXIT(ctx))
		return uslExecuteCompound(&st->true_clause,ctx);
	return uslExecuteCompound(&st->false_clause,ctx);
}

V_LOCAL void
if_destroy(struct usl_statement_s *self)
{
	st_if_p st = (st_if_p)self;
	uslDestroyCompound(&st->true_clause);
	uslDestroyCompound(&st->false_clause);
	etreeDestroy(st->control);
	memFree(st);
}

V_LOCAL vboolean
if_parse(statement_parse_context_p ctx)
{
	CALLER_NAME(if_parse)
	vboolean has_else;
	st_if_p st = (st_if_p)memAllocZ(sizeof(st_if_t));
	vpsInit(&st->true_clause);
	vpsInit(&st->false_clause);
	st->head.relocate = if_relocate;
	st->head.operate = if_operate;
	st->head.destroy = if_destroy;
	ctx->statement_ret = NULL;
	/* assume the keyword 'if' is already read in */
	lexNext(ctx->lexer);
	st->control = 
		etreeParseExpression(ctx->operations,ctx->lexer,ctx->variables);
	if(!st->control)
	{
		SYN_EXPECTED_EXPRESSION(ctx->lexer);
		memFree(st);
		return false;
	}
	if(st->control->typeid != TYPEID_INT)
	{
		PARSE_ERROR(ctx->lexer,"control expression must be 'int'");
		etreeDestroy(st->control);
		memFree(st);
		return false;
	}
	if(!uslParseCompound(&st->true_clause,ctx))
	{
		SYN_EXPECTED(ctx->lexer,"<true_clause_statement>");
		etreeDestroy(st->control);
		memFree(st);
		return false;
	}
	lexPush(ctx->lexer,LEX_POSITION_BIT);
	has_else = lexNextIsEx(ctx->lexer,"else",STR_COMP);
	lexPop(ctx->lexer,LEX_POSITION_BIT);
	if(has_else)
	{
		lexNext(ctx->lexer);
		if(!uslParseCompound(&st->false_clause,ctx))
		{
			SYN_EXPECTED(ctx->lexer,"<false_clause_statement>");
			etreeDestroy(st->control);
			uslDestroyCompound(&st->true_clause);
			memFree(st);
			return false;
		}
	}
	ctx->statement_ret = (usl_statement_p)st;
	return true;
}

#define IF_PARSE_ENTRY \
	{if_parse,{SYN_KEYWORD,"if"},"if <expression> <statement> [else <statement>]"}

/*
 * 'While' loop
 */
typedef struct st_while_s
{
	usl_statement_t	head;
	etree_node_p	control;
	vp_stack_t		body;
}   st_while_t, *st_while_p;

V_LOCAL void
while_relocate(struct usl_statement_s *self,etree_operand_p variables,
	etree_context_p ctx)
{
	st_while_p st = (st_while_p)self;
	etreeRelocateExpression(st->control,variables,ctx);
	etreeOptimizeExpression(st->control);
	uslRelocateCompound(&st->body,variables,ctx);
}

V_LOCAL vboolean
while_operate(struct usl_statement_s *self,etree_context_p ctx)
{
	st_while_p st = (st_while_p)self;
	for(;;)
	{
		ET_EVAL(st->control,ctx);
		if(!INT_EXIT(ctx))
			break;
		if(!uslExecuteCompound(&st->body,ctx))
			return false;
	}
	return true;
}

V_LOCAL void
while_destroy(struct usl_statement_s *self)
{
	st_while_p st = (st_while_p)self;
	etreeDestroy(st->control);
	uslDestroyCompound(&st->body);
	memFree(st);
}

V_LOCAL vboolean
while_parse(statement_parse_context_p ctx)
{
	CALLER_NAME(while_parse)
	st_while_p st = (st_while_p)memAllocZ(sizeof(st_while_t));
	st->head.relocate = while_relocate;
	st->head.operate = while_operate;
	st->head.destroy = while_destroy;
	ctx->statement_ret = NULL;
	/* assume the keyword 'while' is already read in */
	lexNext(ctx->lexer);
	st->control =
		etreeParseExpression(ctx->operations,ctx->lexer,ctx->variables);
	if(!st->control)
	{
		SYN_EXPECTED_EXPRESSION(ctx->lexer);
		memFree(st);
		return false;
	}
	if(st->control->typeid != TYPEID_INT)
	{
		PARSE_ERROR(ctx->lexer,"control expression must be 'int'");
		etreeDestroy(st->control);
		memFree(st);
		return false;
	}
	if(!uslParseCompound(&st->body,ctx))
	{
		SYN_EXPECTED(ctx->lexer,"<while_body_statement>");
		etreeDestroy(st->control);
		memFree(st);
	}
	ctx->statement_ret = (usl_statement_p)st;
	return true;
}

#define WHILE_PARSE_ENTRY \
	{while_parse,{SYN_KEYWORD,"while"},"while <expression> <statement>"}

/*
 * 'For' loop
 */
typedef struct st_for_s
{
	usl_statement_t	head;
	etree_node_p	control;
	USL_INT			lower, upper, step;
	vp_stack_t		body;
}   st_for_t, *st_for_p;

V_LOCAL void
for_relocate(struct usl_statement_s *self,etree_operand_p variables,
	etree_context_p ctx)
{
	st_for_p st = (st_for_p)self;
	etreeRelocateExpression(st->control,variables,ctx);
	/* don't need to optimize it: simple integer variable */
	uslRelocateCompound(&st->body,variables,ctx);
}

V_LOCAL vboolean
for_operate(struct usl_statement_s *self,etree_context_p ctx)
{
	st_for_p st = (st_for_p)self;
	vboolean forward = st->lower <= st->upper ? true : false;
	*NODAL_INT(st->control) = st->lower;
	if(forward)
	{
		while(*NODAL_INT(st->control) <= st->upper)
		{
			if(!uslExecuteCompound(&st->body,ctx))
				return false;
			*NODAL_INT(st->control) += st->step;
		}
	}
	else
	{
		while(*NODAL_INT(st->control) >= st->upper)
		{
			if(!uslExecuteCompound(&st->body,ctx))
				return false;
			*NODAL_INT(st->control) += st->step;
		}
	}
	return true;
}

V_LOCAL void
for_destroy(struct usl_statement_s *self)
{
	st_for_p st = (st_for_p)self;
	etreeDestroy(st->control);
	uslDestroyCompound(&st->body);
	memFree(st);
}

V_LOCAL vboolean
for_parse(statement_parse_context_p ctx)
{
	CALLER_NAME(for_parse)
	DEBUG_MESSAGE(wrong_control,
		"control expression must be scalar integer variable")
	s32_t	lower, upper, step;
	st_for_p st = (st_for_p)memAllocZ(sizeof(st_for_t));
	st->head.relocate = for_relocate;
	st->head.operate = for_operate;
	st->head.destroy = for_destroy;
	ctx->statement_ret = NULL;
	/* assume the keyword 'for' is already read in */
	lexNext(ctx->lexer);
	st->control =
		etreeParseExpression(ctx->operations,ctx->lexer,ctx->variables);
	if(!st->control)
	{
		SYN_EXPECTED_EXPRESSION(ctx->lexer);
		memFree(st);
		return false;
	}
	if((st->control->typeid != TYPEID_INT) || ETREE_CONST(st->control) ||
		st->control->left || st->control->right)
	{
		PARSE_ERROR(ctx->lexer,wrong_control);
		goto err_exit;
	}
	if(!lexNextIs(ctx->lexer,"="))
	{
		SYN_EXPECTED(ctx->lexer,"=");
		goto err_exit;
	}
	if(!lexNextInteger(ctx->lexer,&lower))
	{
		SYN_EXPECTED(ctx->lexer,"<integer lower_limit_constant>");
		goto err_exit;
	}
	st->lower = lower;
	if(!lexNextIsEx(ctx->lexer,"to",STR_COMP))
	{
		SYN_EXPECTED(ctx->lexer,"to");
		goto err_exit;
	}
	if(!lexNextInteger(ctx->lexer,&upper))
	{
		SYN_EXPECTED(ctx->lexer,"integer <upper_limit_constant>");
		goto err_exit;
	}
	st->upper = upper;
	if(!lexNextIsEx(ctx->lexer,"step",STR_COMP))
	{
		SYN_EXPECTED(ctx->lexer,"step");
		goto err_exit;
	}
	if(!lexNextInteger(ctx->lexer,&step))
	{
		SYN_EXPECTED(ctx->lexer,"integer <step_constant>");
		goto err_exit;
	}
	st->step = step;
	if(!uslParseCompound(&st->body,ctx))
	{
		SYN_EXPECTED(ctx->lexer,"<for_body_statement>");
		goto err_exit;
	}
	ctx->statement_ret = (usl_statement_p)st;
	return true;
err_exit:;
	etreeDestroy(st->control);
	memFree(st);
	return false;
}

#define FOR_PARSE_ENTRY \
	{for_parse,{SYN_KEYWORD,"for"}, \
		"for <int variable> = <start_const> to <end_const> " \
		"step <step_const> <statement>"}

/*
 * The fancy 'print' statement.
 * syntax:
 * "print <expresion>[,<expresion>,...];"
 
 * TODO: 
 *		fprint file_name, <expresion>[,<expresion>,...];
 *
 *	1. At the start of execution, initialise hash table.
 *	2. At call of fprint file_name, expr
 *		2.1. If file_name was not in hash, create new key with type void_p,
 *		  and set it value to pointer to struct file_out_s { vhandle_t fh };
 *		2.2. Get handle from hash and call filePuts(str_out).
 *	3. In destructor, iterate hash table and close all files.
 */

typedef struct st_print_s
{
	usl_statement_t	head;
	vp_stack_t		expressions;
}   st_print_t, *st_print_p;

V_LOCAL void
print_relocate(struct usl_statement_s *self,etree_operand_p variables,
	etree_context_p ctx)
{
	st_print_p st = (st_print_p)self;
	etree_node_p expr;
	u32_t i, num_expr = vpsCount(&st->expressions);
	for(i = 0;i < num_expr;i++)
	{
		expr = (etree_node_p)vpsGet(&st->expressions,i);
		etreeRelocateExpression(expr,variables,ctx);
		etreeOptimizeExpression(expr);
	}
}

V_LOCAL vboolean
print_operate(struct usl_statement_s *self,etree_context_p ctx)
{
	etree_node_p expr;
	st_print_p st = (st_print_p)self;
	u32_t i, num_expr = vpsCount(&st->expressions);
	for(i = 0;i < num_expr;i++)
	{
		expr = (etree_node_p)vpsGet(&st->expressions,i);
		ET_EVAL(expr,ctx);
		switch(expr->typeid)
		{
			case TYPEID_INT:
				printf("%i",INT_EXIT(ctx));
				break;
			case TYPEID_REAL:
				printf("%g",REAL_EXIT(ctx));
				break;
			case TYPEID_STRING:
				if(STRING_EXIT(ctx))
				{
					printf(STRING_EXIT(ctx)->data);
					memFree(STRING_EXIT(ctx));
					STRING_EXIT(ctx) = NULL;
				}
				break;
			default:
				/* ??? output binary data in hexadecimal form ??? */
				break;
		}
	}
	return true;
}

V_LOCAL void
print_destroy(struct usl_statement_s *self)
{
	st_print_p st = (st_print_p)self;
	etree_node_p expr;
	while(vpsPop(&st->expressions,&expr))
		etreeDestroy(expr);
	vpsClear(&st->expressions);
	memFree(st);
}

V_LOCAL vboolean
print_parse(statement_parse_context_p ctx)
{
	CALLER_NAME(print_parse)
	char *token;
	st_print_p st;
	etree_node_p expr;
	vboolean expect_expression = true;
	ctx->statement_ret = NULL;
	st = (st_print_p)memAllocZ(sizeof(st_print_t));
	st->head.relocate = print_relocate;
	st->head.operate = print_operate;
	st->head.destroy = print_destroy;
	vpsInit(&st->expressions);
	while(lexNext(ctx->lexer))
	{
		token = lexLast(ctx->lexer);
		if(token[0] == ';' && !token[1])
		{
			if(expect_expression)
			{
				SYN_EXPECTED_EXPRESSION(ctx->lexer);
				st->head.destroy((usl_statement_p)st);
				return false;
			}
			ctx->statement_ret = (usl_statement_p)st;
			return true;
		}
		if(token[0] == ',' && !token[1])
		{
			expect_expression = true;
			continue;
		}
		expr = etreeParseExpression(ctx->operations,ctx->lexer,ctx->variables);
		if(!expr)
		{
			st->head.destroy((usl_statement_p)st);
			return false;
		}
		expect_expression = false;
		vpsPush(&st->expressions,expr);
	}
	SYN_UNEXPECTED_EOF(ctx->lexer);
	st->head.destroy((usl_statement_p)st);
	return false;
}

#define PRINT_PARSE_ENTRY \
	{print_parse,{SYN_KEYWORD,"print"},"print expression[,expression,...];"}

/*
 * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 */

V_LOCAL statement_parse_entry_t known_statements[] = 
{
	VAR_PARSE_ENTRY,
	RETURN_PARSE_ENTRY,
	ASSIGN_PARSE_ENTRY,
	IF_PARSE_ENTRY,
	WHILE_PARSE_ENTRY,
	FOR_PARSE_ENTRY,
	PRINT_PARSE_ENTRY,
	{NULL,{0,NULL},NULL}
};

/*
 * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 * Part 3: functions.
 * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 */

/*
 * TODO:
 * There must be some way to pass parameter list; we can't extend 'variables'
 * because it is assumed they belongs to _current_ context. It is better
 * to pass set of nodes (which later can be linked with another context)
 * with correctly set 'var_ptr' fields. The etreeCreatNodeOrLeaf can
 * search in this set, and if variable found - duplicate the node (this also
 * allows, for example, to access C matrices: just set 'relocated' flag
 * and predefined 'base' will not be spoiled by relocation routine).
 */

typedef struct usl_func_s
{
	etree_operand_p	variables;
	etree_context_p ctx;
	vp_stack_t		body;
}   usl_func_t, *usl_func_p;

usl_func_p
uslParseFunction(vhandle_t lexer,u32_t return_typeid)
{
	CALLER_NAME(uslParseFunction)
	usl_func_p fn;
	statement_parse_context_t parse_ctx;
	fn = (usl_func_p)memAllocZ(sizeof(usl_func_t));
	vpsInit(&fn->body);
	memZero(&parse_ctx,sizeof(parse_ctx));
	parse_ctx.lexer = lexer;
	parse_ctx.statements = known_statements;
	parse_ctx.operations = known_nodal_operations;
	parse_ctx.variables = NULL;
	parse_ctx.scope = 0; /* assume opening-brace was _not_ read in */
	parse_ctx.statement_ret = NULL;
	parse_ctx.return_parsed = false;
	parse_ctx.return_typeid = return_typeid;
	if(!uslParseCompound(&fn->body,&parse_ctx))
	{
		etreeFreeIdentifiers(parse_ctx.variables);
		memFree(fn);
		return NULL;
	}
	if(!parse_ctx.return_parsed)
	{
		WARNING_GENERIC("missing return value");
	}
	fn->variables = parse_ctx.variables;
	fn->ctx = etreeCreateContext(fn->variables);
	uslRelocateCompound(&fn->body,fn->variables,fn->ctx);
	return fn;
}

void
uslExecuteFunction(usl_func_p fn)
{
	uslExecuteCompound(&fn->body,fn->ctx);
}

void
uslDestroyFunction(usl_func_p fn)
{
	uslDestroyCompound(&fn->body);
	etreeFreeIdentifiers(fn->variables);
	etreeFreeContext(fn->ctx);
	memFree(fn);
}

/*
 * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 */

int main()
{
	usl_func_p fn;
	vhandle_t lexer;
	logStartConsoleLog();
	logUpperLevel(LOG_TRACE);

	lexer = lexParseFile("in.func","{}[](),;");
	assert(lexer);
	lexEnable(lexer,LEX_QUOTES_RETURNING);
	lexEnable(lexer,LEX_ONE_CHAR_COMMENTS);
	lexSetInteger(lexer,LEX_COMMENT_CHAR,'#');
	fn = uslParseFunction(lexer,TYPEID_INT);
	assert(fn);
	lexDestroy(lexer);
	uslExecuteFunction(fn);
	uslDestroyFunction(fn);

	memPrintMemStats();
	return 0;
}
