#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,
};

// =======================================================================
//   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;

	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;

	x -> next = newvar;

	return newvar;
}

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)
{
	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(result == NULL)
	{
		oberon_error(scope -> ctx, "undefined ident %s", name);
	}

	return result;
}

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;
	oberon_generator_init_var(scope -> ctx, var);
	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;
	oberon_generator_init_proc(scope -> ctx, proc);
	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;
	}
}

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;
		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 oberon_type_t * oberon_type(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)
{
	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;
		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(expr -> result -> class != pref -> class)
	{
		oberon_error(ctx, "incompatible types");
	}

	if(pref -> class == OBERON_TYPE_INTEGER)
	{
		if(expr -> result -> class > pref -> class)
		{
			oberon_error(ctx, "incompatible size");
		}
	}

	// 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++)
	{
		oberon_autocast_to(ctx, arg, param -> type);
		arg = arg -> next;
		param = param -> next;
	}
}

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

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);

	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_new_item(MODE_CALL, var -> type);
			break;
		default:
			oberon_error(ctx, "invalid designator");
			break;
	}

	expr -> item.var = var;
	return expr;
}

static oberon_expr_t *
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);
		}

		expr -> result = expr -> item.var -> type -> base;
		expr -> item.mode = MODE_CALL;
		expr -> item.num_args = num_args;
		expr -> item.args = arguments;
		oberon_assert_token(ctx, RPAREN);

		oberon_autocast_call(ctx, expr);
	}

	return expr;
}

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_proc_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;
		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_statement_seq(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 oberon_type_t *
oberon_make_array_type(oberon_context_t * ctx, int dim, oberon_item_t * size, oberon_type_t * base)
{
	assert(dim == 1);
	oberon_type_t * newtype;

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

	newtype = oberon_new_type_ptr(OBERON_TYPE_ARRAY);
	newtype -> dim = dim;
	newtype -> size = size -> integer;
	newtype -> base = base;
	oberon_generator_init_type(ctx, newtype);

	return newtype;
}

static oberon_type_t *
oberon_type(oberon_context_t * ctx)
{
	oberon_type_t * type;

	if(ctx -> token == IDENT)
	{
		char * name = oberon_assert_ident(ctx);
		type = oberon_find_type(ctx -> decl, name);
	}
	else if(ctx -> token == ARRAY)
	{
		oberon_assert_token(ctx, ARRAY);
		oberon_item_t * size = oberon_const_expr(ctx);
		oberon_assert_token(ctx, OF);
		oberon_type_t * base = oberon_type(ctx);
		type = oberon_make_array_type(ctx, 1, size, base);
	}
	else
	{
		oberon_error(ctx, "invalid type declaration");
	}

	return type;
}

static void
oberon_var_decl(oberon_context_t * ctx)
{
	char * name = oberon_assert_ident(ctx);
	oberon_assert_token(ctx, COLON);
	oberon_type_t * type = oberon_type(ctx);
	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_type(ctx);

	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 oberon_type_t *
oberon_formal_pars(oberon_context_t * ctx)
{
	oberon_type_t * tp;
	tp = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
	tp -> num_decl = 0;
	tp -> base = ctx -> void_type;
	tp -> decl = NULL;

	oberon_assert_token(ctx, LPAREN);

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

	oberon_assert_token(ctx, RPAREN);

	if(ctx -> token == COLON)
	{
		oberon_assert_token(ctx, COLON);
		tp -> base = oberon_type(ctx);
	}

	oberon_generator_init_type(ctx, tp);
	return tp;
}

static void
oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
{
	if(ctx -> 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, ctx -> result_type);
	}

	ctx -> has_return = 1;

	oberon_generate_return(ctx, expr);
}

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

	char * name;
	name = oberon_assert_ident(ctx);

	oberon_scope_t * this_proc_def_scope = ctx -> decl;
	oberon_open_scope(ctx);

	oberon_type_t * signature;
	if(ctx -> token == LPAREN)
	{
		signature = oberon_formal_pars(ctx);
	}
	else
	{
		signature = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
		signature -> num_decl = 0;
		signature -> base = ctx -> void_type;
		signature -> decl = NULL;
		oberon_generator_init_type(ctx, signature);
	}

	oberon_object_t * proc;
	proc = oberon_define_proc(this_proc_def_scope, name, signature);

	ctx -> result_type = signature -> base;
	ctx -> has_return = 0;

	oberon_assert_token(ctx, SEMICOLON);

	oberon_generate_begin_proc(ctx, proc);

	// TODO declarations

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

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

	if(signature -> base -> class == OBERON_TYPE_VOID)
	{
		oberon_make_return(ctx, NULL);
	}

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

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

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_type_decl(oberon_context_t * ctx)
{
	char * name;
	oberon_object_t * newtype;
	oberon_type_t * type;

	name = oberon_assert_ident(ctx);
	oberon_assert_token(ctx, EQUAL);
	type = oberon_type(ctx);

	newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE);
	newtype -> type = type;
}

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);
		}
	}

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

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_make_call(oberon_context_t * ctx, oberon_expr_t * desig)
{
	oberon_autocast_call(ctx, desig);
	oberon_generate_call_proc(ctx, desig);
}

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
		{
			item1 = oberon_opt_proc_parens(ctx, item1);
			oberon_make_call(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 -> 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);
}

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);	

	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;
}