#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <ctype.h>
#include <string.h>
#include <assert.h>

#include "oberon.h"
#include "generator.h"

enum {
	EOF_ = 0,
	IDENT,
	MODULE,
	SEMICOLON,
	END,
	DOT,
	VAR,
	COLON,
	BEGIN,
	ASSIGN,
	INTEGER,
	TRUE,
	FALSE,
	LPAREN,
	RPAREN,
	EQUAL,
	NEQ,
	LESS,
	LEQ,
	GREAT,
	GEQ,
	PLUS,
	MINUS,
	OR,
	STAR,
	SLASH,
	DIV,
	MOD,
	AND,
	NOT,
	PROCEDURE,
	COMMA,
	RETURN,
	CONST,
	TYPE,
	ARRAY,
	OF,
	LBRACE,
	RBRACE,
	RECORD,
	POINTER,
	TO,
	UPARROW,
	NIL
};

// =======================================================================
//   UTILS
// ======================================================================= 

void
oberon_error(oberon_context_t * ctx, const char * fmt, ...)
{
	va_list ptr;
	va_start(ptr, fmt);
	fprintf(stderr, "error: ");
	vfprintf(stderr, fmt, ptr);
	fprintf(stderr, "\n");
	fprintf(stderr, "  code_index = %i\n", ctx -> code_index);
	fprintf(stderr, "  c          = %c\n", ctx -> c);
	fprintf(stderr, "  token      = %i\n", ctx -> token);
	va_end(ptr);
	exit(1);
}

static oberon_type_t *
oberon_new_type_ptr(int class)
{
	oberon_type_t * x = malloc(sizeof *x);
	memset(x, 0, sizeof *x);
	x -> class = class;
	return x;
}

static oberon_type_t *
oberon_new_type_integer(int size)
{
	oberon_type_t * x;
	x = oberon_new_type_ptr(OBERON_TYPE_INTEGER);
	x -> size = size;
	return x;
}

static oberon_type_t *
oberon_new_type_boolean(int size)
{
	oberon_type_t * x;
	x = oberon_new_type_ptr(OBERON_TYPE_BOOLEAN);
	x -> size = size;
	return x;
}

// =======================================================================
//   TABLE
// ======================================================================= 

static oberon_scope_t *
oberon_open_scope(oberon_context_t * ctx)
{
	oberon_scope_t * scope = malloc(sizeof *scope);
	memset(scope, 0, sizeof *scope);

	oberon_object_t * list = malloc(sizeof *list);
	memset(list, 0, sizeof *list);

	scope -> ctx = ctx;
	scope -> list = list;
	scope -> up = ctx -> decl;

	if(scope -> up)
	{
		scope -> parent = scope -> up -> parent;
		scope -> local = scope -> up -> local;
	}

	ctx -> decl = scope;
	return scope;
}

static void
oberon_close_scope(oberon_scope_t * scope)
{
	oberon_context_t * ctx = scope -> ctx;
	ctx -> decl = scope -> up;
}

static oberon_object_t *
oberon_define_object(oberon_scope_t * scope, char * name, int class)
{
	oberon_object_t * x = scope -> list;
	while(x -> next && strcmp(x -> next -> name, name) != 0)
	{
		x = x -> next;
	}

	if(x -> next)
	{
		oberon_error(scope -> ctx, "already defined");
	}

	oberon_object_t * newvar = malloc(sizeof *newvar);
	memset(newvar, 0, sizeof *newvar);
	newvar -> name = name;
	newvar -> class = class;
	newvar -> local = scope -> local;
	newvar -> parent = scope -> parent;

	x -> next = newvar;

	return newvar;
}

static void
oberon_define_field(oberon_context_t * ctx, oberon_type_t * rec, char *  name, oberon_type_t * type)
{
	// TODO check base fields

	oberon_object_t * x = rec -> decl;
	while(x -> next && strcmp(x -> next -> name, name) != 0)
	{
		x = x -> next;
	}

	if(x -> next)
	{
		oberon_error(ctx, "multiple definition");
	}

	oberon_object_t * field = malloc(sizeof *field);
	memset(field, 0, sizeof *field);
	field -> name = name;
	field -> class = OBERON_CLASS_FIELD;
	field -> type = type;
	field -> local = 1;
	field -> parent = NULL;

	rec -> num_decl += 1;
	x -> next = field;
}

static oberon_object_t *
oberon_find_object_in_list(oberon_object_t * list, char * name)
{
	oberon_object_t * x = list;
	while(x -> next && strcmp(x -> next -> name, name) != 0)
	{
		x = x -> next;
	}
	return x -> next;
}

static oberon_object_t *
oberon_find_object(oberon_scope_t * scope, char * name, int check_it)
{
	oberon_object_t * result = NULL;

	oberon_scope_t * s = scope;
	while(result == NULL && s != NULL)
	{
		result = oberon_find_object_in_list(s -> list, name);
		s = s -> up;
	}

	if(check_it && result == NULL)
	{
		oberon_error(scope -> ctx, "undefined ident %s", name);
	}

	return result;
}

static oberon_object_t *
oberon_find_field(oberon_context_t * ctx, oberon_type_t * rec, char * name)
{
	oberon_object_t * x = rec -> decl;
	for(int i = 0; i < rec -> num_decl; i++)
	{
		if(strcmp(x -> name, name) == 0)
		{
			return x;
		}
		x = x -> next;
	}

	oberon_error(ctx, "field not defined");

	return NULL;
}

static oberon_object_t *
oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type)
{
	oberon_object_t * id;
	id = oberon_define_object(scope, name, OBERON_CLASS_TYPE);
	id -> type = type;
	oberon_generator_init_type(scope -> ctx, type);
	return id;
}

/*
static oberon_type_t *
oberon_find_type(oberon_scope_t * scope, char * name)
{
	oberon_object_t * x = oberon_find_object(scope, name);
	if(x -> class != OBERON_CLASS_TYPE)
	{
		oberon_error(scope -> ctx, "%s not a type", name);
	}

	return x -> type;
}
*/

static oberon_object_t *
oberon_define_var(oberon_scope_t * scope, int class, char * name, oberon_type_t * type)
{
	oberon_object_t * var;
	var = oberon_define_object(scope, name, class);
	var -> type = type;
	return var;
}

/*
static oberon_object_t *
oberon_find_var(oberon_scope_t * scope, char * name)
{
	oberon_object_t * x = oberon_find_object(scope, name);

	if(x -> class != OBERON_CLASS_VAR)
	{
		oberon_error(scope -> ctx, "%s not a var", name);
	}

	return x;
}
*/

/*
static oberon_object_t *
oberon_define_proc(oberon_scope_t * scope, char * name, oberon_type_t * signature)
{
	oberon_object_t * proc;
	proc = oberon_define_object(scope, name, OBERON_CLASS_PROC);
	proc -> type = signature;
	return proc;
}
*/

// =======================================================================
//   SCANER
// ======================================================================= 

static void
oberon_get_char(oberon_context_t * ctx)
{
	ctx -> code_index += 1;
	ctx -> c = ctx -> code[ctx -> code_index];
}

static void
oberon_init_scaner(oberon_context_t * ctx, const char * code)
{
	ctx -> code = code;
	ctx -> code_index = 0;
	ctx -> c = ctx -> code[ctx -> code_index];
}

static void
oberon_read_ident(oberon_context_t * ctx)
{
	int len = 0;
	int i = ctx -> code_index;

	int c = ctx -> code[i];
	while(isalnum(c))
	{
		i += 1;
		len += 1;
		c = ctx -> code[i];
	}

	char * ident = malloc(len + 1);
	memcpy(ident, &ctx->code[ctx->code_index], len);
	ident[len] = 0;

	ctx -> code_index = i;
	ctx -> c = ctx -> code[i];
	ctx -> string = ident;
	ctx -> token = IDENT;

	if(strcmp(ident, "MODULE") == 0)
	{
		ctx -> token = MODULE;
	}
	else if(strcmp(ident, "END") == 0)
	{
		ctx -> token = END;
	}
	else if(strcmp(ident, "VAR") == 0)
	{
		ctx -> token = VAR;
	}
	else if(strcmp(ident, "BEGIN") == 0)
	{
		ctx -> token = BEGIN;
	}
	else if(strcmp(ident, "TRUE") == 0)
	{
		ctx -> token = TRUE;
	}
	else if(strcmp(ident, "FALSE") == 0)
	{
		ctx -> token = FALSE;
	}
	else if(strcmp(ident, "OR") == 0)
	{
		ctx -> token = OR;
	}
	else if(strcmp(ident, "DIV") == 0)
	{
		ctx -> token = DIV;
	}
	else if(strcmp(ident, "MOD") == 0)
	{
		ctx -> token = MOD;
	}
	else if(strcmp(ident, "PROCEDURE") == 0)
	{
		ctx -> token = PROCEDURE;
	}
	else if(strcmp(ident, "RETURN") == 0)
	{
		ctx -> token = RETURN;
	}
	else if(strcmp(ident, "CONST") == 0)
	{
		ctx -> token = CONST;
	}
	else if(strcmp(ident, "TYPE") == 0)
	{
		ctx -> token = TYPE;
	}
	else if(strcmp(ident, "ARRAY") == 0)
	{
		ctx -> token = ARRAY;
	}
	else if(strcmp(ident, "OF") == 0)
	{
		ctx -> token = OF;
	}
	else if(strcmp(ident, "RECORD") == 0)
	{
		ctx -> token = RECORD;
	}
	else if(strcmp(ident, "POINTER") == 0)
	{
		ctx -> token = POINTER;
	}
	else if(strcmp(ident, "TO") == 0)
	{
		ctx -> token = TO;
	}
	else if(strcmp(ident, "NIL") == 0)
	{
		ctx -> token = NIL;
	}
}

static void
oberon_read_integer(oberon_context_t * ctx)
{
	int len = 0;
	int i = ctx -> code_index;

	int c = ctx -> code[i];
	while(isdigit(c))
	{
		i += 1;
		len += 1;
		c = ctx -> code[i];
	}

	char * ident = malloc(len + 2);
	memcpy(ident, &ctx->code[ctx->code_index], len);
	ident[len + 1] = 0;

	ctx -> code_index = i;
	ctx -> c = ctx -> code[i];
	ctx -> string = ident;
	ctx -> integer = atoi(ident);
	ctx -> token = INTEGER;
}

static void
oberon_skip_space(oberon_context_t * ctx)
{
	while(isspace(ctx -> c))
	{
		oberon_get_char(ctx);
	}
}

static void
oberon_read_symbol(oberon_context_t * ctx)
{
	int c = ctx -> c;
	switch(c)
	{
		case 0:
			ctx -> token = EOF_;
			break;
		case ';':
			ctx -> token = SEMICOLON;
			oberon_get_char(ctx);
			break;
		case ':':
			ctx -> token = COLON;
			oberon_get_char(ctx);
			if(ctx -> c == '=')
			{
				ctx -> token = ASSIGN;
				oberon_get_char(ctx);
			}
			break;
		case '.':
			ctx -> token = DOT;
			oberon_get_char(ctx);
			break;
		case '(':
			ctx -> token = LPAREN;
			oberon_get_char(ctx);
			break;
		case ')':
			ctx -> token = RPAREN;
			oberon_get_char(ctx);
			break;
		case '=':
			ctx -> token = EQUAL;
			oberon_get_char(ctx);
			break;
		case '#':
			ctx -> token = NEQ;
			oberon_get_char(ctx);
			break;
		case '<':
			ctx -> token = LESS;
			oberon_get_char(ctx);
			if(ctx -> c == '=')
			{
				ctx -> token = LEQ;
				oberon_get_char(ctx);
			}
			break;
		case '>':
			ctx -> token = GREAT;
			oberon_get_char(ctx);
			if(ctx -> c == '=')
			{
				ctx -> token = GEQ;
				oberon_get_char(ctx);
			}
			break;
		case '+':
			ctx -> token = PLUS;
			oberon_get_char(ctx);
			break;
		case '-':
			ctx -> token = MINUS;
			oberon_get_char(ctx);
			break;
		case '*':
			ctx -> token = STAR;
			oberon_get_char(ctx);
			break;
		case '/':
			ctx -> token = SLASH;
			oberon_get_char(ctx);
			break;
		case '&':
			ctx -> token = AND;
			oberon_get_char(ctx);
			break;
		case '~':
			ctx -> token = NOT;
			oberon_get_char(ctx);
			break;
		case ',':
			ctx -> token = COMMA;
			oberon_get_char(ctx);
			break;
		case '[':
			ctx -> token = LBRACE;
			oberon_get_char(ctx);
			break;
		case ']':
			ctx -> token = RBRACE;
			oberon_get_char(ctx);
			break;
		case '^':
			ctx -> token = UPARROW;
			oberon_get_char(ctx);
			break;
		default:
			oberon_error(ctx, "invalid char");
			break;
	}
}

static void
oberon_read_token(oberon_context_t * ctx)
{
	oberon_skip_space(ctx);

	int c = ctx -> c;
	if(isalpha(c))
	{
		oberon_read_ident(ctx);
	}
	else if(isdigit(c))
	{
		oberon_read_integer(ctx);
	}
	else
	{
		oberon_read_symbol(ctx);
	}
}

// =======================================================================
//   EXPRESSION
// =======================================================================

static void oberon_expect_token(oberon_context_t * ctx, int token);
static oberon_expr_t * oberon_expr(oberon_context_t * ctx);
static void oberon_assert_token(oberon_context_t * ctx, int token);
static char * oberon_assert_ident(oberon_context_t * ctx);
static void oberon_type(oberon_context_t * ctx, oberon_type_t ** type);
static oberon_item_t * oberon_const_expr(oberon_context_t * ctx);

static oberon_expr_t *
oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right)
{
	oberon_oper_t * operator;
	operator = malloc(sizeof *operator);
	memset(operator, 0, sizeof *operator);

	operator -> is_item = 0;
	operator -> result = result;
	operator -> op = op;
	operator -> left = left;
	operator -> right = right;

	return (oberon_expr_t *) operator;
}

static oberon_expr_t *
oberon_new_item(int mode, oberon_type_t * result)
{
	oberon_item_t * item;
        item = malloc(sizeof *item);
        memset(item, 0, sizeof *item);

	item -> is_item = 1;
	item -> result = result;
	item -> mode = mode;

	return (oberon_expr_t *)item;
}

static oberon_expr_t *
oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a)
{
	oberon_expr_t * expr;
	oberon_type_t * result;

	result = a -> result;

	if(token == MINUS)
	{
		if(result -> class != OBERON_TYPE_INTEGER)
		{
			oberon_error(ctx, "incompatible operator type");
		}

		expr = oberon_new_operator(OP_UNARY_MINUS, result, a, NULL);
	}
	else if(token == NOT)
	{
		if(result -> class != OBERON_TYPE_BOOLEAN)
		{
			oberon_error(ctx, "incompatible operator type");
		}

		expr = oberon_new_operator(OP_LOGIC_NOT, result, a, NULL);
	}
	else
	{
		oberon_error(ctx, "oberon_make_unary_op: wat");
	}

	return expr;
}

static void
oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first, int const_expr)
{
	oberon_expr_t * last;

	*num_expr = 1;
	*first = last = oberon_expr(ctx);
	while(ctx -> token == COMMA)
	{
		oberon_assert_token(ctx, COMMA);
		oberon_expr_t * current;

		if(const_expr)
		{
			current = (oberon_expr_t *) oberon_const_expr(ctx);
		}
		else
		{
			current = oberon_expr(ctx);
		}

		last -> next = current;
		last = current;
		*num_expr += 1;
	}
}

static oberon_expr_t *
oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
{
	if(pref -> class != expr -> result -> class)
	{
		oberon_error(ctx, "incompatible types");
	}

	if(pref -> class == OBERON_TYPE_INTEGER)
	{
		if(expr -> result -> class > pref -> class)
		{
			oberon_error(ctx, "incompatible size");
		}
	}
	else if(pref -> class == OBERON_TYPE_RECORD)
	{
		if(expr -> result != pref)
		{
			printf("oberon_autocast_to: rec %p != %p\n", expr -> result, pref);
			oberon_error(ctx, "incompatible record types");
		}
	}
	else if(pref -> class == OBERON_TYPE_POINTER)
	{
		if(expr -> result -> base != pref -> base)
		{
			if(expr -> result -> base -> class != OBERON_TYPE_VOID)
			{
				oberon_error(ctx, "incompatible pointer types");
			}
		}
	}

	// TODO cast

	return expr;
}

static void
oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
{
	if(desig -> is_item == 0)
	{
		oberon_error(ctx, "expected item");
	}

	if(desig -> item.mode != MODE_CALL)
	{
		oberon_error(ctx, "expected mode CALL");
	}

	if(desig -> item.var -> class != OBERON_CLASS_PROC)
	{
		oberon_error(ctx, "only procedures can be called");
	}

	oberon_type_t * fn = desig -> item.var -> type;
	int num_args = desig -> item.num_args;
	int num_decl = fn -> num_decl;

	if(num_args < num_decl)
	{
		oberon_error(ctx, "too few arguments");
	}
	else if(num_args > num_decl)
	{
		oberon_error(ctx, "too many arguments");
	}

	oberon_expr_t * arg = desig -> item.args;
	oberon_object_t * param = fn -> decl;
	for(int i = 0; i < num_args; i++)
	{
		if(param -> class == OBERON_CLASS_VAR_PARAM)
		{
			if(arg -> is_item)
			{
				switch(arg -> item.mode)
				{
					case MODE_VAR:
					case MODE_INDEX:
					case MODE_FIELD:
					// Допустимо разыменование?
					//case MODE_DEREF:
						break;
					default:
						oberon_error(ctx, "var-parameter accept only variables");
						break;
				}
			}
		}
		oberon_autocast_to(ctx, arg, param -> type);
		arg = arg -> next;
		param = param -> next;
	}
}

static oberon_expr_t *
oberon_make_call_func(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args)
{
	if(proc -> class != OBERON_CLASS_PROC)
	{
		oberon_error(ctx, "not a procedure");
	}

	oberon_expr_t * call;

	if(proc -> sysproc)
	{
		if(proc -> genfunc == NULL)
		{
			oberon_error(ctx, "not a function-procedure");
		}

		call = proc -> genfunc(ctx, num_args, list_args);
	}
	else
	{
		if(proc -> type -> base -> class == OBERON_TYPE_VOID)
		{
			oberon_error(ctx, "attempt to call procedure in expression");
		}

		call = oberon_new_item(MODE_CALL, proc -> type -> base);
		call -> item.var = proc;
		call -> item.num_args = num_args;
		call -> item.args = list_args;
		oberon_autocast_call(ctx, call);
	}

	return call;
}

static void
oberon_make_call_proc(oberon_context_t * ctx, oberon_object_t * proc, int num_args, oberon_expr_t * list_args)
{
	if(proc -> class != OBERON_CLASS_PROC)
	{
		oberon_error(ctx, "not a procedure");
	}

	if(proc -> sysproc)
	{
		if(proc -> genproc == NULL)
		{
			oberon_error(ctx, "requres non-typed procedure");
		}

		proc -> genproc(ctx, num_args, list_args);
	}
	else
	{
		if(proc -> type -> base -> class != OBERON_TYPE_VOID)
		{
			oberon_error(ctx, "attempt to call function as non-typed procedure");
		}

		oberon_expr_t * call;
		call = oberon_new_item(MODE_CALL, proc -> type -> base);
		call -> item.var = proc;
		call -> item.num_args = num_args;
		call -> item.args = list_args;
		oberon_autocast_call(ctx, call);
		oberon_generate_call_proc(ctx, call);
	}
}

#define ISEXPR(x) \
	(((x) == PLUS) \
	|| ((x) == MINUS) \
	|| ((x) == IDENT) \
	|| ((x) == INTEGER) \
	|| ((x) == LPAREN) \
	|| ((x) == NOT) \
	|| ((x) == TRUE) \
	|| ((x) == FALSE))

static oberon_expr_t *
oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr)
{
	if(expr -> result -> class != OBERON_TYPE_POINTER)
	{
		oberon_error(ctx, "not a pointer");
	}

	assert(expr -> is_item);

	oberon_expr_t * selector;
	selector = oberon_new_item(MODE_DEREF, expr -> result -> base);
	selector -> item.parent = (oberon_item_t *) expr;

	return selector;
}

static oberon_expr_t *
oberon_make_array_selector(oberon_context_t * ctx, oberon_expr_t * desig, oberon_expr_t * index)
{
	if(desig -> result -> class == OBERON_TYPE_POINTER)
	{
		desig = oberno_make_dereferencing(ctx, desig);
	}

	assert(desig -> is_item);

	if(desig -> result -> class != OBERON_TYPE_ARRAY)
	{
		oberon_error(ctx, "not array");
	}

	oberon_type_t * base;
	base = desig -> result -> base;

	if(index -> result -> class != OBERON_TYPE_INTEGER)
	{
		oberon_error(ctx, "index must be integer");
	}

	// Статическая проверка границ массива
	if(index -> is_item)
	{
		if(index -> item.mode == MODE_INTEGER)
		{
			int arr_size = desig -> result -> size;
			int index_int = index -> item.integer;
			if(index_int < 0 || index_int > arr_size - 1)
			{
				oberon_error(ctx, "not in range (dimension size 0..%i)", arr_size - 1);
			}
		}
	}

	oberon_expr_t * selector;
	selector = oberon_new_item(MODE_INDEX, base);
	selector -> item.parent = (oberon_item_t *) desig;
	selector -> item.num_args = 1;
	selector -> item.args = index;

	return selector;
}

static oberon_expr_t *
oberon_make_record_selector(oberon_context_t * ctx, oberon_expr_t * expr, char * name)
{
	if(expr -> result -> class == OBERON_TYPE_POINTER)
	{
		expr = oberno_make_dereferencing(ctx, expr);
	}

	assert(expr -> is_item == 1);

	if(expr -> result -> class != OBERON_TYPE_RECORD)
	{
		oberon_error(ctx, "not record");
	}

	oberon_type_t * rec = expr -> result;

	oberon_object_t * field;
	field = oberon_find_field(ctx, rec, name);

	oberon_expr_t * selector;
	selector = oberon_new_item(MODE_FIELD, field -> type);
	selector -> item.var = field;
	selector -> item.parent = (oberon_item_t *) expr;

	return selector;
}

#define ISSELECTOR(x) \
	(((x) == LBRACE) \
	|| ((x) == DOT) \
	|| ((x) == UPARROW))

static oberon_expr_t *
oberon_designator(oberon_context_t * ctx)
{
	char * name;
	oberon_object_t * var;
	oberon_expr_t * expr;

	name = oberon_assert_ident(ctx);
	var = oberon_find_object(ctx -> decl, name, 1);

	switch(var -> class)
	{
		case OBERON_CLASS_CONST:
			// TODO copy value
			expr = (oberon_expr_t *) var -> value;
			break;
		case OBERON_CLASS_VAR:
		case OBERON_CLASS_VAR_PARAM:
		case OBERON_CLASS_PARAM:
			expr = oberon_new_item(MODE_VAR, var -> type);
			break;
		case OBERON_CLASS_PROC:
			//expr = oberon_make_call_expr(var, 0, NULL);
			expr = oberon_new_item(MODE_CALL, var -> type);
			break;
		default:
			oberon_error(ctx, "invalid designator");
			break;
	}
	expr -> item.var = var;

	while(ISSELECTOR(ctx -> token))
	{
		switch(ctx -> token)
		{
			case DOT:
				oberon_assert_token(ctx, DOT);
				name = oberon_assert_ident(ctx);
				expr = oberon_make_record_selector(ctx, expr, name);
				break;
			case LBRACE:
				oberon_assert_token(ctx, LBRACE);
				int num_indexes = 0;
				oberon_expr_t * indexes = NULL;
				oberon_expr_list(ctx, &num_indexes, &indexes, 0);
				oberon_assert_token(ctx, RBRACE);

				for(int i = 0; i < num_indexes; i++)
				{
					expr = oberon_make_array_selector(ctx, expr, indexes);
					indexes = indexes -> next;
				}
				break;
			case UPARROW:
				oberon_assert_token(ctx, UPARROW);
				expr = oberno_make_dereferencing(ctx, expr);
				break;
			default:
				oberon_error(ctx, "oberon_designator: wat");
				break;
		}
	}
	return expr;
}

static oberon_expr_t *
oberon_opt_func_parens(oberon_context_t * ctx, oberon_expr_t * expr)
{
	assert(expr -> is_item == 1);

	if(ctx -> token == LPAREN)
	{
		oberon_assert_token(ctx, LPAREN);

		int num_args = 0;
		oberon_expr_t * arguments = NULL;

		if(ISEXPR(ctx -> token))
		{
			oberon_expr_list(ctx, &num_args, &arguments, 0);
		}

		expr = oberon_make_call_func(ctx, expr -> item.var, num_args, arguments);

		oberon_assert_token(ctx, RPAREN);
	}

	return expr;
}

static void
oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr)
{
	assert(expr -> is_item == 1);

	if(ctx -> token == LPAREN)
	{
		oberon_assert_token(ctx, LPAREN);

		int num_args = 0;
		oberon_expr_t * arguments = NULL;

		if(ISEXPR(ctx -> token))
		{
			oberon_expr_list(ctx, &num_args, &arguments, 0);
		}

		oberon_make_call_proc(ctx, expr -> item.var, num_args, arguments);

		oberon_assert_token(ctx, RPAREN);
	}
}

static oberon_expr_t *
oberon_factor(oberon_context_t * ctx)
{
	oberon_expr_t * expr;

	switch(ctx -> token)
	{
		case IDENT:
			expr = oberon_designator(ctx);
			expr = oberon_opt_func_parens(ctx, expr);
			break;
		case INTEGER:
			expr = oberon_new_item(MODE_INTEGER, ctx -> int_type);
			expr -> item.integer = ctx -> integer;
			oberon_assert_token(ctx, INTEGER);
			break;
		case TRUE:
			expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type);
			expr -> item.boolean = 1;
			oberon_assert_token(ctx, TRUE);
			break;
		case FALSE:
			expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type);
			expr -> item.boolean = 0;
			oberon_assert_token(ctx, FALSE);
			break;
		case LPAREN:
			oberon_assert_token(ctx, LPAREN);
			expr = oberon_expr(ctx);
			oberon_assert_token(ctx, RPAREN);
			break;
		case NOT:
			oberon_assert_token(ctx, NOT);
			expr = oberon_factor(ctx);
			expr = oberon_make_unary_op(ctx, NOT, expr);
			break;
		case NIL:
			oberon_assert_token(ctx, NIL);
			expr = oberon_new_item(MODE_NIL, ctx -> void_ptr_type);
			break;
		default:
			oberon_error(ctx, "invalid expression");
	}

	return expr;
}

/*
 * oberon_autocast_binary_op автоматически переобразовывеат тип по след. правилам:
 *   1. Классы обоих типов должны быть одинаковы
 *   2. В качестве результата должен быть выбран больший тип.
 *   3. Если размер результат не должен быть меньше чем базовый int
 */

static void
oberon_autocast_binary_op(oberon_context_t * ctx, oberon_type_t * a, oberon_type_t * b, oberon_type_t ** result)
{
	if((a -> class) != (b -> class))
	{
		oberon_error(ctx, "incompatible types");
	}

	if((a -> size) > (b -> size))
	{
		*result = a;
	}
	else
	{
		*result = b;
	}

	if(((*result) -> class) == OBERON_TYPE_INTEGER)
	{
		if(((*result) -> size) < (ctx -> int_type -> size))
		{
			*result = ctx -> int_type;
		}
	}

	/* TODO: cast types */
}

#define ITMAKESBOOLEAN(x) \
	(((x) >= EQUAL && (x) <= GEQ) || ((x) == OR) || ((x) == AND))

#define ITUSEONLYINTEGER(x) \
	((x) >= LESS && (x) <= GEQ)

#define ITUSEONLYBOOLEAN(x) \
	(((x) == OR) || ((x) == AND))

static oberon_expr_t *
oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_expr_t * b)
{
	oberon_expr_t * expr;
	oberon_type_t * result;

	if(ITMAKESBOOLEAN(token))
	{
		if(ITUSEONLYINTEGER(token))
		{
			if(a -> result -> class != OBERON_TYPE_INTEGER
				|| b -> result -> class != OBERON_TYPE_INTEGER)
			{
				oberon_error(ctx, "used only with integer types");
			}
		}
		else if(ITUSEONLYBOOLEAN(token))
		{
			if(a -> result -> class != OBERON_TYPE_BOOLEAN
				|| b -> result -> class != OBERON_TYPE_BOOLEAN)
			{
				oberon_error(ctx, "used only with boolean type");
			}
		}

		result = ctx -> bool_type;

		if(token == EQUAL)
		{
			expr = oberon_new_operator(OP_EQ, result, a, b);
		}
		else if(token == NEQ)
		{
			expr = oberon_new_operator(OP_NEQ, result, a, b);
		}
		else if(token == LESS)
		{
			expr = oberon_new_operator(OP_LSS, result, a, b);
		}
		else if(token == LEQ)
		{
			expr = oberon_new_operator(OP_LEQ, result, a, b);
		}
		else if(token == GREAT)
		{
			expr = oberon_new_operator(OP_GRT, result, a, b);
		}
		else if(token == GEQ)
		{
			expr = oberon_new_operator(OP_GEQ, result, a, b);
		}
		else if(token == OR)
		{
			expr = oberon_new_operator(OP_LOGIC_OR, result, a, b);
		}
		else if(token == AND)
		{
			expr = oberon_new_operator(OP_LOGIC_AND, result, a, b);
		}
		else
		{
			oberon_error(ctx, "oberon_make_bin_op: bool wat");
		}
	}
	else
	{
		oberon_autocast_binary_op(ctx, a -> result, b -> result, &result);

		if(token == PLUS)
		{
			expr = oberon_new_operator(OP_ADD, result, a, b);
		}
		else if(token == MINUS)
		{
			expr = oberon_new_operator(OP_SUB, result, a, b);
		}
		else if(token == STAR)
		{
			expr = oberon_new_operator(OP_MUL, result, a, b);
		}
		else if(token == SLASH)
		{
			expr = oberon_new_operator(OP_DIV, result, a, b);
		}
		else if(token == DIV)
		{
			expr = oberon_new_operator(OP_DIV, result, a, b);
		}
		else if(token == MOD)
		{
			expr = oberon_new_operator(OP_MOD, result, a, b);
		}
		else
		{
			oberon_error(ctx, "oberon_make_bin_op: bin wat");
		}
	}

	return expr;
}

#define ISMULOP(x) \
	((x) >= STAR && (x) <= AND)

static oberon_expr_t *
oberon_term_expr(oberon_context_t * ctx)
{
	oberon_expr_t * expr;

	expr = oberon_factor(ctx);
	while(ISMULOP(ctx -> token))
	{
		int token = ctx -> token;
		oberon_read_token(ctx);

		oberon_expr_t * inter = oberon_factor(ctx);
		expr = oberon_make_bin_op(ctx, token, expr, inter);
	}

	return expr;
}

#define ISADDOP(x) \
	((x) >= PLUS && (x) <= OR)

static oberon_expr_t *
oberon_simple_expr(oberon_context_t * ctx)
{
	oberon_expr_t * expr;

	int minus = 0;
	if(ctx -> token == PLUS)
	{
		minus = 0;
		oberon_assert_token(ctx, PLUS);
	}
	else if(ctx -> token == MINUS)
	{
		minus = 1;
		oberon_assert_token(ctx, MINUS);
	}

	expr = oberon_term_expr(ctx);
	while(ISADDOP(ctx -> token))
	{
		int token = ctx -> token;
		oberon_read_token(ctx);

		oberon_expr_t * inter = oberon_term_expr(ctx);
		expr = oberon_make_bin_op(ctx, token, expr, inter);
	}

	if(minus)
	{
		expr = oberon_make_unary_op(ctx, MINUS, expr);
	}

	return expr;
}

#define ISRELATION(x) \
	((x) >= EQUAL && (x) <= GEQ)

static oberon_expr_t *
oberon_expr(oberon_context_t * ctx)
{
	oberon_expr_t * expr;

	expr = oberon_simple_expr(ctx);
	while(ISRELATION(ctx -> token))
	{
		int token = ctx -> token;
		oberon_read_token(ctx);

		oberon_expr_t * inter = oberon_simple_expr(ctx);
		expr = oberon_make_bin_op(ctx, token, expr, inter);
	}

	return expr;
}

static oberon_item_t *
oberon_const_expr(oberon_context_t * ctx)
{
	oberon_expr_t * expr;
	expr = oberon_expr(ctx);

	if(expr -> is_item == 0)
	{
		oberon_error(ctx, "const expression are required");
	}

	return (oberon_item_t *) expr;
}

// =======================================================================
//   PARSER
// =======================================================================

static void oberon_decl_seq(oberon_context_t * ctx);
static void oberon_statement_seq(oberon_context_t * ctx);
static void oberon_initialize_decl(oberon_context_t * ctx);

static void
oberon_expect_token(oberon_context_t * ctx, int token)
{
	if(ctx -> token != token)
	{
		oberon_error(ctx, "unexpected token %i (%i)", ctx -> token, token);
	}
}

static void
oberon_assert_token(oberon_context_t * ctx, int token)
{
	oberon_expect_token(ctx, token);
	oberon_read_token(ctx);
}

static char *
oberon_assert_ident(oberon_context_t * ctx)
{
	oberon_expect_token(ctx, IDENT);
	char * ident = ctx -> string;
	oberon_read_token(ctx);
	return ident;
}

static void
oberon_var_decl(oberon_context_t * ctx)
{
	char * name;
	oberon_type_t * type;
	type = oberon_new_type_ptr(OBERON_TYPE_VOID);

	name = oberon_assert_ident(ctx);
	oberon_assert_token(ctx, COLON);
	oberon_type(ctx, &type);
	oberon_define_var(ctx -> decl, OBERON_CLASS_VAR, name, type);
}

static oberon_object_t *
oberon_make_param(oberon_context_t * ctx, int token, char * name, oberon_type_t * type)
{
	oberon_object_t * param;

	if(token == VAR)
	{
		param = oberon_define_var(ctx -> decl, OBERON_CLASS_VAR_PARAM, name, type);
	}
	else if(token == IDENT)
	{
		param = oberon_define_var(ctx -> decl, OBERON_CLASS_PARAM, name, type);
	}
	else
	{
		oberon_error(ctx, "oberon_make_param: wat");
	}

	return param;
}

static oberon_object_t *
oberon_fp_section(oberon_context_t * ctx, int * num_decl)
{
	int modifer_token = ctx -> token;
	if(ctx -> token == VAR)
	{
		oberon_read_token(ctx);
	}

	char * name;
	name = oberon_assert_ident(ctx);

	oberon_assert_token(ctx, COLON);

	oberon_type_t * type;
	type = oberon_new_type_ptr(OBERON_TYPE_VOID);
	oberon_type(ctx, &type);

	oberon_object_t * first;
	first = oberon_make_param(ctx, modifer_token, name, type);

	*num_decl += 1;
	return first;
}

#define ISFPSECTION \
	((ctx -> token == VAR) || (ctx -> token == IDENT))

static void
oberon_formal_pars(oberon_context_t * ctx, oberon_type_t * signature)
{
	oberon_assert_token(ctx, LPAREN);

	if(ISFPSECTION)
	{
		signature -> decl = oberon_fp_section(ctx, &signature -> num_decl);
		while(ctx -> token == SEMICOLON)
		{
			oberon_assert_token(ctx, SEMICOLON);
			oberon_fp_section(ctx, &signature -> num_decl);
		}
	}

	oberon_assert_token(ctx, RPAREN);

	if(ctx -> token == COLON)
	{
		oberon_assert_token(ctx, COLON);
		// TODO get by qualident
		oberon_type(ctx, &signature -> base);
	}
}

static void
oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type)
{
	oberon_type_t * signature;
	signature = *type;
	signature -> class = OBERON_TYPE_PROCEDURE;
	signature -> num_decl = 0;
	signature -> base = ctx -> void_type;
	signature -> decl = NULL;

	if(ctx -> token == LPAREN)
	{
		oberon_formal_pars(ctx, signature);
	}
}

static void
oberon_compare_signatures(oberon_context_t * ctx, oberon_type_t * a, oberon_type_t * b)
{
	if(a -> num_decl != b -> num_decl)
	{
		oberon_error(ctx, "number parameters not matched");
	}

	int num_param = a -> num_decl;
	oberon_object_t * param_a = a -> decl;
	oberon_object_t * param_b = b -> decl;
	for(int i = 0; i < num_param; i++)
	{
		if(strcmp(param_a -> name, param_b -> name) != 0)
		{
			oberon_error(ctx, "param %i name not matched", i + 1);
		}

		if(param_a -> type != param_b -> type)
		{
			oberon_error(ctx, "param %i type not matched", i + 1);
		}

		param_a = param_a -> next;
		param_b = param_b -> next;
	}
}

static void
oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
{
	oberon_object_t * proc = ctx -> decl -> parent;
	oberon_type_t * result_type = proc -> type -> base;

	if(result_type -> class == OBERON_TYPE_VOID)
	{
		if(expr != NULL)
		{
			oberon_error(ctx, "procedure has no result type");
		}
	}
	else
	{
		if(expr == NULL)
		{
			oberon_error(ctx, "procedure requires expression on result");
		}

		oberon_autocast_to(ctx, expr, result_type);
	}

	proc -> has_return = 1;

	oberon_generate_return(ctx, expr);
}

static void
oberon_proc_decl_body(oberon_context_t * ctx, oberon_object_t * proc)
{
	oberon_assert_token(ctx, SEMICOLON);

	ctx -> decl = proc -> scope;

	oberon_decl_seq(ctx);

	oberon_generate_begin_proc(ctx, proc);

	if(ctx -> token == BEGIN)
	{
		oberon_assert_token(ctx, BEGIN);
		oberon_statement_seq(ctx);
	}

	oberon_assert_token(ctx, END);
	char * name = oberon_assert_ident(ctx);
	if(strcmp(name, proc -> name) != 0)
	{
		oberon_error(ctx, "procedure name not matched");
	}

	if(proc -> type -> base -> class == OBERON_TYPE_VOID
		&& proc -> has_return == 0)
	{
		oberon_make_return(ctx, NULL);
	}

	if(proc -> has_return == 0)
	{
		oberon_error(ctx, "procedure requires return");
	}

	oberon_generate_end_proc(ctx);
	oberon_close_scope(ctx -> decl);
}

static void
oberon_proc_decl(oberon_context_t * ctx)
{
	oberon_assert_token(ctx, PROCEDURE);

	int forward = 0;
	if(ctx -> token == UPARROW)
	{
		oberon_assert_token(ctx, UPARROW);
		forward = 1;
	}

	char * name;
	name = oberon_assert_ident(ctx);

	oberon_scope_t * proc_scope;
	proc_scope = oberon_open_scope(ctx);
	ctx -> decl -> local = 1;

	oberon_type_t * signature;
	signature = oberon_new_type_ptr(OBERON_TYPE_VOID);
	oberon_opt_formal_pars(ctx, &signature);	

	oberon_initialize_decl(ctx);
	oberon_generator_init_type(ctx, signature);
	oberon_close_scope(ctx -> decl);

	oberon_object_t * proc;
	proc = oberon_find_object(ctx -> decl, name, 0);
	if(proc != NULL)
	{
		if(proc -> class != OBERON_CLASS_PROC)
		{
			oberon_error(ctx, "mult definition");
		}

		if(forward == 0)
		{
			if(proc -> linked)
			{
				oberon_error(ctx, "mult procedure definition");
			}
		}

		oberon_compare_signatures(ctx, proc -> type, signature);
	}
	else
	{
		proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC);
		proc -> type = signature;
		proc -> scope = proc_scope;
		oberon_generator_init_proc(ctx, proc);
	}

	proc -> scope -> parent = proc;

	if(forward == 0)
	{
		proc -> linked = 1;
		oberon_proc_decl_body(ctx, proc);
	}
}

static void
oberon_const_decl(oberon_context_t * ctx)
{
	char * name;
	oberon_item_t * value;
	oberon_object_t * constant;

	name = oberon_assert_ident(ctx);
	oberon_assert_token(ctx, EQUAL);
	value = oberon_const_expr(ctx);

	constant = oberon_define_object(ctx -> decl, name, OBERON_CLASS_CONST);
	constant -> value = value;
}

static void
oberon_make_array_type(oberon_context_t * ctx, oberon_expr_t * size, oberon_type_t * base, oberon_type_t ** type)
{
	if(size -> is_item == 0)
	{
		oberon_error(ctx, "requires constant");
	}

	if(size -> item.mode != MODE_INTEGER)
	{
		oberon_error(ctx, "requires integer constant");
	}

	oberon_type_t * arr;
	arr = *type;
	arr -> class = OBERON_TYPE_ARRAY;
	arr -> size = size -> item.integer;
	arr -> base = base;
}

static void
oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec)
{
	if(ctx -> token == IDENT)
	{
		char * name;
		oberon_type_t * type;
		type = oberon_new_type_ptr(OBERON_TYPE_VOID);

		name = oberon_assert_ident(ctx);
		oberon_assert_token(ctx, COLON);
		oberon_type(ctx, &type);
		oberon_define_field(ctx, rec, name, type);
	}
}

static void
oberon_qualident_type(oberon_context_t * ctx, oberon_type_t ** type)
{
	char * name;
	oberon_object_t * to;

	name = oberon_assert_ident(ctx);
	to = oberon_find_object(ctx -> decl, name, 0);

	if(to != NULL)
	{
		if(to -> class != OBERON_CLASS_TYPE)
		{
			oberon_error(ctx, "not a type");
		}
	}
	else
	{
		to = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE);
		to -> type = oberon_new_type_ptr(OBERON_TYPE_VOID);
	}

	*type = to -> type;
}

static void oberon_opt_formal_pars(oberon_context_t * ctx, oberon_type_t ** type);

/*
 * Правило граматики "type". Указатель type должен указывать на существующий объект!
 */

static void
oberon_make_multiarray(oberon_context_t * ctx, oberon_expr_t * sizes, oberon_type_t * base, oberon_type_t ** type)
{
	if(sizes == NULL)
	{
		*type = base;
		return;
	}

	oberon_type_t * dim;
	dim = oberon_new_type_ptr(OBERON_TYPE_VOID);

	oberon_make_multiarray(ctx, sizes -> next, base, &dim);

	oberon_make_array_type(ctx, sizes, dim, type);
}

static void
oberon_type(oberon_context_t * ctx, oberon_type_t ** type)
{
	if(ctx -> token == IDENT)
	{
		oberon_qualident_type(ctx, type);
	}
	else if(ctx -> token == ARRAY)
	{
		oberon_assert_token(ctx, ARRAY);

		int num_sizes = 0;
		oberon_expr_t * sizes;
		oberon_expr_list(ctx, &num_sizes, &sizes, 1);

		oberon_assert_token(ctx, OF);

		oberon_type_t * base;
		base = oberon_new_type_ptr(OBERON_TYPE_VOID);
		oberon_type(ctx, &base);

		oberon_make_multiarray(ctx, sizes, base, type);
	}
	else if(ctx -> token == RECORD)
	{
		oberon_type_t * rec;
		rec = *type;
		rec -> class = OBERON_TYPE_RECORD;
		oberon_object_t * list = malloc(sizeof *list);
	        memset(list, 0, sizeof *list);
		rec -> num_decl = 0;
		rec -> base = NULL;
		rec -> decl = list;

		oberon_assert_token(ctx, RECORD);
		oberon_field_list(ctx, rec);
		while(ctx -> token == SEMICOLON)
		{
			oberon_assert_token(ctx, SEMICOLON);
			oberon_field_list(ctx, rec);
		}
		oberon_assert_token(ctx, END);

		rec -> decl = rec -> decl -> next;
		*type = rec;
	}
	else if(ctx -> token == POINTER)
	{
		oberon_assert_token(ctx, POINTER);
		oberon_assert_token(ctx, TO);

		oberon_type_t * base;
		base = oberon_new_type_ptr(OBERON_TYPE_VOID);
		oberon_type(ctx, &base);

		oberon_type_t * ptr;
		ptr = *type;
		ptr -> class = OBERON_TYPE_POINTER;
		ptr -> base = base;
	}
	else if(ctx -> token == PROCEDURE)
	{
		oberon_open_scope(ctx);
		oberon_assert_token(ctx, PROCEDURE);
		oberon_opt_formal_pars(ctx, type);
		oberon_close_scope(ctx -> decl);
	}
	else
	{
		oberon_error(ctx, "invalid type declaration");
	}
}

static void
oberon_type_decl(oberon_context_t * ctx)
{
	char * name;
	oberon_object_t * newtype;
	oberon_type_t * type;

	name = oberon_assert_ident(ctx);

	newtype = oberon_find_object(ctx -> decl, name, 0);
	if(newtype == NULL)
	{
		newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE);
		newtype -> type = oberon_new_type_ptr(OBERON_TYPE_VOID);
		assert(newtype -> type);
	}
	else
	{
		if(newtype -> class != OBERON_CLASS_TYPE)
		{
			oberon_error(ctx, "mult definition");
		}

		if(newtype -> linked)
		{
			oberon_error(ctx, "mult definition - already linked");
		}
	}

	oberon_assert_token(ctx, EQUAL);

	type = newtype -> type;
	oberon_type(ctx, &type);

	if(type -> class == OBERON_TYPE_VOID)
	{
		oberon_error(ctx, "recursive alias declaration");
	}

	newtype -> type = type;
	newtype -> linked = 1;
}

static void oberon_prevent_recursive_object(oberon_context_t * ctx, oberon_object_t * x);
static void oberon_prevent_recursive_type(oberon_context_t * ctx, oberon_type_t * type);

static void
oberon_prevent_recursive_pointer(oberon_context_t * ctx, oberon_type_t * type)
{
	if(type -> class != OBERON_TYPE_POINTER
		&& type -> class != OBERON_TYPE_ARRAY)
	{
		return;
	}

	if(type -> recursive)
	{
		oberon_error(ctx, "recursive pointer declaration");
	}

	if(type -> base -> class == OBERON_TYPE_POINTER)
	{
		oberon_error(ctx, "attempt to make pointer to pointer");
	}

	type -> recursive = 1;

	oberon_prevent_recursive_pointer(ctx, type -> base);

	type -> recursive = 0;
}

static void
oberon_prevent_recursive_record(oberon_context_t * ctx, oberon_type_t * type)
{
	if(type -> class != OBERON_TYPE_RECORD)
	{
		return;
	}

	if(type -> recursive)
	{
		oberon_error(ctx, "recursive record declaration");
	}

	type -> recursive = 1;

	int num_fields = type -> num_decl;
	oberon_object_t * field = type -> decl;
	for(int i = 0; i < num_fields; i++)
	{
		oberon_prevent_recursive_object(ctx, field);
		field = field -> next;
	}

	type -> recursive = 0;	
}
static void
oberon_prevent_recursive_procedure(oberon_context_t * ctx, oberon_type_t * type)
{
	if(type -> class != OBERON_TYPE_PROCEDURE)
	{
		return;
	}

	if(type -> recursive)
	{
		oberon_error(ctx, "recursive procedure declaration");
	}

	type -> recursive = 1;

	int num_fields = type -> num_decl;
	oberon_object_t * field = type -> decl;
	for(int i = 0; i < num_fields; i++)
	{
		oberon_prevent_recursive_object(ctx, field);
		field = field -> next;
	}

	type -> recursive = 0;	
}

static void
oberon_prevent_recursive_array(oberon_context_t * ctx, oberon_type_t * type)
{
	if(type -> class != OBERON_TYPE_ARRAY)
	{
		return;
	}

	if(type -> recursive)
	{
		oberon_error(ctx, "recursive array declaration");
	}

	type -> recursive = 1;

	oberon_prevent_recursive_type(ctx, type -> base);

	type -> recursive = 0;
}

static void
oberon_prevent_recursive_type(oberon_context_t * ctx, oberon_type_t * type)
{
	if(type -> class == OBERON_TYPE_POINTER)
	{
		oberon_prevent_recursive_pointer(ctx, type);
	}
	else if(type -> class == OBERON_TYPE_RECORD)
	{
		oberon_prevent_recursive_record(ctx, type);
	}
	else if(type -> class == OBERON_TYPE_ARRAY)
	{
		oberon_prevent_recursive_array(ctx, type);
	}
	else if(type -> class == OBERON_TYPE_PROCEDURE)
	{
		oberon_prevent_recursive_procedure(ctx, type);
	}
}

static void
oberon_prevent_recursive_object(oberon_context_t * ctx, oberon_object_t * x)
{
	switch(x -> class)
	{
		case OBERON_CLASS_VAR:
		case OBERON_CLASS_TYPE:
		case OBERON_CLASS_PARAM:
		case OBERON_CLASS_VAR_PARAM:
		case OBERON_CLASS_FIELD:
			oberon_prevent_recursive_type(ctx, x -> type);
			break;
		case OBERON_CLASS_CONST:
		case OBERON_CLASS_PROC:
			break;
		default:
			oberon_error(ctx, "oberon_prevent_recursive_object: wat");
			break;
	}
}

static void
oberon_prevent_recursive_decl(oberon_context_t * ctx)
{
	oberon_object_t * x = ctx -> decl -> list -> next;

	while(x)
	{
		oberon_prevent_recursive_object(ctx, x);
		x = x -> next;
	}
}

static void oberon_initialize_object(oberon_context_t * ctx, oberon_object_t * x);
static void oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type);

static void
oberon_initialize_record_fields(oberon_context_t * ctx, oberon_type_t * type)
{
	if(type -> class != OBERON_TYPE_RECORD)
	{
		return;
	}

	int num_fields = type -> num_decl;
	oberon_object_t * field = type -> decl;
	for(int i = 0; i < num_fields; i++)
	{
		if(field -> type -> class == OBERON_TYPE_POINTER)
		{
			oberon_initialize_type(ctx, field -> type);
		}

		oberon_initialize_object(ctx, field);
		field = field -> next;
	}

	oberon_generator_init_record(ctx, type);
}

static void
oberon_initialize_type(oberon_context_t * ctx, oberon_type_t * type)
{
	if(type -> class == OBERON_TYPE_VOID)
	{
		oberon_error(ctx, "undeclarated type");
	}

	if(type -> initialized)
	{
		return;
	}

	type -> initialized = 1;

	if(type -> class == OBERON_TYPE_POINTER)
	{
		oberon_initialize_type(ctx, type -> base);
		oberon_generator_init_type(ctx, type);
	}
	else if(type -> class == OBERON_TYPE_ARRAY)
	{
		oberon_initialize_type(ctx, type -> base);		
		oberon_generator_init_type(ctx, type);
	}
	else if(type -> class == OBERON_TYPE_RECORD)
	{
		oberon_generator_init_type(ctx, type);
		oberon_initialize_record_fields(ctx, type);
	}
	else if(type -> class == OBERON_TYPE_PROCEDURE)
	{
		int num_fields = type -> num_decl;
		oberon_object_t * field = type -> decl;
		for(int i = 0; i < num_fields; i++)
		{
			oberon_initialize_object(ctx, field);
			field = field -> next;
		}		

		oberon_generator_init_type(ctx, type);
	}
	else
	{
		oberon_generator_init_type(ctx, type);
	}
}

static void
oberon_initialize_object(oberon_context_t * ctx, oberon_object_t * x)
{
	if(x -> initialized)
	{
		return;
	}

	x -> initialized = 1;

	switch(x -> class)
	{
		case OBERON_CLASS_TYPE:
			oberon_initialize_type(ctx, x -> type);
			break;
		case OBERON_CLASS_VAR:
		case OBERON_CLASS_PARAM:
		case OBERON_CLASS_VAR_PARAM:
		case OBERON_CLASS_FIELD:
			oberon_initialize_type(ctx, x -> type);
			oberon_generator_init_var(ctx, x);
			break;
		case OBERON_CLASS_CONST:
		case OBERON_CLASS_PROC:
			break;
		default:
			oberon_error(ctx, "oberon_prevent_recursive_object: wat");
			break;
	}
}

static void
oberon_initialize_decl(oberon_context_t * ctx)
{
	oberon_object_t * x = ctx -> decl -> list;

	while(x -> next)
	{
		oberon_initialize_object(ctx, x -> next);
		x = x -> next;
	}	
}

static void
oberon_prevent_undeclarated_procedures(oberon_context_t * ctx)
{
	oberon_object_t * x = ctx -> decl -> list;

	while(x -> next)
	{
		if(x -> next -> class == OBERON_CLASS_PROC)
		{
			if(x -> next -> linked == 0)
			{
				oberon_error(ctx, "unresolved forward declaration");
			}
		}
		x = x -> next;
	}	
}

static void
oberon_decl_seq(oberon_context_t * ctx)
{
	if(ctx -> token == CONST)
	{
		oberon_assert_token(ctx, CONST);
		while(ctx -> token == IDENT)
		{
			oberon_const_decl(ctx);
			oberon_assert_token(ctx, SEMICOLON);
		}
	}

	if(ctx -> token == TYPE)
	{
		oberon_assert_token(ctx, TYPE);
		while(ctx -> token == IDENT)
		{
			oberon_type_decl(ctx);
			oberon_assert_token(ctx, SEMICOLON);
		}
	}

	if(ctx -> token == VAR)
	{
		oberon_assert_token(ctx, VAR);
		while(ctx -> token == IDENT)
		{
			oberon_var_decl(ctx);
			oberon_assert_token(ctx, SEMICOLON);
		}
	}

	oberon_prevent_recursive_decl(ctx);
	oberon_initialize_decl(ctx);

	while(ctx -> token == PROCEDURE)
	{
		oberon_proc_decl(ctx);
		oberon_assert_token(ctx, SEMICOLON);
	}

	oberon_prevent_undeclarated_procedures(ctx);
}

static void
oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
{
	oberon_autocast_to(ctx, src, dst -> result);
	oberon_generate_assign(ctx, src, dst);
}

static void
oberon_statement(oberon_context_t * ctx)
{
	oberon_expr_t * item1;
	oberon_expr_t * item2;

	if(ctx -> token == IDENT)
	{
		item1 = oberon_designator(ctx);
		if(ctx -> token == ASSIGN)
		{
			oberon_assert_token(ctx, ASSIGN);
			item2 = oberon_expr(ctx);
			oberon_assign(ctx, item2, item1);
		}
		else
		{
			oberon_opt_proc_parens(ctx, item1);
		}
	}
	else if(ctx -> token == RETURN)
	{
		oberon_assert_token(ctx, RETURN);
		if(ISEXPR(ctx -> token))
		{
			oberon_expr_t * expr;
			expr = oberon_expr(ctx);
			oberon_make_return(ctx, expr);
		}
		else
		{
			oberon_make_return(ctx, NULL);
		}
	}
}

static void
oberon_statement_seq(oberon_context_t * ctx)
{
	oberon_statement(ctx);
	while(ctx -> token == SEMICOLON)
	{
		oberon_assert_token(ctx, SEMICOLON);
		oberon_statement(ctx);
	}
}

static void
oberon_parse_module(oberon_context_t * ctx)
{
	char *name1, *name2;
	oberon_read_token(ctx);

	oberon_assert_token(ctx, MODULE);
	name1 = oberon_assert_ident(ctx);
	oberon_assert_token(ctx, SEMICOLON);
	ctx -> mod -> name = name1;

	oberon_decl_seq(ctx);

	if(ctx -> token == BEGIN)
	{
		oberon_assert_token(ctx, BEGIN);
		oberon_generate_begin_module(ctx);
		oberon_statement_seq(ctx);
		oberon_generate_end_module(ctx);
	}

	oberon_assert_token(ctx, END);
	name2 = oberon_assert_ident(ctx);
	oberon_assert_token(ctx, DOT);

	if(strcmp(name1, name2) != 0)
	{
		oberon_error(ctx, "module name not matched");
	}
}

// =======================================================================
//   LIBRARY
// =======================================================================

static void
register_default_types(oberon_context_t * ctx)
{
	ctx -> void_type = oberon_new_type_ptr(OBERON_TYPE_VOID);
	oberon_generator_init_type(ctx, ctx -> void_type);

	ctx -> void_ptr_type = oberon_new_type_ptr(OBERON_TYPE_POINTER);
	ctx -> void_ptr_type -> base = ctx -> void_type;
	oberon_generator_init_type(ctx, ctx -> void_ptr_type);

	ctx -> int_type = oberon_new_type_integer(sizeof(int));
	oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type);

	ctx -> bool_type = oberon_new_type_boolean(sizeof(int));
	oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type);
}

static void
oberon_new_intrinsic_function(oberon_context_t * ctx, char * name, GenerateFuncCallback generate)
{
	oberon_object_t * proc;
	proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC);
	proc -> sysproc = 1;
	proc -> genfunc = generate;
	proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
}

/*
static void
oberon_new_intrinsic_procedure(oberon_context_t * ctx, char * name, GenerateProcCallback generate)
{
	oberon_object_t * proc;
	proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC);
	proc -> sysproc = 1;
	proc -> genproc = generate;
	proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
}
*/

static oberon_expr_t *
oberon_make_abs_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args)
{
	if(num_args < 1)
	{
		oberon_error(ctx, "too few arguments");
	}

	if(num_args > 1)
	{
		oberon_error(ctx, "too mach arguments");
	}

	oberon_expr_t * arg;
	arg = list_args;

	oberon_type_t * result_type;
	result_type = arg -> result;
	
	if(result_type -> class != OBERON_TYPE_INTEGER)
	{
		oberon_error(ctx, "ABS accepts only integers");
	}


	oberon_expr_t * expr;
	expr = oberon_new_operator(OP_ABS, result_type, arg, NULL);
	return expr;
}

oberon_context_t *
oberon_create_context()
{
	oberon_context_t * ctx = malloc(sizeof *ctx);
	memset(ctx, 0, sizeof *ctx);

	oberon_scope_t * world_scope;
	world_scope = oberon_open_scope(ctx);
	ctx -> world_scope = world_scope;

	oberon_generator_init_context(ctx);

	register_default_types(ctx);
	oberon_new_intrinsic_function(ctx, "ABS", oberon_make_abs_call);

	return ctx;
}

void
oberon_destroy_context(oberon_context_t * ctx)
{
	oberon_generator_destroy_context(ctx);
	free(ctx);
}

oberon_module_t *
oberon_compile_module(oberon_context_t * ctx, const char * code)
{
	oberon_module_t * mod = malloc(sizeof *mod);
	memset(mod, 0, sizeof *mod);
	ctx -> mod = mod;

	oberon_scope_t * module_scope;
	module_scope = oberon_open_scope(ctx);
	mod -> decl = module_scope;

	oberon_init_scaner(ctx, code);
	oberon_parse_module(ctx);

	oberon_generate_code(ctx);

	ctx -> mod = NULL;
	return mod;
}