/*
 * Copyright (c) 2010 Jiri Svoboda
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 *
 * - Redistributions of source code must retain the above copyright
 *   notice, this list of conditions and the following disclaimer.
 * - Redistributions in binary form must reproduce the above copyright
 *   notice, this list of conditions and the following disclaimer in the
 *   documentation and/or other materials provided with the distribution.
 * - The name of the author may not be used to endorse or promote products
 *   derived from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

/** @file Runner (executes the code). */

#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
#include "debug.h"
#include "intmap.h"
#include "list.h"
#include "mytypes.h"
#include "os/os.h"
#include "rdata.h"
#include "run.h"
#include "run_texpr.h"
#include "symbol.h"
#include "stree.h"
#include "strtab.h"
#include "tdata.h"

#include "run_expr.h"

static void run_nameref(run_t *run, stree_nameref_t *nameref,
    rdata_item_t **res);

static void run_literal(run_t *run, stree_literal_t *literal,
    rdata_item_t **res);
static void run_lit_int(run_t *run, stree_lit_int_t *lit_int,
    rdata_item_t **res);
static void run_lit_ref(run_t *run, stree_lit_ref_t *lit_ref,
    rdata_item_t **res);
static void run_lit_string(run_t *run, stree_lit_string_t *lit_string,
    rdata_item_t **res);

static void run_self_ref(run_t *run, stree_self_ref_t *self_ref,
    rdata_item_t **res);

static void run_binop(run_t *run, stree_binop_t *binop, rdata_item_t **res);
static void run_binop_int(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
    rdata_value_t *v2, rdata_item_t **res);
static void run_binop_string(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
    rdata_value_t *v2, rdata_item_t **res);
static void run_binop_ref(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
    rdata_value_t *v2, rdata_item_t **res);

static void run_unop(run_t *run, stree_unop_t *unop, rdata_item_t **res);
static void run_new(run_t *run, stree_new_t *new_op, rdata_item_t **res);
static void run_new_array(run_t *run, stree_new_t *new_op,
    tdata_item_t *titem, rdata_item_t **res);
static void run_new_object(run_t *run, stree_new_t *new_op,
    tdata_item_t *titem, rdata_item_t **res);

static void run_access(run_t *run, stree_access_t *access, rdata_item_t **res);
static void run_access_item(run_t *run, stree_access_t *access,
    rdata_item_t *arg, rdata_item_t **res);
static void run_access_ref(run_t *run, stree_access_t *access,
    rdata_item_t *arg, rdata_item_t **res);
static void run_access_deleg(run_t *run, stree_access_t *access,
    rdata_item_t *arg, rdata_item_t **res);
static void run_access_object(run_t *run, stree_access_t *access,
    rdata_item_t *arg, rdata_item_t **res);

static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res);
static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res);
static void run_index_array(run_t *run, stree_index_t *index,
    rdata_item_t *base, list_t *args, rdata_item_t **res);
static void run_index_object(run_t *run, stree_index_t *index,
    rdata_item_t *base, list_t *args, rdata_item_t **res);
static void run_index_string(run_t *run, stree_index_t *index,
    rdata_item_t *base, list_t *args, rdata_item_t **res);
static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res);
static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res);

/** Evaluate expression. */
void run_expr(run_t *run, stree_expr_t *expr, rdata_item_t **res)
{
#ifdef DEBUG_RUN_TRACE
	printf("Executing expression.\n");
#endif

	switch (expr->ec) {
	case ec_nameref:
		run_nameref(run, expr->u.nameref, res);
		break;
	case ec_literal:
		run_literal(run, expr->u.literal, res);
		break;
	case ec_self_ref:
		run_self_ref(run, expr->u.self_ref, res);
		break;
	case ec_binop:
		run_binop(run, expr->u.binop, res);
		break;
	case ec_unop:
		run_unop(run, expr->u.unop, res);
		break;
	case ec_new:
		run_new(run, expr->u.new_op, res);
		break;
	case ec_access:
		run_access(run, expr->u.access, res);
		break;
	case ec_call:
		run_call(run, expr->u.call, res);
		break;
	case ec_index:
		run_index(run, expr->u.index, res);
		break;
	case ec_assign:
		run_assign(run, expr->u.assign, res);
		break;
	case ec_as:
		run_as(run, expr->u.as_op, res);
		break;
	}

#ifdef DEBUG_RUN_TRACE
	printf("Expression result: ");
	rdata_item_print(*res);
	printf(".\n");
#endif
}

/** Evaluate name reference expression. */
static void run_nameref(run_t *run, stree_nameref_t *nameref,
    rdata_item_t **res)
{
	stree_symbol_t *sym;
	rdata_item_t *item;
	rdata_address_t *address;
	rdata_addr_var_t *addr_var;
	rdata_value_t *value;
	rdata_var_t *var;
	rdata_deleg_t *deleg_v;

	run_proc_ar_t *proc_ar;
	stree_symbol_t *csi_sym;
	stree_csi_t *csi;
	rdata_object_t *obj;
	rdata_var_t *member_var;

#ifdef DEBUG_RUN_TRACE
	printf("Run nameref.\n");
#endif

	/*
	 * Look for a local variable.
	 */
	var = run_local_vars_lookup(run, nameref->name->sid);
	if (var != NULL) {
		/* Found a local variable. */
		item = rdata_item_new(ic_address);
		address = rdata_address_new(ac_var);
		addr_var = rdata_addr_var_new();

		item->u.address = address;
		address->u.var_a = addr_var;
		addr_var->vref = var;

		*res = item;
#ifdef DEBUG_RUN_TRACE
		printf("Found local variable.\n");
#endif
		return;
	}

	/*
	 * Look for a class-wide or global symbol.
	 */

	/* Determine currently active object or CSI. */
	proc_ar = run_get_current_proc_ar(run);
	if (proc_ar->obj != NULL) {
		assert(proc_ar->obj->vc == vc_object);
		obj = proc_ar->obj->u.object_v;
		csi_sym = obj->class_sym;
		csi = symbol_to_csi(csi_sym);
		assert(csi != NULL);
	} else {
		csi = proc_ar->proc->outer_symbol->outer_csi;
		obj = NULL;
	}

	sym = symbol_lookup_in_csi(run->program, csi, nameref->name);

	/* Existence should have been verified in type checking phase. */
	assert(sym != NULL);

	switch (sym->sc) {
	case sc_csi:
#ifdef DEBUG_RUN_TRACE
		printf("Referencing class.\n");
#endif
		item = rdata_item_new(ic_value);
		value = rdata_value_new();
		var = rdata_var_new(vc_deleg);
		deleg_v = rdata_deleg_new();

		item->u.value = value;
		value->var = var;
		var->u.deleg_v = deleg_v;

		deleg_v->obj = NULL;
		deleg_v->sym = sym;
		*res = item;
		break;
	case sc_fun:
		/* There should be no global functions. */
		assert(csi != NULL);

		if (sym->outer_csi != csi) {
			/* Function is not in the current object. */
			printf("Error: Cannot access non-static member "
			    "function '");
			symbol_print_fqn(sym);
			printf("' from nested CSI '");
			symbol_print_fqn(csi_sym);
			printf("'.\n");
			exit(1);
		}

		/* Construct delegate. */
		item = rdata_item_new(ic_value);
		value = rdata_value_new();
		item->u.value = value;

		var = rdata_var_new(vc_deleg);
		deleg_v = rdata_deleg_new();
		value->var = var;
		var->u.deleg_v = deleg_v;

		deleg_v->obj = proc_ar->obj;
		deleg_v->sym = sym;

		*res = item;
		break;
	case sc_var:
#ifdef DEBUG_RUN_TRACE
		printf("Referencing member variable.\n");
#endif
		/* There should be no global variables. */
		assert(csi != NULL);

		/* XXX Assume variable is not static for now. */
		assert(obj != NULL);

		if (sym->outer_csi != csi) {
			/* Variable is not in the current object. */
			printf("Error: Cannot access non-static member "
			    "variable '");
			symbol_print_fqn(sym);
			printf("' from nested CSI '");
			symbol_print_fqn(csi_sym);
			printf("'.\n");
			exit(1);
		}

		/* Find member variable in object. */
		member_var = intmap_get(&obj->fields, nameref->name->sid);
		assert(member_var != NULL);

		/* Return address of the variable. */
		item = rdata_item_new(ic_address);
		address = rdata_address_new(ac_var);
		addr_var = rdata_addr_var_new();

		item->u.address = address;
		address->u.var_a = addr_var;
		addr_var->vref = member_var;

		*res = item;
		break;
	default:
		printf("Referencing symbol class %d unimplemented.\n", sym->sc);
		*res = NULL;
		break;
	}
}

/** Evaluate literal. */
static void run_literal(run_t *run, stree_literal_t *literal,
    rdata_item_t **res)
{
#ifdef DEBUG_RUN_TRACE
	printf("Run literal.\n");
#endif

	switch (literal->ltc) {
	case ltc_int:
		run_lit_int(run, &literal->u.lit_int, res);
		break;
	case ltc_ref:
		run_lit_ref(run, &literal->u.lit_ref, res);
		break;
	case ltc_string:
		run_lit_string(run, &literal->u.lit_string, res);
		break;
	default:
		assert(b_false);
	}
}

/** Evaluate integer literal. */
static void run_lit_int(run_t *run, stree_lit_int_t *lit_int,
    rdata_item_t **res)
{
	rdata_item_t *item;
	rdata_value_t *value;
	rdata_var_t *var;
	rdata_int_t *int_v;

#ifdef DEBUG_RUN_TRACE
	printf("Run integer literal.\n");
#endif
	(void) run;

	item = rdata_item_new(ic_value);
	value = rdata_value_new();
	var = rdata_var_new(vc_int);
	int_v = rdata_int_new();

	item->u.value = value;
	value->var = var;
	var->u.int_v = int_v;
	int_v->value = lit_int->value;

	*res = item;
}

/** Evaluate reference literal (@c nil). */
static void run_lit_ref(run_t *run, stree_lit_ref_t *lit_ref,
    rdata_item_t **res)
{
	rdata_item_t *item;
	rdata_value_t *value;
	rdata_var_t *var;
	rdata_ref_t *ref_v;

#ifdef DEBUG_RUN_TRACE
	printf("Run reference literal (nil).\n");
#endif
	(void) run;
	(void) lit_ref;

	item = rdata_item_new(ic_value);
	value = rdata_value_new();
	var = rdata_var_new(vc_ref);
	ref_v = rdata_ref_new();

	item->u.value = value;
	value->var = var;
	var->u.ref_v = ref_v;
	ref_v->vref = NULL;

	*res = item;
}

/** Evaluate string literal. */
static void run_lit_string(run_t *run, stree_lit_string_t *lit_string,
    rdata_item_t **res)
{
	rdata_item_t *item;
	rdata_value_t *value;
	rdata_var_t *var;
	rdata_string_t *string_v;

#ifdef DEBUG_RUN_TRACE
	printf("Run integer literal.\n");
#endif
	(void) run;

	item = rdata_item_new(ic_value);
	value = rdata_value_new();
	var = rdata_var_new(vc_string);
	string_v = rdata_string_new();

	item->u.value = value;
	value->var = var;
	var->u.string_v = string_v;
	string_v->value = lit_string->value;

	*res = item;
}

/** Evaluate @c self reference. */
static void run_self_ref(run_t *run, stree_self_ref_t *self_ref,
    rdata_item_t **res)
{
	run_proc_ar_t *proc_ar;

#ifdef DEBUG_RUN_TRACE
	printf("Run self reference.\n");
#endif
	(void) self_ref;
	proc_ar = run_get_current_proc_ar(run);

	/* Return reference to the currently active object. */
	run_reference(run, proc_ar->obj, res);
}

/** Evaluate binary operation. */
static void run_binop(run_t *run, stree_binop_t *binop, rdata_item_t **res)
{
	rdata_item_t *rarg1_i, *rarg2_i;
	rdata_item_t *rarg1_vi, *rarg2_vi;
	rdata_value_t *v1, *v2;

#ifdef DEBUG_RUN_TRACE
	printf("Run binary operation.\n");
#endif
	run_expr(run, binop->arg1, &rarg1_i);
	run_expr(run, binop->arg2, &rarg2_i);

	switch (binop->bc) {
	case bo_plus:
	case bo_equal:
	case bo_notequal:
	case bo_lt:
	case bo_gt:
	case bo_lt_equal:
	case bo_gt_equal:
		/* These are implemented so far. */
		break;
	default:
		printf("Unimplemented: Binary operation type %d.\n",
		    binop->bc);
		exit(1);
	}

#ifdef DEBUG_RUN_TRACE
	printf("Check binop argument results.\n");
#endif

	run_cvt_value_item(run, rarg1_i, &rarg1_vi);
	run_cvt_value_item(run, rarg2_i, &rarg2_vi);

	v1 = rarg1_vi->u.value;
	v2 = rarg2_vi->u.value;

	if (v1->var->vc != v2->var->vc) {
		printf("Unimplemented: Binary operation arguments have "
		    "different type.\n");
		exit(1);
	}

	switch (v1->var->vc) {
	case vc_int:
		run_binop_int(run, binop, v1, v2, res);
		break;
	case vc_string:
		run_binop_string(run, binop, v1, v2, res);
		break;
	case vc_ref:
		run_binop_ref(run, binop, v1, v2, res);
		break;
	default:
		printf("Unimplemented: Binary operation arguments of "
		    "type %d.\n", v1->var->vc);
		exit(1);
	}
}

/** Evaluate binary operation on int arguments. */
static void run_binop_int(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
    rdata_value_t *v2, rdata_item_t **res)
{
	rdata_item_t *item;
	rdata_value_t *value;
	rdata_var_t *var;
	rdata_int_t *int_v;

	int i1, i2;

	(void) run;

	item = rdata_item_new(ic_value);
	value = rdata_value_new();
	var = rdata_var_new(vc_int);
	int_v = rdata_int_new();

	item->u.value = value;
	value->var = var;
	var->u.int_v = int_v;

	i1 = v1->var->u.int_v->value;
	i2 = v2->var->u.int_v->value;

	switch (binop->bc) {
	case bo_plus:
		int_v->value = i1 + i2;
		break;

	/* XXX We should have a real boolean type. */
	case bo_equal:
		int_v->value = (i1 == i2) ? 1 : 0;
		break;
	case bo_notequal:
		int_v->value = (i1 != i2) ? 1 : 0;
		break;
	case bo_lt:
		int_v->value = (i1 < i2) ? 1 : 0;
		break;
	case bo_gt:
		int_v->value = (i1 > i2) ? 1 : 0;
		break;
	case bo_lt_equal:
		int_v->value = (i1 <= i2) ? 1 : 0;
		break;
	case bo_gt_equal:
		int_v->value = (i1 >= i2) ? 1 : 0;
		break;
	default:
		assert(b_false);
	}

	*res = item;
}

/** Evaluate binary operation on string arguments. */
static void run_binop_string(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
    rdata_value_t *v2, rdata_item_t **res)
{
	rdata_item_t *item;
	rdata_value_t *value;
	rdata_var_t *var;
	rdata_string_t *string_v;

	char *s1, *s2;

	(void) run;

	item = rdata_item_new(ic_value);
	value = rdata_value_new();
	var = rdata_var_new(vc_string);
	string_v = rdata_string_new();

	item->u.value = value;
	value->var = var;
	var->u.string_v = string_v;

	s1 = v1->var->u.string_v->value;
	s2 = v2->var->u.string_v->value;

	switch (binop->bc) {
	case bo_plus:
		/* Concatenate strings. */
		string_v->value = os_str_acat(s1, s2);
		break;
	default:
		printf("Error: Invalid binary operation on string "
		    "arguments (%d).\n", binop->bc);
		assert(b_false);
	}

	*res = item;
}

/** Evaluate binary operation on ref arguments. */
static void run_binop_ref(run_t *run, stree_binop_t *binop, rdata_value_t *v1,
    rdata_value_t *v2, rdata_item_t **res)
{
	rdata_item_t *item;
	rdata_value_t *value;
	rdata_var_t *var;
	rdata_int_t *int_v;

	rdata_var_t *ref1, *ref2;

	(void) run;

	item = rdata_item_new(ic_value);
	value = rdata_value_new();
	var = rdata_var_new(vc_int);
	int_v = rdata_int_new();

	item->u.value = value;
	value->var = var;
	var->u.int_v = int_v;

	ref1 = v1->var->u.ref_v->vref;
	ref2 = v2->var->u.ref_v->vref;

	switch (binop->bc) {
	/* XXX We should have a real boolean type. */
	case bo_equal:
		int_v->value = (ref1 == ref2) ? 1 : 0;
		break;
	case bo_notequal:
		int_v->value = (ref1 != ref2) ? 1 : 0;
		break;
	default:
		printf("Error: Invalid binary operation on reference "
		    "arguments (%d).\n", binop->bc);
		assert(b_false);
	}

	*res = item;
}


/** Evaluate unary operation. */
static void run_unop(run_t *run, stree_unop_t *unop, rdata_item_t **res)
{
	rdata_item_t *rarg;

#ifdef DEBUG_RUN_TRACE
	printf("Run unary operation.\n");
#endif
	run_expr(run, unop->arg, &rarg);
	*res = NULL;
}

/** Evaluate @c new operation. */
static void run_new(run_t *run, stree_new_t *new_op, rdata_item_t **res)
{
	tdata_item_t *titem;

#ifdef DEBUG_RUN_TRACE
	printf("Run 'new' operation.\n");
#endif
	/* Evaluate type expression */
	run_texpr(run->program, run_get_current_csi(run), new_op->texpr,
	    &titem);

	switch (titem->tic) {
	case tic_tarray:
		run_new_array(run, new_op, titem, res);
		break;
	case tic_tobject:
		run_new_object(run, new_op, titem, res);
		break;
	default:
		printf("Error: Invalid argument to operator 'new', "
		    "expected object.\n");
		exit(1);
	}
}

/** Create new array. */
static void run_new_array(run_t *run, stree_new_t *new_op,
    tdata_item_t *titem, rdata_item_t **res)
{
	tdata_array_t *tarray;
	rdata_array_t *array;
	rdata_var_t *array_var;
	rdata_var_t *elem_var;

	rdata_item_t *rexpr, *rexpr_vi;
	rdata_var_t *rexpr_var;

	stree_expr_t *expr;

	list_node_t *node;
	int length;
	int i;

#ifdef DEBUG_RUN_TRACE
	printf("Create new array.\n");
#endif
	(void) run;
	(void) new_op;

	assert(titem->tic == tic_tarray);
	tarray = titem->u.tarray;

	/* Create the array. */
	assert(titem->u.tarray->rank > 0);
	array = rdata_array_new(titem->u.tarray->rank);

	/* Compute extents. */
	node = list_first(&tarray->extents);
	if (node == NULL) {
		printf("Error: Extents must be specified when constructing "
		    "an array with 'new'.\n");
		exit(1);
	}

	i = 0; length = 1;
	while (node != NULL) {
		expr = list_node_data(node, stree_expr_t *);

		/* Evaluate extent argument. */
		run_expr(run, expr, &rexpr);
		run_cvt_value_item(run, rexpr, &rexpr_vi);
		assert(rexpr_vi->ic == ic_value);
		rexpr_var = rexpr_vi->u.value->var;

		if (rexpr_var->vc != vc_int) {
			printf("Error: Array extent must be an integer.\n");
			exit(1);
		}

#ifdef DEBUG_RUN_TRACE
		printf("Array extent: %d.\n", rexpr_var->u.int_v->value);
#endif
		array->extent[i] = rexpr_var->u.int_v->value;
		length = length * array->extent[i];

		node = list_next(&tarray->extents, node);
		i += 1;
	}

	array->element = calloc(length, sizeof(rdata_var_t *));
	if (array->element == NULL) {
		printf("Memory allocation failed.\n");
		exit(1);
	}

	/* Create member variables */
	for (i = 0; i < length; ++i) {
		/* XXX Depends on member variable type. */
		elem_var = rdata_var_new(vc_int);
		elem_var->u.int_v = rdata_int_new();
		elem_var->u.int_v->value = 0;

		array->element[i] = elem_var;
	}

	/* Create array variable. */
	array_var = rdata_var_new(vc_array);
	array_var->u.array_v = array;

	/* Create reference to the new array. */
	run_reference(run, array_var, res);
}

/** Create new object. */
static void run_new_object(run_t *run, stree_new_t *new_op,
    tdata_item_t *titem, rdata_item_t **res)
{
	rdata_object_t *obj;
	rdata_var_t *obj_var;

	stree_symbol_t *csi_sym;
	stree_csi_t *csi;
	stree_csimbr_t *csimbr;

	rdata_var_t *mbr_var;

	list_node_t *node;

#ifdef DEBUG_RUN_TRACE
	printf("Create new object.\n");
#endif
	(void) run;
	(void) new_op;

	/* Lookup object CSI. */
	assert(titem->tic == tic_tobject);
	csi = titem->u.tobject->csi;
	csi_sym = csi_to_symbol(csi);

	/* Create the object. */
	obj = rdata_object_new();
	obj->class_sym = csi_sym;
	intmap_init(&obj->fields);

	obj_var = rdata_var_new(vc_object);
	obj_var->u.object_v = obj;

	/* Create object fields. */
	node = list_first(&csi->members);
	while (node != NULL) {
		csimbr = list_node_data(node, stree_csimbr_t *);
		if (csimbr->cc == csimbr_var) {
			/* XXX Depends on member variable type. */
			mbr_var = rdata_var_new(vc_int);
			mbr_var->u.int_v = rdata_int_new();
			mbr_var->u.int_v->value = 0;

			intmap_set(&obj->fields, csimbr->u.var->name->sid,
			    mbr_var);
		}

		node = list_next(&csi->members, node);
	}

	/* Create reference to the new object. */
	run_reference(run, obj_var, res);
}

/** Evaluate member acccess. */
static void run_access(run_t *run, stree_access_t *access, rdata_item_t **res)
{
	rdata_item_t *rarg;

#ifdef DEBUG_RUN_TRACE
	printf("Run access operation.\n");
#endif
	run_expr(run, access->arg, &rarg);
	if (rarg == NULL) {
		printf("Error: Sub-expression has no value.\n");
		exit(1);
	}

	run_access_item(run, access, rarg, res);
}

/** Evaluate member acccess (with base already evaluated). */
static void run_access_item(run_t *run, stree_access_t *access,
    rdata_item_t *arg, rdata_item_t **res)
{
	var_class_t vc;

#ifdef DEBUG_RUN_TRACE
	printf("Run access operation on pre-evaluated base.\n");
#endif
	vc = run_item_get_vc(run, arg);

	switch (vc) {
	case vc_ref:
		run_access_ref(run, access, arg, res);
		break;
	case vc_deleg:
		run_access_deleg(run, access, arg, res);
		break;
	case vc_object:
		run_access_object(run, access, arg, res);
		break;
	default:
		printf("Unimplemented: Using access operator ('.') "
		    "with unsupported data type (value/%d).\n", vc);
		exit(1);
	}
}

/** Evaluate reference acccess. */
static void run_access_ref(run_t *run, stree_access_t *access,
    rdata_item_t *arg, rdata_item_t **res)
{
	rdata_item_t *darg;

	/* Implicitly dereference. */
	run_dereference(run, arg, &darg);

	if (run->thread_ar->bo_mode != bm_none) {
		*res = run_recovery_item(run);
		return;
	}

	/* Try again. */
	run_access_item(run, access, darg, res);
}

/** Evaluate delegate-member acccess. */
static void run_access_deleg(run_t *run, stree_access_t *access,
    rdata_item_t *arg, rdata_item_t **res)
{
	rdata_item_t *arg_vi;
	rdata_value_t *arg_val;
	rdata_deleg_t *deleg_v;
	stree_symbol_t *member;

#ifdef DEBUG_RUN_TRACE
	printf("Run delegate access operation.\n");
#endif
	run_cvt_value_item(run, arg, &arg_vi);
	arg_val = arg_vi->u.value;
	assert(arg_val->var->vc == vc_deleg);

	deleg_v = arg_val->var->u.deleg_v;
	if (deleg_v->obj != NULL || deleg_v->sym->sc != sc_csi) {
		printf("Error: Using '.' with delegate to different object "
		    "than a CSI (%d).\n", deleg_v->sym->sc);
		exit(1);
	}

	member = symbol_search_csi(run->program, deleg_v->sym->u.csi,
	    access->member_name);

	if (member == NULL) {
		printf("Error: CSI '");
		symbol_print_fqn(deleg_v->sym);
		printf("' has no member named '%s'.\n",
		    strtab_get_str(access->member_name->sid));
		exit(1);
	}

#ifdef DEBUG_RUN_TRACE
	printf("Found member '%s'.\n",
	    strtab_get_str(access->member_name->sid));
#endif

	/*
	 * Reuse existing item, value, var, deleg.
	 * XXX This is maybe not a good idea because it complicates memory
	 * management as there is not a single owner 
	 */
	deleg_v->sym = member;
	*res = arg;
}

/** Evaluate object member acccess. */
static void run_access_object(run_t *run, stree_access_t *access,
    rdata_item_t *arg, rdata_item_t **res)
{
	stree_symbol_t *member;
	rdata_var_t *object_var;
	rdata_object_t *object;
	rdata_item_t *ritem;
	rdata_address_t *address;
	rdata_addr_var_t *addr_var;
	rdata_addr_prop_t *addr_prop;
	rdata_aprop_named_t *aprop_named;
	rdata_deleg_t *deleg_p;

	rdata_value_t *value;
	rdata_deleg_t *deleg_v;
	rdata_var_t *var;

#ifdef DEBUG_RUN_TRACE
	printf("Run object access operation.\n");
#endif
	assert(arg->ic == ic_address);
	assert(arg->u.address->ac == ac_var);
	assert(arg->u.address->u.var_a->vref->vc == vc_object);

	object_var = arg->u.address->u.var_a->vref;
	object = object_var->u.object_v;

	member = symbol_search_csi(run->program, object->class_sym->u.csi,
	    access->member_name);

	if (member == NULL) {
		printf("Error: Object of class '");
		symbol_print_fqn(object->class_sym);
		printf("' has no member named '%s'.\n",
		    strtab_get_str(access->member_name->sid));
		exit(1);
	}

#ifdef DEBUG_RUN_TRACE
	printf("Found member '%s'.\n",
	    strtab_get_str(access->member_name->sid));
#endif

	switch (member->sc) {
	case sc_csi:
		printf("Error: Accessing object member which is nested CSI.\n");
		exit(1);
	case sc_fun:
		/* Construct delegate. */
		ritem = rdata_item_new(ic_value);
		value = rdata_value_new();
		ritem->u.value = value;

		var = rdata_var_new(vc_deleg);
		value->var = var;
		deleg_v = rdata_deleg_new();
		var->u.deleg_v = deleg_v;

		deleg_v->obj = arg->u.address->u.var_a->vref;
		deleg_v->sym = member;
		break;
	case sc_var:
		/* Construct variable address item. */
		ritem = rdata_item_new(ic_address);
		address = rdata_address_new(ac_var);
		addr_var = rdata_addr_var_new();
		ritem->u.address = address;
		address->u.var_a = addr_var;

		addr_var->vref = intmap_get(&object->fields,
		    access->member_name->sid);
		assert(addr_var->vref != NULL);
		break;
	case sc_prop:
		/* Construct named property address. */
		ritem = rdata_item_new(ic_address);
		address = rdata_address_new(ac_prop);
		addr_prop = rdata_addr_prop_new(apc_named);
		aprop_named = rdata_aprop_named_new();
		ritem->u.address = address;
		address->u.prop_a = addr_prop;
		addr_prop->u.named = aprop_named;

		deleg_p = rdata_deleg_new();
		deleg_p->obj = object_var;
		deleg_p->sym = member;
		addr_prop->u.named->prop_d = deleg_p;
		break;
	}

	*res = ritem;
}

/** Call a function. */
static void run_call(run_t *run, stree_call_t *call, rdata_item_t **res)
{
	rdata_item_t *rfun;
	rdata_deleg_t *deleg_v;
	list_t arg_vals;
	list_node_t *node;
	stree_expr_t *arg;
	rdata_item_t *rarg_i, *rarg_vi;

	stree_fun_t *fun;
	run_proc_ar_t *proc_ar;

#ifdef DEBUG_RUN_TRACE
	printf("Run call operation.\n");
#endif
	run_expr(run, call->fun, &rfun);

	if (run->thread_ar->bo_mode != bm_none) {
		*res = run_recovery_item(run);
		return;
	}

	if (rfun->ic != ic_value || rfun->u.value->var->vc != vc_deleg) {
		printf("Unimplemented: Call expression of this type.\n");
		exit(1);
	}

	deleg_v = rfun->u.value->var->u.deleg_v;

	if (deleg_v->sym->sc != sc_fun) {
		printf("Error: Called symbol is not a function.\n");
		exit(1);
	}

#ifdef DEBUG_RUN_TRACE
	printf("Call function '");
	symbol_print_fqn(deleg_v->sym);
	printf("'\n");
#endif
	/* Evaluate function arguments. */
	list_init(&arg_vals);
	node = list_first(&call->args);

	while (node != NULL) {
		arg = list_node_data(node, stree_expr_t *);
		run_expr(run, arg, &rarg_i);
		run_cvt_value_item(run, rarg_i, &rarg_vi);

		list_append(&arg_vals, rarg_vi);
		node = list_next(&call->args, node);
	}

	fun = symbol_to_fun(deleg_v->sym);
	assert(fun != NULL);

	/* Create procedure activation record. */
	run_proc_ar_create(run, deleg_v->obj, fun->proc, &proc_ar);

	/* Fill in argument values. */
	run_proc_ar_set_args(run, proc_ar, &arg_vals);

	/* Run the function. */
	run_proc(run, proc_ar, res);

#ifdef DEBUG_RUN_TRACE
	printf("Returned from function call.\n");
#endif
}

/** Run index operation. */
static void run_index(run_t *run, stree_index_t *index, rdata_item_t **res)
{
	rdata_item_t *rbase;
	rdata_item_t *base_i;
	list_node_t *node;
	stree_expr_t *arg;
	rdata_item_t *rarg_i, *rarg_vi;
	var_class_t vc;
	list_t arg_vals;

#ifdef DEBUG_RUN_TRACE
	printf("Run index operation.\n");
#endif
	run_expr(run, index->base, &rbase);

	vc = run_item_get_vc(run, rbase);

	/* Implicitly dereference. */
	if (vc == vc_ref) {
		run_dereference(run, rbase, &base_i);
	} else {
		base_i = rbase;
	}

	vc = run_item_get_vc(run, base_i);

	/* Evaluate arguments (indices). */
	node = list_first(&index->args);
	list_init(&arg_vals);

	while (node != NULL) {
		arg = list_node_data(node, stree_expr_t *);
		run_expr(run, arg, &rarg_i);
		run_cvt_value_item(run, rarg_i, &rarg_vi);

		list_append(&arg_vals, rarg_vi);

		node = list_next(&index->args, node);
	}

	switch (vc) {
	case vc_array:
		run_index_array(run, index, base_i, &arg_vals, res);
		break;
	case vc_object:
		run_index_object(run, index, base_i, &arg_vals, res);
		break;
	case vc_string:
		run_index_string(run, index, base_i, &arg_vals, res);
		break;
	default:
		printf("Error: Indexing object of bad type (%d).\n", vc);
		exit(1);
	}
}

/** Run index operation on array. */
static void run_index_array(run_t *run, stree_index_t *index,
    rdata_item_t *base, list_t *args, rdata_item_t **res)
{
	list_node_t *node;
	rdata_array_t *array;
	rdata_item_t *arg;

	int i;
	int elem_index;
	int arg_val;

	rdata_item_t *ritem;
	rdata_address_t *address;
	rdata_addr_var_t *addr_var;

#ifdef DEBUG_RUN_TRACE
	printf("Run array index operation.\n");
#endif
	(void) run;
	(void) index;

	assert(base->ic == ic_address);
	assert(base->u.address->ac == ac_var);
	assert(base->u.address->u.var_a->vref->vc == vc_array);
	array = base->u.address->u.var_a->vref->u.array_v;

	/*
	 * Linear index of the desired element. Elements are stored in
	 * lexicographic order with the last index changing the fastest.
	 */
	elem_index = 0;

	node = list_first(args);
	i = 0;

	while (node != NULL) {
		if (i >= array->rank) {
			printf("Error: Too many indices for array of rank %d",
			    array->rank);
			exit(1);
		}

		arg = list_node_data(node, rdata_item_t *);
		assert(arg->ic == ic_value);

		if (arg->u.value->var->vc != vc_int) {
			printf("Error: Array index is not an integer.\n");
			exit(1);
		}

		arg_val = arg->u.value->var->u.int_v->value;

		if (arg_val < 0 || arg_val >= array->extent[i]) {
			printf("Error: Array index (value: %d) is out of range.\n",
			    arg_val);
			run_raise_error(run);
			*res = run_recovery_item(run);
			return;
		}

		elem_index = elem_index * array->extent[i] + arg_val;

		node = list_next(args, node);
		i += 1;
	}

	if (i < array->rank) {
		printf("Error: Too few indices for array of rank %d",
		    array->rank);
		exit(1);
	}

	/* Construct variable address item. */
	ritem = rdata_item_new(ic_address);
	address = rdata_address_new(ac_var);
	addr_var = rdata_addr_var_new();
	ritem->u.address = address;
	address->u.var_a = addr_var;

	addr_var->vref = array->element[elem_index];

	*res = ritem;
}

/** Index an object (via its indexer). */
static void run_index_object(run_t *run, stree_index_t *index,
    rdata_item_t *base, list_t *args, rdata_item_t **res)
{
	rdata_item_t *ritem;
	rdata_address_t *address;
	rdata_addr_prop_t *addr_prop;
	rdata_aprop_indexed_t *aprop_indexed;
	rdata_var_t *obj_var;
	stree_csi_t *obj_csi;
	rdata_deleg_t *object_d;
	stree_symbol_t *indexer_sym;
	stree_ident_t *indexer_ident;

	list_node_t *node;
	rdata_item_t *arg;

#ifdef DEBUG_RUN_TRACE
	printf("Run object index operation.\n");
#endif
	(void) index;

	/* Construct property address item. */
	ritem = rdata_item_new(ic_address);
	address = rdata_address_new(ac_prop);
	addr_prop = rdata_addr_prop_new(apc_indexed);
	aprop_indexed = rdata_aprop_indexed_new();
	ritem->u.address = address;
	address->u.prop_a = addr_prop;
	addr_prop->u.indexed = aprop_indexed;

	if (base->ic != ic_address || base->u.address->ac != ac_var) {
		/* XXX Several other cases can occur. */
		printf("Unimplemented: Indexing object varclass via something "
		    "which is not a simple variable reference.\n");
		exit(1);
	}

	/* Find indexer symbol. */
	obj_var = base->u.address->u.var_a->vref;
	assert(obj_var->vc == vc_object);
	indexer_ident = stree_ident_new();
	indexer_ident->sid = strtab_get_sid(INDEXER_IDENT);
	obj_csi = symbol_to_csi(obj_var->u.object_v->class_sym);
	assert(obj_csi != NULL);
	indexer_sym = symbol_search_csi(run->program, obj_csi, indexer_ident);

	if (indexer_sym == NULL) {
		printf("Error: Accessing object which does not have an "
		    "indexer.\n");
		exit(1);
	}

	/* Construct delegate. */
	object_d = rdata_deleg_new();
	object_d->obj = obj_var;
	object_d->sym = indexer_sym;
	aprop_indexed->object_d = object_d;

	/* Copy list of argument values. */
	list_init(&aprop_indexed->args);

	node = list_first(args);
	while (node != NULL) {
		arg = list_node_data(node, rdata_item_t *);
		list_append(&aprop_indexed->args, arg);
		node = list_next(args, node);
	}

	*res = ritem;
}

/** Run index operation on string. */
static void run_index_string(run_t *run, stree_index_t *index,
    rdata_item_t *base, list_t *args, rdata_item_t **res)
{
	list_node_t *node;
	rdata_string_t *string;
	rdata_item_t *base_vi;
	rdata_item_t *arg;

	int i;
	int elem_index;
	int arg_val;
	int rc;

	rdata_value_t *value;
	rdata_var_t *cvar;
	rdata_item_t *ritem;
	int cval;

#ifdef DEBUG_RUN_TRACE
	printf("Run string index operation.\n");
#endif
	(void) run;
	(void) index;

	run_cvt_value_item(run, base, &base_vi);
	assert(base_vi->u.value->var->vc == vc_string);
	string = base->u.value->var->u.string_v;

	/*
	 * Linear index of the desired element. Elements are stored in
	 * lexicographic order with the last index changing the fastest.
	 */
	node = list_first(args);
	elem_index = 0;

	i = 0;
	while (node != NULL) {
		if (i >= 1) {
			printf("Error: Too many indices string.\n");
			exit(1);
		}

		arg = list_node_data(node, rdata_item_t *);
		assert(arg->ic == ic_value);

		if (arg->u.value->var->vc != vc_int) {
			printf("Error: String index is not an integer.\n");
			exit(1);
		}

		arg_val = arg->u.value->var->u.int_v->value;
		elem_index = arg_val;

		node = list_next(args, node);
		i += 1;
	}

	if (i < 1) {
		printf("Error: Too few indices for string.\n");
		exit(1);
	}

	rc = os_str_get_char(string->value, elem_index, &cval);
	if (rc != EOK) {
		printf("Error: String index (value: %d) is out of range.\n",
		    arg_val);
		exit(1);
	}

	/* Construct character value. */
	ritem = rdata_item_new(ic_value);
	value = rdata_value_new();
	ritem->u.value = value;

	cvar = rdata_var_new(vc_int);
	cvar->u.int_v = rdata_int_new();
	cvar->u.int_v->value = cval;
	value->var = cvar;

	*res = ritem;
}

/** Execute assignment. */
static void run_assign(run_t *run, stree_assign_t *assign, rdata_item_t **res)
{
	rdata_item_t *rdest_i, *rsrc_i;
	rdata_item_t *rsrc_vi;
	rdata_value_t *src_val;

#ifdef DEBUG_RUN_TRACE
	printf("Run assign operation.\n");
#endif
	run_expr(run, assign->dest, &rdest_i);
	run_expr(run, assign->src, &rsrc_i);

	run_cvt_value_item(run, rsrc_i, &rsrc_vi);
	assert(rsrc_vi->ic == ic_value);
	src_val = rsrc_vi->u.value;

	if (rdest_i->ic != ic_address) {
		printf("Error: Address expression required on left side of "
		    "assignment operator.\n");
		exit(1);
	}

	run_address_write(run, rdest_i->u.address, rsrc_vi->u.value);

	*res = NULL;
}

/** Execute @c as conversion. */
static void run_as(run_t *run, stree_as_t *as_op, rdata_item_t **res)
{
	rdata_item_t *rarg_i;
	rdata_item_t *rarg_vi;
	rdata_item_t *rarg_di;
	rdata_var_t *arg_vref;
	tdata_item_t *dtype;
	run_proc_ar_t *proc_ar;

	stree_symbol_t *obj_csi_sym;
	stree_csi_t *obj_csi;

#ifdef DEBUG_RUN_TRACE
	printf("Run @c as conversion operation.\n");
#endif
	run_expr(run, as_op->arg, &rarg_i);

	/*
	 * This should always be a reference if the argument is indeed
	 * a class instance.
	 */
	assert(run_item_get_vc(run, rarg_i) == vc_ref);
	run_cvt_value_item(run, rarg_i, &rarg_vi);
	assert(rarg_vi->ic == ic_value);

	if (rarg_vi->u.value->var->u.ref_v->vref == NULL) {
		/* Nil reference is always okay. */
		*res = rarg_vi;
		return;
	}

	run_dereference(run, rarg_vi, &rarg_di);

	/* Now we should have a variable address. */
	assert(rarg_di->ic == ic_address);
	assert(rarg_di->u.address->ac == ac_var);

	arg_vref = rarg_di->u.address->u.var_a->vref;

	proc_ar = run_get_current_proc_ar(run);
	/* XXX Memoize to avoid recomputing. */
	run_texpr(run->program, proc_ar->proc->outer_symbol->outer_csi,
	    as_op->dtype, &dtype);

	assert(arg_vref->vc == vc_object);
	obj_csi_sym = arg_vref->u.object_v->class_sym;
	obj_csi = symbol_to_csi(obj_csi_sym);
	assert(obj_csi != NULL);

	if (tdata_is_csi_derived_from_ti(obj_csi, dtype) != b_true) {
		printf("Error: Run-time type conversion error. Object is "
		    "of type '");
		symbol_print_fqn(obj_csi_sym);
		printf("' which is not derived from '");
		tdata_item_print(dtype);
		printf("'.\n");
		exit(1);
	}

	*res = rarg_vi;
}

/** Return boolean value of an item.
 *
 * Tries to interpret @a item as a boolean value. If it is not a boolean
 * value, this generates an error.
 *
 * XXX Currently int supplants the role of a true boolean type.
 */
bool_t run_item_boolean_value(run_t *run, rdata_item_t *item)
{
	rdata_item_t *vitem;
	rdata_var_t *var;

	(void) run;
	run_cvt_value_item(run, item, &vitem);

	assert(vitem->ic == ic_value);
	var = vitem->u.value->var;

	if (var->vc != vc_int) {
		printf("Error: Boolean (int) expression expected.\n");
		exit(1);
	}

	return (var->u.int_v->value != 0);
}