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

#include <gc.h>

#include "oberon-internals.h"
#include "oberon-type-compat.h"
#include "oberon-common.h"
#include "generator.h"

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

static void
oberon_make_copy_call(oberon_context_t * ctx, int num_args, oberon_expr_t * list_args);

static oberon_type_t *
oberon_new_type_ptr(int class)
{
	oberon_type_t * x = GC_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()
{
	oberon_type_t * x;
	x = oberon_new_type_ptr(OBERON_TYPE_BOOLEAN);
	return x;
}

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

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

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

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

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 = GC_MALLOC(sizeof *operator);
	memset(operator, 0, sizeof *operator);

	operator -> is_item = 0;
	operator -> result = result;
	operator -> read_only = 1;
	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, int read_only)
{
	oberon_item_t * item;
        item = GC_MALLOC(sizeof *item);
        memset(item, 0, sizeof *item);

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

	return (oberon_expr_t *)item;
}

static oberon_type_t *
oberon_get_type_of_int_value(oberon_context_t * ctx, int64_t i)
{
	if(i >= -128 && i <= 127)
	{
		return ctx -> byte_type;
	}
	else if(i >= -32768 && i <= 32767)
	{
		return ctx -> shortint_type;
	}
	else if(i >= -2147483648 && i <= 2147483647)
	{
		 return ctx -> int_type;
	}
	else
	{
		return ctx -> longint_type;
	}
}

static oberon_expr_t *
oberon_make_integer(oberon_context_t * ctx, int64_t i)
{
	oberon_expr_t * expr;
	oberon_type_t * result;
	result = oberon_get_type_of_int_value(ctx, i);
	expr = oberon_new_item(MODE_INTEGER, result, true);
	expr -> item.integer = i;
	expr -> item.real = i;
	return expr;
}

static oberon_expr_t *
oberon_make_system_byte(oberon_context_t * ctx, int64_t i)
{
	oberon_expr_t * expr;
	expr = oberon_new_item(MODE_SYSBYTE, ctx -> system_byte_type, true);
	expr -> item.integer = i;
	expr -> item.real = i;
	return expr;
}

static oberon_expr_t *
oberon_make_char(oberon_context_t * ctx, int64_t i)
{
	oberon_expr_t * expr;
	expr = oberon_new_item(MODE_CHAR, ctx -> char_type, true);
	expr -> item.integer = i;
	expr -> item.real = i;
	return expr;
}

static oberon_expr_t *
oberon_make_string(oberon_context_t * ctx, char * str)
{
	oberon_expr_t * expr;
	expr = oberon_new_item(MODE_STRING, ctx -> string_type, true);
	expr -> item.integer = str[0];
	expr -> item.real = str[0];
	expr -> item.string = str;
	return expr;
}

static oberon_expr_t *
oberon_make_real_typed(oberon_context_t * ctx, double r, oberon_type_t * result)
{
	oberon_expr_t * expr;
	expr = oberon_new_item(MODE_REAL, result, true);
	expr -> item.integer = r;
	expr -> item.real = r;
	return expr;
}

static oberon_expr_t *
oberon_make_real(oberon_context_t * ctx, double r, bool longmode)
{
	oberon_type_t * result;
	result = (longmode) ? (ctx -> longreal_type) : (ctx -> real_type);
	return oberon_make_real_typed(ctx, r, result);
}

static oberon_expr_t *
oberon_make_boolean(oberon_context_t * ctx, bool cond)
{
	oberon_expr_t * expr;
	expr = oberon_new_item(MODE_BOOLEAN, ctx -> bool_type, true);
	expr -> item.integer = cond;
	expr -> item.real = cond;
	return expr;
}

static oberon_expr_t *
oberon_make_set(oberon_context_t * ctx, int64_t i)
{
	oberon_expr_t * expr;
	expr = oberon_new_item(MODE_SET, ctx -> set_type, true);
	expr -> item.integer = i;
	expr -> item.real = i;
	return expr;
}

static oberon_expr_t *
oberon_make_set_index(oberon_context_t * ctx, int64_t i)
{
	oberon_expr_t * expr;
	expr = oberon_new_item(MODE_SET, ctx -> set_type, true);
	expr -> item.integer = 1 << i;
	expr -> item.real = 1 << i;
	return expr;
}

static oberon_expr_t *
oberon_make_set_range(oberon_context_t * ctx, int64_t x, int64_t y)
{
	oberon_expr_t * expr;
	expr = oberon_new_item(MODE_SET, ctx -> set_type, true);
	expr -> item.integer = (x <= y) ? ((2 << y) - (1 << x)) : (0);
	expr -> item.real = expr -> item.integer;
	return expr;
}

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

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

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

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

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

	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_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, bool 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_object_in_scope(oberon_scope_t * scope, char * name, bool check_it)
{
	oberon_object_t * result = NULL;

	result = oberon_find_object_in_list(scope -> list, name);

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

	return result;
}

static oberon_object_t *
oberon_create_object(oberon_scope_t * scope, char * name, int class, bool export, bool read_only)
{
	oberon_object_t * newvar = GC_MALLOC(sizeof *newvar);
	memset(newvar, 0, sizeof *newvar);
	newvar -> name = name;
	newvar -> class = class;
	newvar -> export = export;
	newvar -> read_only = read_only;
	newvar -> local = scope -> local;
	newvar -> parent = scope -> parent;
	newvar -> parent_type = scope -> parent_type;
	newvar -> module = scope -> ctx -> mod;
	return newvar;
}

static oberon_object_t *
oberon_define_object(oberon_scope_t * scope, char * name, int class, bool export, bool read_only, bool check_upscope)
{
	if(check_upscope)
	{
		if(oberon_find_object(scope -> up, name, false))
		{
			oberon_error(scope -> ctx, "already defined");
		}
	}

	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;
	newvar = oberon_create_object(scope, name, class, export, read_only);
	x -> next = newvar;

	return newvar;
}

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

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

static void
oberon_init_scaner(oberon_context_t * ctx, oberon_scanner_t * s)
{
	ctx -> code = s -> code;
	ctx -> code_index = 0;
	ctx -> xloc.source = s -> source;
	ctx -> xloc.line = 1;
	ctx -> xloc.col = 1;
	ctx -> loc = ctx -> xloc;
	ctx -> c = ctx -> code[ctx -> code_index];
	oberon_set_line(ctx, 1);
}

static void
oberon_read_ident(oberon_context_t * ctx)
{
	int start = ctx -> code_index;

	oberon_get_char(ctx);
	while(isalnum(ctx -> c) || ctx -> c == '_')
	{
		oberon_get_char(ctx);
	}

	int end = ctx -> code_index;

	char * ident = GC_MALLOC(end - start + 1);
	memcpy(ident, &ctx -> code[start], end - start);
	ident[end - start] = 0;

	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, "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;
	}
	else if(strcmp(ident, "IMPORT") == 0)
	{
		ctx -> token = IMPORT;
	}
	else if(strcmp(ident, "IN") == 0)
	{
		ctx -> token = IN;
	}
	else if(strcmp(ident, "IS") == 0)
	{
		ctx -> token = IS;
	}
	else if(strcmp(ident, "IF") == 0)
	{
		ctx -> token = IF;
	}
	else if(strcmp(ident, "THEN") == 0)
	{
		ctx -> token = THEN;
	}
	else if(strcmp(ident, "ELSE") == 0)
	{
		ctx -> token = ELSE;
	}
	else if(strcmp(ident, "ELSIF") == 0)
	{
		ctx -> token = ELSIF;
	}
	else if(strcmp(ident, "WHILE") == 0)
	{
		ctx -> token = WHILE;
	}
	else if(strcmp(ident, "DO") == 0)
	{
		ctx -> token = DO;
	}
	else if(strcmp(ident, "REPEAT") == 0)
	{
		ctx -> token = REPEAT;
	}
	else if(strcmp(ident, "UNTIL") == 0)
	{
		ctx -> token = UNTIL;
	}
	else if(strcmp(ident, "FOR") == 0)
	{
		ctx -> token = FOR;
	}
	else if(strcmp(ident, "BY") == 0)
	{
		ctx -> token = BY;
	}
	else if(strcmp(ident, "LOOP") == 0)
	{
		ctx -> token = LOOP;
	}
	else if(strcmp(ident, "EXIT") == 0)
	{
		ctx -> token = EXIT;
	}
	else if(strcmp(ident, "CASE") == 0)
	{
		ctx -> token = CASE;
	}
	else if(strcmp(ident, "WITH") == 0)
	{
		ctx -> token = WITH;
	}
}

#define ISHEXDIGIT(x) \
	(((x) >= '0' && (x) <= '9') || ((x) >= 'A' && (x) <= 'F'))

static void
oberon_read_number(oberon_context_t * ctx)
{
	long integer;
	double real;
	char * ident;
	int start_i;
	int exp_i;
	int end_i;

	/*
	 * mode = 0 == DEC
	 * mode = 1 == HEX
	 * mode = 2 == REAL
	 * mode = 3 == LONGREAL
	 * mode = 4 == CHAR
	 */
	int mode = 0;
	start_i = ctx -> code_index;

	while(isdigit(ctx -> c))
	{
		oberon_get_char(ctx);
	}

	end_i = ctx -> code_index;

	if(ISHEXDIGIT(ctx -> c))
	{
		mode = 1;
		while(ISHEXDIGIT(ctx -> c))
		{
			oberon_get_char(ctx);
		}

		end_i = ctx -> code_index;

		if(ctx -> c == 'H')
		{
			mode = 1;
			oberon_get_char(ctx);
		}
		else if(ctx -> c == 'X')
		{
			mode = 4;
			oberon_get_char(ctx);
		}
		else
		{
			oberon_error(ctx, "invalid hex number");
		}
	}
	else if(ctx -> c == '.')
	{
		oberon_get_char(ctx);
		if(ctx -> c == '.')
		{
			/* Чит: избегаем конфликта с DOTDOT */
			ctx -> code_index -= 1;
		}
		else
		{
			mode = 2;

			while(isdigit(ctx -> c))
			{
				oberon_get_char(ctx);
			}

			if(ctx -> c == 'E' || ctx -> c == 'D')
			{
				exp_i = ctx -> code_index;

				if(ctx -> c == 'D')
				{
					mode = 3;
				}

				oberon_get_char(ctx);

				if(ctx -> c == '+' || ctx -> c == '-')
				{
					oberon_get_char(ctx);
				}

				while(isdigit(ctx -> c))
				{
					oberon_get_char(ctx);
				}	
			}
		}
		end_i = ctx -> code_index;
	}

	if(mode == 0)
	{
		if(ctx -> c == 'H')
		{
			mode = 1;
			oberon_get_char(ctx);
		}
		else if(ctx -> c == 'X')
		{
			mode = 4;
			oberon_get_char(ctx);
		}
	}

	int len = end_i - start_i;
	ident = GC_MALLOC(len + 1);
	memcpy(ident, &ctx -> code[start_i], len);
	ident[len] = 0;

	ctx -> longmode = false;
	if(mode == 3)
	{
		int i = exp_i - start_i;
		ident[i] = 'E';
		ctx -> longmode = true;
	}

	switch(mode)
	{
		case 0:
			integer = atol(ident);
			real = integer;
			ctx -> token = INTEGER;
			break;
		case 1:
			sscanf(ident, "%lx", &integer);
			real = integer;
			ctx -> token = INTEGER;
			break;
		case 2:
		case 3:
			sscanf(ident, "%lf", &real);
			integer = real;
			ctx -> token = REAL;
			break;
		case 4:
			sscanf(ident, "%lx", &integer);
			real = integer;
			ctx -> token = CHAR;
			break;
		default:
			oberon_error(ctx, "oberon_read_number: wat");
			break;
	}

	ctx -> string = ident;
	ctx -> integer = integer;
	ctx -> real = real;
}

static void
oberon_get_lined_char(oberon_context_t * ctx)
{
	do
	{
		if(ctx -> c == 0xD)
		{
			oberon_get_char(ctx);
			if(ctx -> c == 0xA)
			{
				oberon_get_char(ctx);
			}
			ctx -> xloc.line += 1;
			ctx -> xloc.col = 1;
			oberon_set_line(ctx, ctx -> xloc.line);
		}
		else if(ctx -> c == 0xA)
		{
			oberon_get_char(ctx);
			ctx -> xloc.line += 1;
			ctx -> xloc.col = 1;
			oberon_set_line(ctx, ctx -> xloc.line);
		}
		else
		{
			oberon_get_char(ctx);
		}
	} while(ctx -> c == 0xD || ctx -> c == 0xA);
}

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

static void
oberon_read_comment(oberon_context_t * ctx)
{
	int nesting = 1;
	while(nesting >= 1)
	{
		if(ctx -> c == '(')
		{
			oberon_get_lined_char(ctx);
			if(ctx -> c == '*')
			{
				oberon_get_lined_char(ctx);
				nesting += 1;
			}
		}
		else if(ctx -> c == '*')
		{
			oberon_get_lined_char(ctx);
			if(ctx -> c == ')')
			{
				oberon_get_lined_char(ctx);
				nesting -= 1;
			}
		}
		else if(ctx -> c == 0)
		{
			oberon_error(ctx, "unterminated comment");
		}
		else
		{
			oberon_get_lined_char(ctx);
		}
	}
}

static void oberon_read_string(oberon_context_t * ctx)
{
	int c = ctx -> c;
	oberon_get_char(ctx);

	int start = ctx -> code_index;

	while(ctx -> c != 0 && ctx -> c != c)
	{
		oberon_get_char(ctx);
	}

	if(ctx -> c == 0)
	{
		oberon_error(ctx, "unterminated string");
	}

	int end = ctx -> code_index;

	oberon_get_char(ctx);

	char * string = GC_MALLOC(end - start + 1);
	strncpy(string, &ctx -> code[start], end - start);
	string[end - start] = 0;

	ctx -> token = STRING;
	ctx -> string = string;
	ctx -> integer = string[0];
}

static void oberon_read_token(oberon_context_t * 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);
			if(ctx -> c == '.')
			{
				ctx -> token = DOTDOT;
				oberon_get_char(ctx);
			}
			break;
		case '(':
			ctx -> token = LPAREN;
			oberon_get_char(ctx);
			if(ctx -> c == '*')
			{
				oberon_get_char(ctx);
				oberon_read_comment(ctx);
				oberon_read_token(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);
			if(ctx -> c == ')')
			{
				oberon_get_char(ctx);
				oberon_error(ctx, "unstarted comment");
			}
			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 = LBRACK;
			oberon_get_char(ctx);
			break;
		case ']':
			ctx -> token = RBRACK;
			oberon_get_char(ctx);
			break;
		case '^':
			ctx -> token = UPARROW;
			oberon_get_char(ctx);
			break;
		case '"':
			oberon_read_string(ctx);
			break;
		case '\'':
			oberon_read_string(ctx);
			break;			
		case '{':
			ctx -> token = LBRACE;
			oberon_get_char(ctx);
			break;
		case '}':
			ctx -> token = RBRACE;
			oberon_get_char(ctx);
			break;
		case '|':
			ctx -> token = BAR;
			oberon_get_char(ctx);
			break;
		default:
			oberon_error(ctx, "invalid char %c", ctx -> c);
			break;
	}
}

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

	ctx -> loc = ctx -> xloc;

	int c = ctx -> c;
	if(isalpha(c) || c == '_')
	{
		oberon_read_ident(ctx);
	}
	else if(isdigit(c))
	{
		oberon_read_number(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 * oberno_make_dereferencing(oberon_context_t * ctx, oberon_expr_t * expr);
static bool oberon_is_const(oberon_expr_t * expr);

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_SET)
		{
			if(oberon_is_const(a))
			{
				expr = oberon_make_set(ctx, ~(a -> item.integer));
			}
			else
			{
				expr = oberon_new_operator(OP_COMPLEMENTATION, result, a, NULL);
			}
		}
		else if(result -> class == OBERON_TYPE_INTEGER)
		{
			if(oberon_is_const(a))
			{
				expr = oberon_make_integer(ctx, -(a -> item.integer));
			}
			else
			{
				expr = oberon_new_operator(OP_UNARY_MINUS, result, a, NULL);
			}
		}
		else if(result -> class == OBERON_TYPE_REAL)
		{
			if(oberon_is_const(a))
			{
				expr = oberon_make_real_typed(ctx, -(a -> item.real), result);
			}
			else
			{
				expr = oberon_new_operator(OP_UNARY_MINUS, result, a, NULL);
			}
		}
		else
		{
			oberon_error(ctx, "incompatible operator type");
		}
	}
	else if(token == NOT)
	{
		if(result -> class != OBERON_TYPE_BOOLEAN)
		{
			oberon_error(ctx, "incompatible operator type");
		}

			if(oberon_is_const(a))
			{
				expr = oberon_make_boolean(ctx, !(a -> item.integer));
			}
			else
			{
				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;
	if(const_expr)
	{
		*first = last = (oberon_expr_t *) oberon_const_expr(ctx);
	}
	else
	{
		*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_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
{
	oberon_expr_t * cast;

	if((oberon_is_char_type(pref) && oberon_is_const_string(expr) && strlen(expr -> item.string) == 1))
	{
		/* Автоматически преобразуем строку единичного размера в символ */
		cast = oberon_new_item(MODE_CHAR, ctx -> char_type, true);
		cast -> item.integer = expr -> item.string[0];
	}
	else if(oberon_is_record_type(pref) || oberon_is_pointer_to_record(pref))
	{
		assert(expr -> is_item);
		cast = oberon_new_item(MODE_AS, pref, expr -> read_only);
		cast -> item.parent = (oberon_item_t *) expr;
	}
	else if(!oberon_is_some_types(expr -> result, pref))
	{
		cast = oberon_new_operator(OP_CAST, pref, expr, NULL);
	}
	else
	{
		cast = expr;
	}

	return cast;
}

static oberon_expr_t *
oberon_hard_cast_expr(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
{
	return oberon_new_operator(OP_HARDCAST, pref, expr, NULL);
}

static void
oberon_check_dst(oberon_context_t * ctx, oberon_expr_t * dst)
{
	if(dst -> read_only)
	{
		oberon_error(ctx, "read-only destination");
	}

	if(dst -> is_item == false)
	{
		oberon_error(ctx, "not variable");
	}

	switch(dst -> item.mode)
	{
		case MODE_VAR:
		case MODE_CALL:
		case MODE_INDEX:
		case MODE_FIELD:
		case MODE_DEREF:
		case MODE_NEW:
			/* accept */
			break;
		default:
			oberon_error(ctx, "not variable");
			break;
	}
}

static void
oberon_check_src(oberon_context_t * ctx, oberon_expr_t * src)
{
	if(src -> is_item)
	{
		if(src -> item.mode == MODE_TYPE)
		{
			oberon_error(ctx, "not variable");
		}
	}
}

static void
oberon_autocast_call(oberon_context_t * ctx, oberon_item_t * desig)
{
	if(desig -> mode != MODE_CALL)
	{
		oberon_error(ctx, "expected mode CALL");
	}

	oberon_type_t * fn = desig -> parent -> result;
	int num_args = desig -> 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 * casted[num_args];
	oberon_expr_t * arg = desig -> args;
	oberon_object_t * param = fn -> decl;
	for(int i = 0; i < num_args; i++)
	{
		if(param -> class == OBERON_CLASS_VAR_PARAM)
		{
			oberon_check_dst(ctx, arg);
			if(!oberon_is_compatible_arrays(param, arg))
			{
				oberon_check_compatible_var_param(ctx, param -> type, arg -> result);
			}
			casted[i] = arg;
			//casted[i] = oberon_cast_expr(ctx, arg, param -> type);
		}
		else
		{
			oberon_check_src(ctx, arg);
			if(!oberon_is_compatible_arrays(param, arg))
			{
				oberon_check_assignment_compatible(ctx, arg, param -> type);
			}
			casted[i] = oberon_cast_expr(ctx, arg, param -> type);
		}

		arg = arg -> next;
		param = param -> next;
	}

	/* Создаём новый список выражений */
	if(num_args > 0)
	{
		arg = casted[0];
		for(int i = 0; i < num_args - 1; i++)
		{
			casted[i] -> next = casted[i + 1];
		}
		desig -> args = arg;
	}
}

static oberon_expr_t *
oberon_make_call_func(oberon_context_t * ctx, oberon_item_t * item, int num_args, oberon_expr_t * list_args)
{
	oberon_type_t * signature = item -> result;
	if(signature -> class != OBERON_TYPE_PROCEDURE)
	{
		oberon_error(ctx, "not a procedure");
	}

	oberon_expr_t * call;

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

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

		call = oberon_new_item(MODE_CALL, signature -> base, true);
		call -> item.parent = item;
		call -> item.num_args = num_args;
		call -> item.args = list_args;
		oberon_autocast_call(ctx, (oberon_item_t *) call);
	}

	return call;
}

static void
oberon_make_call_proc(oberon_context_t * ctx, oberon_item_t * item, int num_args, oberon_expr_t * list_args)
{
	oberon_type_t * signature = item -> result;
	if(signature -> class != OBERON_TYPE_PROCEDURE)
	{
		oberon_error(ctx, "not a procedure");
	}

	oberon_expr_t * call;

	if(signature -> sysproc)
	{
		if(signature -> genproc == NULL)
		{
			oberon_error(ctx, "not a procedure");
		}

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

		call = oberon_new_item(MODE_CALL, signature -> base, true);
		call -> item.parent = item;
		call -> item.num_args = num_args;
		call -> item.args = list_args;
		oberon_autocast_call(ctx, (oberon_item_t *) call);
		oberon_generate_call_proc(ctx, call);
	}
}

#define ISEXPR(x) \
	(((x) == PLUS) \
	|| ((x) == MINUS) \
	|| ((x) == IDENT) \
	|| ((x) == INTEGER) \
	|| ((x) == REAL) \
	|| ((x) == CHAR) \
	|| ((x) == STRING) \
	|| ((x) == NIL) \
	|| ((x) == LBRACE) \
	|| ((x) == LPAREN) \
	|| ((x) == NOT))

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, false);
	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(desig -> result -> size != 0)
	{
		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, desig -> read_only);
	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);

	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_object(rec -> scope, name, true);

	if(field -> export == 0)
	{
		if(field -> module != ctx -> mod)
		{
			oberon_error(ctx, "field not exported");
		}
	}

	int read_only = expr -> read_only;
	if(field -> read_only)
	{
		if(field -> module != ctx -> mod)
		{
			read_only = 1;
		}
	}

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

	return selector;
}

#define ISSELECTOR(x) \
	(((x) == LBRACK) \
	|| ((x) == DOT) \
	|| ((x) == UPARROW) \
	|| ((x) == LPAREN))

static oberon_object_t *
oberon_qualident(oberon_context_t * ctx, char ** xname, int check)
{
	char * name;
	oberon_object_t * x;

	name = oberon_assert_ident(ctx);
	x = oberon_find_object(ctx -> decl, name, check);

	if(x != NULL)
	{
		if(x -> class == OBERON_CLASS_MODULE)
		{
			oberon_assert_token(ctx, DOT);
			name = oberon_assert_ident(ctx);
			/* Наличие объектов в левых модулях всегда проверяется */
			x = oberon_find_object(x -> module -> decl, name, 1);

			if(x -> export == 0)
			{
				oberon_error(ctx, "not exported");
			}
		}
	}

	if(xname)
	{
		*xname = name;
	}

	return x;
}

static oberon_expr_t *
oberon_ident_item(oberon_context_t * ctx, char * name)
{
	bool read_only;
	oberon_object_t * x;
	oberon_expr_t * expr;

	x = oberon_find_object(ctx -> decl, name, true);

	read_only = false;
	if(x -> class == OBERON_CLASS_CONST || x -> class == OBERON_CLASS_PROC)
	{
		read_only = true;
	}

	expr = oberon_new_item(MODE_VAR, x -> type, read_only);
	expr -> item.var = x;
	return expr;
}

static oberon_expr_t *
oberon_qualident_expr(oberon_context_t * ctx)
{
	oberon_object_t * var;
	oberon_expr_t * expr;

	var = oberon_qualident(ctx, NULL, 1);

	int read_only = 0;
	if(var -> read_only)
	{
		if(var -> module != ctx -> mod)
		{
			read_only = 1;
		}
	}

	switch(var -> class)
	{
		case OBERON_CLASS_CONST:
			// TODO copy value
			expr = (oberon_expr_t *) var -> value;
			break;
		case OBERON_CLASS_TYPE:
			expr = oberon_new_item(MODE_TYPE, var -> type, read_only);
			break;
		case OBERON_CLASS_VAR:
		case OBERON_CLASS_VAR_PARAM:
		case OBERON_CLASS_PARAM:
			expr = oberon_new_item(MODE_VAR, var -> type, read_only);
			break;
		case OBERON_CLASS_PROC:
			expr = oberon_new_item(MODE_VAR, var -> type, true);
			break;
		default:
			oberon_error(ctx, "invalid designator");
			break;
	}

	expr -> item.var = var;

	return expr;
}

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

	expr = oberon_qualident_expr(ctx);

	while(expr -> result -> class != OBERON_TYPE_PROCEDURE && 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 LBRACK:
				oberon_assert_token(ctx, LBRACK);
				int num_indexes = 0;
				oberon_expr_t * indexes = NULL;
				oberon_expr_list(ctx, &num_indexes, &indexes, 0);
				oberon_assert_token(ctx, RBRACK);

				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;
			case LPAREN:
				oberon_assert_token(ctx, LPAREN);
				objtype = oberon_qualident(ctx, NULL, true);
				oberon_assert_token(ctx, RPAREN);
				oberon_check_extension_of(ctx, expr -> result, objtype -> type);
				expr = oberon_cast_expr(ctx, expr, objtype -> type);
				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)
{
	/* Если есть скобки - значит вызов. Если нет, то передаём указатель. */
	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);
		}

		assert(expr -> is_item == 1);
		expr = oberon_make_call_func(ctx, (oberon_item_t *) expr, 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);

	int num_args = 0;
	oberon_expr_t * arguments = NULL;

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

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

		oberon_assert_token(ctx, RPAREN);
	}

	/* Вызов происходит даже без скобок */
	oberon_make_call_proc(ctx, (oberon_item_t *) expr, num_args, arguments);
}

static oberon_expr_t *
oberon_element(oberon_context_t * ctx)
{
	oberon_expr_t * e1;
	oberon_expr_t * e2;

	e1 = oberon_expr(ctx);
	oberon_check_src(ctx, e1);
	if(e1 -> result -> class != OBERON_TYPE_INTEGER)
	{
		oberon_error(ctx, "expected integer");
	}

	e2 = NULL;
	if(ctx -> token == DOTDOT)
	{
		oberon_assert_token(ctx, DOTDOT);
		e2 = oberon_expr(ctx);
		oberon_check_src(ctx, e2);
		if(e2 -> result -> class != OBERON_TYPE_INTEGER)
		{
			oberon_error(ctx, "expected integer");
		}
	}

	oberon_expr_t * set;
	if(e2 == NULL && oberon_is_const(e1))
	{
		set = oberon_make_set_index(ctx, e1 -> item.integer);
	}
	else if(e2 != NULL && oberon_is_const(e1) && oberon_is_const(e2))
	{
		set = oberon_make_set_range(ctx, e1 -> item.integer, e2 -> item.integer);
	}
	else
	{
		set = oberon_new_operator(OP_RANGE, ctx -> set_type, e1, e2);
	}
	return set;
}

static oberon_expr_t *
oberon_make_set_union(oberon_context_t * ctx, oberon_expr_t * a, oberon_expr_t * b)
{
	if(oberon_is_const(a) && oberon_is_const(b))
	{
		return oberon_make_set(ctx, (a -> item.integer | b -> item.integer));
	}
	else
	{
		return oberon_new_operator(OP_UNION, ctx -> set_type, a, b);
	}	
}

static oberon_expr_t *
oberon_set(oberon_context_t * ctx)
{
	oberon_expr_t * set;
	oberon_expr_t * elements;
	set = oberon_make_set(ctx, 0);

	oberon_assert_token(ctx, LBRACE);
	if(ISEXPR(ctx -> token))
	{
		elements = oberon_element(ctx);
		set = oberon_make_set_union(ctx, set, elements);
		while(ctx -> token == COMMA)
		{
			oberon_assert_token(ctx, COMMA);
			elements = oberon_element(ctx);
			set = oberon_make_set_union(ctx, set, elements);
		}
	}
	oberon_assert_token(ctx, RBRACE);

	return set;
}

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

	switch(ctx -> token)
	{
		case IDENT:
			expr = oberon_designator(ctx);
			expr = oberon_opt_func_parens(ctx, expr);
			break;
		case INTEGER:
			expr = oberon_make_integer(ctx, ctx -> integer);
			oberon_assert_token(ctx, INTEGER);
			break;
		case CHAR:
			result = ctx -> char_type;
			expr = oberon_new_item(MODE_CHAR, result, true);
			expr -> item.integer = ctx -> integer;
			oberon_assert_token(ctx, CHAR);
			break;
		case STRING:
			expr = oberon_make_string(ctx, ctx -> string);
			oberon_assert_token(ctx, STRING);
			break;
		case REAL:
			expr = oberon_make_real(ctx, ctx -> real, ctx -> longmode);
			oberon_assert_token(ctx, REAL);
			break;
		case LBRACE:
			expr = oberon_set(ctx);
			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 -> nil_type, true);
			break;
		default:
			oberon_error(ctx, "invalid expression");
	}

	return expr;
}

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;

	oberon_check_compatible_bin_expr(ctx, token, a, b);
	oberon_check_src(ctx, a);
	if(token != IS)
	{
		oberon_check_src(ctx, b);
	}

	if(token == IN)
	{
		if(oberon_is_const(a) && oberon_is_const(b))
		{
			expr = oberon_make_boolean(ctx, (1 << a -> item.integer) & b -> item.integer);
		}
		else
		{
			expr = oberon_new_operator(OP_IN, ctx -> bool_type, a, b);
		}
	}
	else if(token == IS)
	{
		oberon_check_type_expr(ctx, b);
		expr = oberon_new_operator(OP_IS, ctx -> bool_type, a, b);
	}
	else if((token >= EQUAL && token <= GEQ) || token == OR || token == AND)
	{
		if(oberon_is_string_of_one(a) && oberon_is_char_type(b -> result))
		{
			result = b -> result;
		}
		else if(oberon_is_string_of_one(b) && oberon_is_char_type(a -> result))
		{
			result = a -> result;
		}
		else if(oberon_is_string_of_one(a) && oberon_is_string_of_one(b))
		{
			result = ctx -> char_type;
		}
		else
		{
			result = oberon_get_longer_type(ctx, a -> result, b -> result);
		}

		if(oberon_is_const(a) && oberon_is_const(b)
			&& (oberon_is_real_type(result) || oberon_is_integer_type(result)))
		{
			if(oberon_is_real_type(result))
			{
				double x = a -> item.real;
				double y = b -> item.real;
				switch(token)
				{
					case EQUAL: expr = oberon_make_boolean(ctx, x == y); break;
					case NEQ:   expr = oberon_make_boolean(ctx, x != y); break;
					case LESS:  expr = oberon_make_boolean(ctx, x < y); break;
					case LEQ:   expr = oberon_make_boolean(ctx, x <= y); break;
					case GREAT: expr = oberon_make_boolean(ctx, x > y); break;
					case GEQ:   expr = oberon_make_boolean(ctx, x >= y); break;
					case OR:    expr = oberon_make_boolean(ctx, x || y); break;
					case AND:   expr = oberon_make_boolean(ctx, x && y); break;
					default: assert(0); break;
				}
			}
			else if(oberon_is_integer_type(result))
			{
				int64_t x = a -> item.integer;
				int64_t y = b -> item.integer;
				switch(token)
				{
					case EQUAL: expr = oberon_make_boolean(ctx, x == y); break;
					case NEQ:   expr = oberon_make_boolean(ctx, x != y); break;
					case LESS:  expr = oberon_make_boolean(ctx, x < y); break;
					case LEQ:   expr = oberon_make_boolean(ctx, x <= y); break;
					case GREAT: expr = oberon_make_boolean(ctx, x > y); break;
					case GEQ:   expr = oberon_make_boolean(ctx, x >= y); break;
					case OR:    expr = oberon_make_boolean(ctx, x || y); break;
					case AND:   expr = oberon_make_boolean(ctx, x && y); break;
					default: assert(0); break;
				}
			}
			else
			{
				assert(0);
			}
		}
		else
		{
			a = oberon_cast_expr(ctx, a, result);
			b = oberon_cast_expr(ctx, b, result);
			result = ctx -> bool_type;
			switch(token)
			{
				case EQUAL: expr = oberon_new_operator(OP_EQ, result, a, b); break;
				case NEQ:   expr = oberon_new_operator(OP_NEQ, result, a, b); break;
				case LESS:  expr = oberon_new_operator(OP_LSS, result, a, b); break;
				case LEQ:   expr = oberon_new_operator(OP_LEQ, result, a, b); break;
				case GREAT: expr = oberon_new_operator(OP_GRT, result, a, b); break;
				case GEQ:   expr = oberon_new_operator(OP_GEQ, result, a, b); break;
				case OR:    expr = oberon_new_operator(OP_LOGIC_OR, result, a, b); break;
				case AND:   expr = oberon_new_operator(OP_LOGIC_AND, result, a, b); break;
				default: assert(0); break;
			}
		}
	}
	else if(token == SLASH)
	{
		if(oberon_is_set_type(a -> result) && oberon_is_set_type(b -> result))
		{
			if(oberon_is_const(a) && oberon_is_const(b))
			{
				int64_t x = a -> item.integer;
				int64_t y = b -> item.integer;
				expr = oberon_make_set(ctx, x ^ y);
			}
			else
			{
				result = oberon_get_longer_type(ctx, a -> result, b -> result);
				a = oberon_cast_expr(ctx, a, result);
				b = oberon_cast_expr(ctx, b, result);
				expr = oberon_new_operator(OP_SYM_DIFFERENCE, result, a, b);
			}
		}
		else
		{
			result = oberon_get_longer_real_type(ctx, a -> result, b -> result);
			if(oberon_is_const(a) && oberon_is_const(b))
			{
				double x = a -> item.real;
				double y = b -> item.real;
				expr = oberon_make_real_typed(ctx, x / y, result);
			}
			else
			{
				a = oberon_cast_expr(ctx, a, result);
				b = oberon_cast_expr(ctx, b, result);
				expr = oberon_new_operator(OP_DIV, result, a, b);
			}
		}
	}
	else
	{
		result = oberon_get_longer_type(ctx, a -> result, b -> result);

		if(oberon_is_const(a) && oberon_is_const(b))
		{
			if(oberon_is_set_type(result))
			{
				int64_t x = a -> item.integer;
				int64_t y = b -> item.integer;
				switch(token)
				{
					case PLUS:  expr = oberon_make_set(ctx, x | y); break;
					case MINUS: expr = oberon_make_set(ctx, x & ~y); break;
					case STAR:  expr = oberon_make_set(ctx, x & y); break;
					default: assert(0); break;
				}
			}
			if(oberon_is_real_type(result))
			{
				double x = a -> item.real;
				double y = b -> item.real;
				switch(token)
				{
					case PLUS:  expr = oberon_make_real_typed(ctx, x + y, result); break;
					case MINUS: expr = oberon_make_real_typed(ctx, x - y, result); break;
					case STAR:  expr = oberon_make_real_typed(ctx, x * y, result); break;
					default: assert(0); break;
				}
			}
			else if(oberon_is_integer_type(result))
			{
				int64_t x = a -> item.integer;
				int64_t y = b -> item.integer;
				switch(token)
				{
					case PLUS:  expr = oberon_make_integer(ctx, x + y); break;
					case MINUS: expr = oberon_make_integer(ctx, x - y); break;
					case STAR:  expr = oberon_make_integer(ctx, x * y); break;
					case DIV:   expr = oberon_make_integer(ctx, x / y); break;
					case MOD:   expr = oberon_make_integer(ctx, x % y); break;
					default: assert(0); break;
				}
			}
			else
			{
				assert(0);
			}
		}
		else
		{
			a = oberon_cast_expr(ctx, a, result);
			b = oberon_cast_expr(ctx, b, result);
			
			
			if(oberon_is_set_type(result))
			{
				switch(token)
				{
					case PLUS:
						expr = oberon_new_operator(OP_UNION, result, a, b);
						break;
					case MINUS:
						expr = oberon_new_operator(OP_DIFFERENCE, result, a, b);
						break;
					case STAR:
						expr = oberon_new_operator(OP_INTERSECTION, result, a, b);
						break;
					default:
						assert(0);
						break;
				}
			}
			else if(oberon_is_real_type(result))
			{
				switch(token)
				{
					case PLUS:
						expr = oberon_new_operator(OP_ADD, result, a, b);
						break;
					case MINUS:
						expr = oberon_new_operator(OP_SUB, result, a, b);
						break;
					case STAR:
						expr = oberon_new_operator(OP_MUL, result, a, b);
						break;
					default:
						printf("token %i line %i\n", token, ctx -> loc.line);
						assert(0);
						break;
				}
			}
			else if(oberon_is_integer_type(result))
			{
				switch(token)
				{
					case PLUS:
						expr = oberon_new_operator(OP_ADD, result, a, b);
						break;
					case MINUS:
						expr = oberon_new_operator(OP_SUB, result, a, b);
						break;
					case STAR:
						expr = oberon_new_operator(OP_MUL, result, a, b);
						break;
					case DIV:
						expr = oberon_new_operator(OP_DIV, result, a, b);
						break;
					case MOD:
						expr = oberon_new_operator(OP_MOD, result, a, b);
						break;
					default:
						printf("token %i line %i\n", token, ctx -> loc.line);
						assert(0);
						break;
				}
			}
			else
			{
				assert(0);
			}
		}
	}

	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) <= IS)

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 bool
oberon_is_const(oberon_expr_t * expr)
{
	if(expr -> is_item == false)
	{
		return false;
	}

	switch(expr -> item.mode)
	{
		case MODE_INTEGER:
		case MODE_BOOLEAN:
		case MODE_NIL:
		case MODE_REAL:
		case MODE_CHAR:
		case MODE_STRING:
		case MODE_SET:
		case MODE_TYPE:
		case MODE_SYSBYTE:
			return true;
			break;
		default:
			return false;
			break;
	}

	return false;
}

static void
oberon_check_const(oberon_context_t * ctx, oberon_expr_t * expr)
{
	if(!oberon_is_const(expr))
	{
		oberon_error(ctx, "const expression are required");
	}
}

static oberon_item_t *
oberon_const_expr(oberon_context_t * ctx)
{
	oberon_expr_t * expr;
	expr = oberon_expr(ctx);
	oberon_check_const(ctx, expr);
	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_def(oberon_context_t * ctx, int * export, int * read_only)
{
	switch(ctx -> token)
	{
		case STAR:
			oberon_assert_token(ctx, STAR);
			*export = 1;
			*read_only = 0;
			break;
		case MINUS:
			oberon_assert_token(ctx, MINUS);
			*export = 1;
			*read_only = 1;
			break;
		default:
			*export = 0;
			*read_only = 0;
			break;
	}
}

static oberon_object_t *
oberon_ident_def(oberon_context_t * ctx, int class, bool check_upscope)
{
	char * name;
	int export;
	int read_only;
	oberon_object_t * x;

	name = oberon_assert_ident(ctx);
	oberon_def(ctx, &export, &read_only);

	x = oberon_define_object(ctx -> decl, name, class, export, read_only, check_upscope);
	return x;
}

static void
oberon_ident_list(oberon_context_t * ctx, int class, bool check_upscope, int * num, oberon_object_t ** list)
{
	*num = 1;
	*list = oberon_ident_def(ctx, class, check_upscope);
	while(ctx -> token == COMMA)
	{
		oberon_assert_token(ctx, COMMA);
		oberon_ident_def(ctx, class, check_upscope);
		*num += 1;
	}
}

static void
oberon_var_decl(oberon_context_t * ctx)
{
	int num;
	oberon_object_t * list;
	oberon_type_t * type;
	type = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);

	oberon_ident_list(ctx, OBERON_CLASS_VAR, false, &num, &list);
	oberon_assert_token(ctx, COLON);
	oberon_type(ctx, &type);

	oberon_object_t * var = list;
	for(int i = 0; i < num; i++)
	{
		var -> type = type;
		var = var -> next;
	}
}

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

	int num;
	oberon_object_t * list;
	oberon_ident_list(ctx, class, false, &num, &list);

	oberon_assert_token(ctx, COLON);

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

	oberon_object_t * param = list;
	for(int i = 0; i < num; i++)
	{
		param -> type = type;
		param = param -> next;
	}

	*num_decl += num;
	return list;
}

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

		oberon_object_t * typeobj;
		typeobj = oberon_qualident(ctx, NULL, 1);
		if(typeobj -> class != OBERON_CLASS_TYPE)
		{
			oberon_error(ctx, "function result is not type");
		}
		if(typeobj -> type -> class == OBERON_TYPE_RECORD
			|| typeobj -> type -> class == OBERON_TYPE_ARRAY)
		{
			oberon_error(ctx, "records or arrays could not be result of function");
		}
		signature -> base = typeobj -> type;
	}
}

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 -> notype_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_NOTYPE)
	{
		if(expr != NULL)
		{
			oberon_error(ctx, "procedure has no result type");
		}
	}
	else
	{
		if(expr == NULL)
		{
			oberon_error(ctx, "procedure requires expression on result");
		}

		oberon_check_src(ctx, expr);
		oberon_check_assignment_compatible(ctx, expr, result_type);
		expr = oberon_cast_expr(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_NOTYPE)
	{
		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;
	int export;
	int read_only;

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

	name = oberon_assert_ident(ctx);
	oberon_def(ctx, &export, &read_only);

	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_NOTYPE);
	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_in_scope(ctx -> decl, name, 0);
	if(proc == NULL)
	{
		proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, export, read_only, false);
		proc -> type = signature;
		proc -> scope = proc_scope;
		oberon_generator_init_proc(ctx, proc);
	}
	else
	{
		if(proc -> class != OBERON_CLASS_PROC)
		{
			oberon_error(ctx, "mult definition");
		}

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

		if(proc -> export != export || proc -> read_only != read_only)
		{
			oberon_error(ctx, "export type not matched");
		}

		oberon_compare_signatures(ctx, proc -> type, signature);
	}

	proc_scope -> parent = proc;
	oberon_object_t * param = proc_scope -> list -> next;
	while(param)
	{
		param -> parent = proc;
		param = param -> next;
	}

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

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

	constant = oberon_ident_def(ctx, OBERON_CLASS_CONST, false);
	oberon_assert_token(ctx, EQUAL);
	value = oberon_const_expr(ctx);
	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_qualident_type(oberon_context_t * ctx, oberon_type_t ** type)
{
	char * name;
	oberon_object_t * to;

	to = oberon_qualident(ctx, &name, 0);

	//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, false, false, false);
		to -> type = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);
	}

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

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

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

static void
oberon_make_open_array(oberon_context_t * ctx, oberon_type_t * base, oberon_type_t * type)
{
	type -> class = OBERON_TYPE_ARRAY;
	type -> size = 0;
	type -> base = base;
}

static void
oberon_field_list(oberon_context_t * ctx, oberon_type_t * rec, oberon_scope_t * modscope)
{
	if(ctx -> token == IDENT)
	{
		int num;
		oberon_object_t * list;
		oberon_type_t * type;
		type = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);

		oberon_ident_list(ctx, OBERON_CLASS_FIELD, true, &num, &list);
		oberon_assert_token(ctx, COLON);

		oberon_scope_t * current = ctx -> decl;
		ctx -> decl = modscope;
		oberon_type(ctx, &type);
		ctx -> decl = current;

		oberon_object_t * field = list;
		for(int i = 0; i < num; i++)
		{
			field -> type = type;
			field = field -> next;
		}

		rec -> num_decl += num;
	}
}

static void
oberon_type_record_body(oberon_context_t * ctx, oberon_type_t * rec)
{
	oberon_scope_t * oldscope = ctx -> decl;
	ctx -> decl = oldscope;

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

		oberon_object_t * typeobj;
		typeobj = oberon_qualident(ctx, NULL, true);

		if(typeobj -> class != OBERON_CLASS_TYPE)
		{
			oberon_error(ctx, "base must be type");
		}

		oberon_type_t * base = typeobj -> type;
		if(base -> class == OBERON_TYPE_POINTER)
		{
			base = base -> base;
		}

		if(base -> class != OBERON_TYPE_RECORD)
		{
			oberon_error(ctx, "base must be record type");
		}

		rec -> base = base;
		ctx -> decl = base -> scope;

		oberon_assert_token(ctx, RPAREN);
	}
	else
	{
		ctx -> decl = NULL;
	}

	oberon_scope_t * this_scope;
	this_scope = oberon_open_scope(ctx);
	this_scope -> local = true;
	this_scope -> parent = NULL;
	this_scope -> parent_type = rec;

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

	rec -> scope = this_scope;
	rec -> decl = this_scope -> list -> next;
	ctx -> decl = oldscope;
}

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;

		if(ISEXPR(ctx -> token))
		{
			oberon_expr_list(ctx, &num_sizes, &sizes, 1);
		}

		oberon_assert_token(ctx, OF);

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

		if(num_sizes == 0)
		{
			oberon_make_open_array(ctx, base, *type);
		}
		else
		{
			oberon_make_multiarray(ctx, sizes, base, type);
		}
	}
	else if(ctx -> token == RECORD)
	{
		oberon_type_t * rec;
		rec = *type;
		rec -> class = OBERON_TYPE_RECORD;
		rec -> module = ctx -> mod;

		oberon_assert_token(ctx, RECORD);
		oberon_type_record_body(ctx, rec);
		oberon_assert_token(ctx, END);

		*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_NOTYPE);
		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;
	int export;
	int read_only;

	name = oberon_assert_ident(ctx);
	oberon_def(ctx, &export, &read_only);

	newtype = oberon_find_object(ctx -> decl, name, 0);
	if(newtype == NULL)
	{
		newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, export, read_only, false);
		newtype -> type = oberon_new_type_ptr(OBERON_TYPE_NOTYPE);
		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");
		}

		newtype -> export = export;
		newtype -> read_only = read_only;
	}

	oberon_assert_token(ctx, EQUAL);

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

	if(type -> class == OBERON_TYPE_NOTYPE)
	{
		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)
	{
		if(type -> class == OBERON_TYPE_POINTER)
		{
			oberon_error(ctx, "recursive pointer declaration");
		}
		else
		{
			oberon_error(ctx, "recursive array declaration (pointer)");
		}
	}

	if(type -> class == OBERON_TYPE_POINTER
		&& 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;

	if(type -> base)
	{
		oberon_prevent_recursive_record(ctx, type -> base);
	}

	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:
		case OBERON_CLASS_MODULE:
			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)
{
	assert(type -> class == OBERON_TYPE_RECORD);

	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_record(ctx, type);
}

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

	if(type -> initialized)
	{
		return;
	}

	type -> initialized = 1;

	if(type -> class == OBERON_TYPE_POINTER || type -> class == OBERON_TYPE_ARRAY)
	{
		if(type -> class == OBERON_TYPE_ARRAY
			&& type -> size != 0
			&& type -> base -> class == OBERON_TYPE_ARRAY
			&& type -> base -> size == 0)
		{
			oberon_error(ctx, "open array not allowed as array element");
		}

		oberon_type_t * rec = type -> base;
		while(rec -> class == OBERON_TYPE_ARRAY || rec -> class == OBERON_TYPE_POINTER)
		{
			rec = rec -> base;
		}

		if(rec -> class == OBERON_TYPE_RECORD
			&& rec -> initialized == 0)
		{
			rec -> initialized = 1;
			oberon_generator_init_type(ctx, rec);
			oberon_initialize_type(ctx, type -> base);
			oberon_generator_init_type(ctx, type);
			oberon_initialize_record_fields(ctx, rec);
		}
		else
		{
			oberon_initialize_type(ctx, type -> base);
			oberon_generator_init_type(ctx, type);
		}
	}
	else if(type -> class == OBERON_TYPE_RECORD)
	{
		printf("Init type: RECORD\n");
		oberon_generator_init_type(ctx, type);
		oberon_initialize_record_fields(ctx, type);
	}
	else if(type -> class == OBERON_TYPE_PROCEDURE)
	{
		printf("Init type: PROCEDURE\n");
		int num_fields = type -> num_decl;
		oberon_object_t * field = type -> decl;
		for(int i = 0; i < num_fields; i++)
		{
			oberon_initialize_type(ctx, field -> type);
			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_FIELD:
			if(x -> type -> class == OBERON_TYPE_ARRAY)
			{
				if(x -> type -> size == 0)
				{
					oberon_error(ctx, "open array not allowed as variable or field");
				}
			}
			oberon_initialize_type(ctx, x -> type);
			oberon_generator_init_var(ctx, x);
			break;
		case OBERON_CLASS_PARAM:
		case OBERON_CLASS_VAR_PARAM:
			oberon_initialize_type(ctx, x -> type);
			oberon_generator_init_var(ctx, x);
			break;
		case OBERON_CLASS_CONST:
		case OBERON_CLASS_PROC:
		case OBERON_CLASS_MODULE:
			break;
		default:
			oberon_error(ctx, "oberon_initialize_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)
{
	while(ctx -> token >= CONST && ctx -> token <= VAR)
	{
		if(ctx -> token == CONST)
		{
			oberon_assert_token(ctx, CONST);
			while(ctx -> token == IDENT)
			{
				oberon_const_decl(ctx);
				oberon_assert_token(ctx, SEMICOLON);
			}
		}
		else if(ctx -> token == TYPE)
		{
			oberon_assert_token(ctx, TYPE);
			while(ctx -> token == IDENT)
			{
				oberon_type_decl(ctx);
				oberon_assert_token(ctx, SEMICOLON);
			}
		}
		else 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 oberon_expr_t *
oberon_make_temp_var_item(oberon_context_t * ctx, oberon_type_t * type)
{
	oberon_object_t * x;
	oberon_expr_t * expr;

	x = oberon_create_object(ctx -> decl, "TEMP", OBERON_CLASS_VAR, false, false);
	x -> local = true;
	x -> type = type;
	oberon_generator_init_temp_var(ctx, x);

	expr = oberon_new_item(MODE_VAR, type, false);
	expr -> item.var = x;
	return expr;
}

static void
oberon_statement_seq(oberon_context_t * ctx);

static void
oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
{
	oberon_check_dst(ctx, dst);
	oberon_check_assignment_compatible(ctx, src, dst -> result);

	if(oberon_is_array_of_char_type(dst -> result)
		&& oberon_is_string_type(src -> result))
	{
		src -> next = dst;
		oberon_make_copy_call(ctx, 2, src);
	}
	else
	{
		src = oberon_cast_expr(ctx, src, dst -> result);
		oberon_generate_assign(ctx, src, dst);
	}
}

static oberon_expr_t *
oberon_case_labels(oberon_context_t * ctx, oberon_expr_t * val)
{
	oberon_expr_t * e1;
	oberon_expr_t * e2;
	oberon_expr_t * cond;
	oberon_expr_t * cond2;

	e1 = (oberon_expr_t *) oberon_const_expr(ctx);

	e2 = NULL;
	if(ctx -> token == DOTDOT)
	{
		oberon_assert_token(ctx, DOTDOT);
		e2 = (oberon_expr_t *) oberon_const_expr(ctx);
	}

	if(e2 == NULL)
	{
		/* val == e1 */
		cond = oberon_make_bin_op(ctx, EQUAL, val, e1);
	}
	else
	{
		/* val >= e1 && val <= e2 */
		cond = oberon_make_bin_op(ctx, GEQ, val, e1);
		cond2 = oberon_make_bin_op(ctx, LEQ, val, e2);
		cond = oberon_make_bin_op(ctx, AND, cond, cond2);
	}

	return cond;
}

static void
oberon_case(oberon_context_t * ctx, oberon_expr_t * val, gen_label_t * end)
{
	oberon_expr_t * cond;
	oberon_expr_t * cond2;
	gen_label_t * this_end;

	if(ISEXPR(ctx -> token))
	{
		this_end = oberon_generator_reserve_label(ctx);

		cond = oberon_case_labels(ctx, val);
		while(ctx -> token == COMMA)
		{
			oberon_assert_token(ctx, COMMA);
			/* cond || cond2 */
			cond2 = oberon_case_labels(ctx, val);
			cond = oberon_make_bin_op(ctx, OR, cond, cond2);
		}
		oberon_assert_token(ctx, COLON);

		oberon_generate_branch(ctx, cond, false, this_end);
		oberon_statement_seq(ctx);
		oberon_generate_goto(ctx, end);

		oberon_generate_label(ctx, this_end);
	}
}

static void
oberon_case_statement(oberon_context_t * ctx)
{
	oberon_expr_t * val;
	oberon_expr_t * expr;
	gen_label_t * end;

	end = oberon_generator_reserve_label(ctx);

	oberon_assert_token(ctx, CASE);
	expr = oberon_expr(ctx);
	val = oberon_make_temp_var_item(ctx, expr -> result);
	oberon_assign(ctx, expr, val);
	oberon_assert_token(ctx, OF);
	oberon_case(ctx, val, end);
	while(ctx -> token == BAR)
	{
		oberon_assert_token(ctx, BAR);
		oberon_case(ctx, val, end);
	}

	if(ctx -> token == ELSE)
	{
		oberon_assert_token(ctx, ELSE);
		oberon_statement_seq(ctx);
	}
	else
	{
		oberon_generate_trap(ctx, -1);
	}

	oberon_generate_label(ctx, end);
	oberon_assert_token(ctx, END);
}

static void
oberon_with_guard_do(oberon_context_t * ctx, gen_label_t * end)
{
	oberon_object_t * var;
	oberon_expr_t * var_expr;
	oberon_expr_t * type_expr;
	oberon_expr_t * cond;
	oberon_type_t * type;
	oberon_type_t * old_type;
	gen_label_t * this_end;

	this_end = oberon_generator_reserve_label(ctx);

	var_expr = oberon_qualident_expr(ctx);
	oberon_assert_token(ctx, COLON);
	type_expr = oberon_qualident_expr(ctx);
	cond = oberon_make_bin_op(ctx, IS, var_expr, type_expr);

	var = var_expr -> item.var;
	type = type_expr -> result;
	old_type = var -> type;

	oberon_assert_token(ctx, DO);
	oberon_generate_branch(ctx, cond, false, this_end);

	var -> type = type;
	oberon_set_typecheck(var, true);

	oberon_statement_seq(ctx);

	var -> type = old_type;
	oberon_set_typecheck(var, false);

	oberon_generate_goto(ctx, end);
	oberon_generate_label(ctx, this_end);
}

static void
oberon_with_statement(oberon_context_t * ctx)
{
	gen_label_t * end;
	end = oberon_generator_reserve_label(ctx);

	oberon_assert_token(ctx, WITH);
	oberon_with_guard_do(ctx, end);
	while(ctx -> token == BAR)
	{
		oberon_assert_token(ctx, BAR);
		oberon_with_guard_do(ctx, end);
	}

	if(ctx -> token == ELSE)
	{
		oberon_assert_token(ctx, ELSE);
		oberon_statement_seq(ctx);
	}
	else
	{
		oberon_generate_trap(ctx, -2);
	}

	oberon_generate_label(ctx, end);
	oberon_assert_token(ctx, END);
}

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 == IF)
	{
		gen_label_t * end;
		gen_label_t * els;
		oberon_expr_t * cond;

		els = oberon_generator_reserve_label(ctx);
		end = oberon_generator_reserve_label(ctx);

		oberon_assert_token(ctx, IF);
		cond = oberon_expr(ctx);
		if(cond -> result -> class != OBERON_TYPE_BOOLEAN)
		{
			oberon_error(ctx, "condition must be boolean");
		}
		oberon_assert_token(ctx, THEN);
		oberon_generate_branch(ctx, cond, false, els);
		oberon_statement_seq(ctx);
		oberon_generate_goto(ctx, end);
		oberon_generate_label(ctx, els);

		while(ctx -> token == ELSIF)
		{
			els = oberon_generator_reserve_label(ctx);

			oberon_assert_token(ctx, ELSIF);
			cond = oberon_expr(ctx);
			if(cond -> result -> class != OBERON_TYPE_BOOLEAN)
			{
				oberon_error(ctx, "condition must be boolean");
			}
			oberon_assert_token(ctx, THEN);
			oberon_generate_branch(ctx, cond, false, els);
			oberon_statement_seq(ctx);
			oberon_generate_goto(ctx, end);
			oberon_generate_label(ctx, els);
		}

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

		oberon_generate_label(ctx, end);
		oberon_assert_token(ctx, END);		
	}
	else if(ctx -> token == WHILE)
	{
		gen_label_t * begin;
		gen_label_t * end;
		oberon_expr_t * cond;

		begin = oberon_generator_reserve_label(ctx);
		end = oberon_generator_reserve_label(ctx);

		oberon_assert_token(ctx, WHILE);
		oberon_generate_label(ctx, begin);
		cond = oberon_expr(ctx);
		if(cond -> result -> class != OBERON_TYPE_BOOLEAN)
		{
			oberon_error(ctx, "condition must be boolean");
		}
		oberon_generate_branch(ctx, cond, false, end);

		oberon_assert_token(ctx, DO);
		oberon_statement_seq(ctx);
		oberon_generate_goto(ctx, begin);

		oberon_assert_token(ctx, END);
		oberon_generate_label(ctx, end);
	}
	else if(ctx -> token == REPEAT)
	{
		gen_label_t * begin;
		oberon_expr_t * cond;

		begin = oberon_generator_reserve_label(ctx);
		oberon_generate_label(ctx, begin);
		oberon_assert_token(ctx, REPEAT);

		oberon_statement_seq(ctx);

		oberon_assert_token(ctx, UNTIL);

		cond = oberon_expr(ctx);
		if(cond -> result -> class != OBERON_TYPE_BOOLEAN)
		{
			oberon_error(ctx, "condition must be boolean");
		}

		oberon_generate_branch(ctx, cond, false, begin);
	}
	else if(ctx -> token == FOR)
	{
		oberon_expr_t * from;
		oberon_expr_t * index;
		oberon_expr_t * to;
		oberon_expr_t * bound;
		oberon_expr_t * by;
		oberon_expr_t * cond;
		oberon_expr_t * count;
		gen_label_t * begin;
		gen_label_t * end;
		char * iname;
		int op;

		begin = oberon_generator_reserve_label(ctx);
		end = oberon_generator_reserve_label(ctx);

		oberon_assert_token(ctx, FOR);
		iname = oberon_assert_ident(ctx);
		index = oberon_ident_item(ctx, iname);
		oberon_assert_token(ctx, ASSIGN);
		from = oberon_expr(ctx);
		oberon_assert_token(ctx, TO);
		bound = oberon_make_temp_var_item(ctx, index -> result);
		to = oberon_expr(ctx);
		oberon_assign(ctx, to, bound); // сначала temp
		oberon_assign(ctx, from, index); // потом i
		if(ctx -> token == BY)
		{
			oberon_assert_token(ctx, BY);
			by = (oberon_expr_t *) oberon_const_expr(ctx);
		}
		else
		{
			by = oberon_make_integer(ctx, 1);
		}

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

		if(by -> item.integer > 0)
		{
			op = LEQ;
		}
		else if(by -> item.integer < 0)
		{
			op = GEQ;
		}
		else
		{
			oberon_error(ctx, "zero step not allowed");
		}

		oberon_assert_token(ctx, DO);
		oberon_generate_label(ctx, begin);
		cond = oberon_make_bin_op(ctx, op, index, bound);
		oberon_generate_branch(ctx, cond, false, end);
		oberon_statement_seq(ctx);
		count = oberon_make_bin_op(ctx, PLUS, index, by);
		oberon_assign(ctx, count, index);
		oberon_generate_goto(ctx, begin);
		oberon_generate_label(ctx, end);
		oberon_assert_token(ctx, END);
	}
	else if(ctx -> token == LOOP)
	{
		gen_label_t * begin;
		gen_label_t * end;

		begin = oberon_generator_reserve_label(ctx);
		end = oberon_generator_reserve_label(ctx);

		oberon_open_scope(ctx);
		oberon_assert_token(ctx, LOOP);
		oberon_generate_label(ctx, begin);
		ctx -> decl -> exit_label = end;
		oberon_statement_seq(ctx);
		oberon_generate_goto(ctx, begin);
		oberon_generate_label(ctx, end);
		oberon_assert_token(ctx, END);
		oberon_close_scope(ctx -> decl);
	}
	else if(ctx -> token == EXIT)
	{
		oberon_assert_token(ctx, EXIT);
		if(ctx -> decl -> exit_label == NULL)
		{
			oberon_error(ctx, "not in LOOP-END");
		}
		oberon_generate_goto(ctx, ctx -> decl -> exit_label);
	}
	else if(ctx -> token == CASE)
	{
		oberon_case_statement(ctx);
	}
	else if(ctx -> token == WITH)
	{
		oberon_with_statement(ctx);
	}
	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_import_module(oberon_context_t * ctx, char * alias, char * name)
{
	oberon_module_t * m = ctx -> module_list;
	while(m && strcmp(m -> name, name) != 0)
	{
		m = m -> next;
	}

	if(m == NULL)
	{
		oberon_scanner_t * s;
		s = ctx -> import_module(name);
		if(s == NULL)
		{
			oberon_error(ctx, "no such module %s", name);
		}

		m = oberon_compile_module(ctx, s);
		assert(m);
	}

	if(m -> ready == 0)
	{
		oberon_error(ctx, "cyclic module import");
	}

	oberon_object_t * ident;
	ident = oberon_define_object(ctx -> decl, alias, OBERON_CLASS_MODULE, false, false, false);
	ident -> module = m;
}

static void
oberon_import_decl(oberon_context_t * ctx)
{
	char * alias;
	char * name;

	alias = name = oberon_assert_ident(ctx);
	if(ctx -> token == ASSIGN)
	{
		oberon_assert_token(ctx, ASSIGN);
		name = oberon_assert_ident(ctx);
	}

	oberon_import_module(ctx, alias, name);
}

static void
oberon_import_list(oberon_context_t * ctx)
{
	oberon_assert_token(ctx, IMPORT);

	oberon_import_decl(ctx);
	while(ctx -> token == COMMA)
	{
		oberon_assert_token(ctx, COMMA);
		oberon_import_decl(ctx);
	}

	oberon_assert_token(ctx, SEMICOLON);
}

static void
oberon_parse_module(oberon_context_t * ctx)
{
	char * name1;
	char * 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_generator_init_module(ctx, ctx -> mod);

	if(ctx -> token == IMPORT)
	{
		oberon_import_list(ctx);
	}

	oberon_decl_seq(ctx);

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

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

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

	oberon_generator_fini_module(ctx -> mod);
}

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

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

	if(!oberon_is_type_expr(arg))
	{
		oberon_error(ctx, "MIN accept only type");
	}

	oberon_expr_t * expr;
	int bits = arg -> result -> size * 8;
	switch(arg -> result -> class)
	{
		case OBERON_TYPE_INTEGER:
			expr = oberon_make_integer(ctx, -powl(2, bits - 1));
			break;
		case OBERON_TYPE_BOOLEAN:
			expr = oberon_make_boolean(ctx, false);
			break;
		case OBERON_TYPE_CHAR:
			expr = oberon_make_char(ctx, 0);
			break;
		case OBERON_TYPE_REAL:
			expr = oberon_make_real_typed(ctx, (bits <= 32) ? (-FLT_MAX) : (-DBL_MAX), arg -> result);
			break;
		case OBERON_TYPE_SET:
			expr = oberon_make_integer(ctx, 0);
			break;
		default:
			oberon_error(ctx, "allowed only basic types");
			break;
	}

	return expr;
}

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

	if(!oberon_is_type_expr(arg))
	{
		oberon_error(ctx, "MAX accept only type");
	}

	oberon_expr_t * expr;
	int bits = arg -> result -> size * 8;
	switch(arg -> result -> class)
	{
		case OBERON_TYPE_INTEGER:
			expr = oberon_make_integer(ctx, powl(2, bits - 1) - 1);
			break;
		case OBERON_TYPE_BOOLEAN:
			expr = oberon_make_boolean(ctx, true);
			break;
		case OBERON_TYPE_CHAR:
			expr = oberon_make_char(ctx, powl(2, bits) - 1);
			break;
		case OBERON_TYPE_REAL:
			expr = oberon_make_real_typed(ctx, (bits <= 32) ? (FLT_MAX) : (DBL_MAX), arg -> result);
			break;
		case OBERON_TYPE_SET:
			expr = oberon_make_integer(ctx, bits);
			break;
		default:
			oberon_error(ctx, "allowed only basic types");
			break;
	}

	return expr;
}

static oberon_expr_t *
oberon_make_size_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;
	if(!oberon_is_type_expr(arg))
	{
		oberon_error(ctx, "SIZE accept only type");
	}

	int size;
	oberon_expr_t * expr;
	oberon_type_t * type = arg -> result;
	switch(type -> class)
	{
		case OBERON_TYPE_INTEGER:
		case OBERON_TYPE_BOOLEAN:
		case OBERON_TYPE_REAL:
		case OBERON_TYPE_CHAR:
		case OBERON_TYPE_SET:
			size = type -> size;
			break;
		default:
			oberon_error(ctx, "TODO SIZE");
			break;
	}

	expr = oberon_make_integer(ctx, size);
	return expr;
}

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_check_src(ctx, arg);

	if(!oberon_is_number_type(arg -> result))
	{
		oberon_error(ctx, "ABS accepts only numbers");
	}

	oberon_expr_t * expr;
	if(oberon_is_const(arg))
	{
		if(oberon_is_real_type(arg -> result))
		{
			double x = arg -> item.real;
			expr = oberon_make_real(ctx, fabsl(x), arg -> result);
		}
		else
		{
			int64_t x = arg -> item.integer;
			expr = oberon_make_integer(ctx, llabs(x));
		}
	}
	else
	{
		expr = oberon_new_operator(OP_ABS, arg -> result, arg, NULL);
	}
	return expr;
}

static void
oberon_make_inc_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 > 2)
	{
		oberon_error(ctx, "too mach arguments");
	}

	oberon_expr_t * dst;
	dst = list_args;
	oberon_check_dst(ctx, dst);

	if(!oberon_is_integer_type(dst -> result))
	{
		oberon_error(ctx, "expect integer");
	}

	oberon_expr_t * step;
	if(num_args == 2)
	{
		step = list_args -> next;
		oberon_check_src(ctx, step);
		if(!oberon_is_integer_type(step -> result))
		{
			oberon_error(ctx, "expect integer");
		}
	}
	else
	{
		step = oberon_make_integer(ctx, 1);
	}

	oberon_expr_t * expr;
	expr = oberon_make_bin_op(ctx, PLUS, dst, step);
	oberon_assign(ctx, expr, dst);
}

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

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

	oberon_expr_t * dst;
	dst = list_args;
	oberon_check_dst(ctx, dst);

	if(!oberon_is_set_type(dst -> result))
	{
		oberon_error(ctx, "expect integer");
	}

	oberon_expr_t * x;
	x = list_args -> next;
	oberon_check_src(ctx, x);
	
	if(!oberon_is_integer_type(x -> result))
	{
		oberon_error(ctx, "expect integer");
	}

	oberon_expr_t * expr;
	expr = oberon_make_bin_op(ctx, PLUS, dst, oberon_new_operator(OP_RANGE, dst -> result, x, NULL));
	oberon_assign(ctx, expr, dst);
}

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

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

	oberon_expr_t * dst;
	dst = list_args;
	oberon_check_dst(ctx, dst);

	if(!oberon_is_set_type(dst -> result))
	{
		oberon_error(ctx, "expect integer");
	}

	oberon_expr_t * x;
	x = list_args -> next;
	oberon_check_src(ctx, x);
	
	if(!oberon_is_integer_type(x -> result))
	{
		oberon_error(ctx, "expect integer");
	}

	oberon_expr_t * expr;
	expr = oberon_make_bin_op(ctx, MINUS, dst, oberon_new_operator(OP_RANGE, dst -> result, x, NULL));
	oberon_assign(ctx, expr, dst);
}

static void
oberon_make_dec_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 > 2)
	{
		oberon_error(ctx, "too mach arguments");
	}

	oberon_expr_t * dst;
	dst = list_args;
	oberon_check_dst(ctx, dst);

	if(!oberon_is_integer_type(dst -> result))
	{
		oberon_error(ctx, "expect integer");
	}

	oberon_expr_t * step;
	if(num_args == 2)
	{
		step = list_args -> next;
		oberon_check_src(ctx, step);
		if(!oberon_is_integer_type(step -> result))
		{
			oberon_error(ctx, "expect integer");
		}
	}
	else
	{
		step = oberon_make_integer(ctx, 1);
	}

	oberon_expr_t * expr;
	expr = oberon_make_bin_op(ctx, MINUS, dst, step);
	oberon_assign(ctx, expr, dst);
}

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

	oberon_expr_t * dst;
	dst = list_args;
	oberon_check_dst(ctx, dst);

	oberon_type_t * type;
	type = dst -> result;

	if(type -> class != OBERON_TYPE_POINTER)
	{
		oberon_error(ctx, "not a pointer");
	}

	type = type -> base;

	oberon_expr_t * src;
	src = oberon_new_item(MODE_NEW, dst -> result, 0);
	src -> item.num_args = 0;
	src -> item.args = NULL;

	int max_args = 1;
	if(type -> class == OBERON_TYPE_ARRAY)
	{
		if(type -> size == 0)
		{
			oberon_type_t * x = type;
			while(x -> class == OBERON_TYPE_ARRAY)
			{
				if(x -> size == 0)
				{
					max_args += 1;
				}
				x = x -> base;
			}
		}

		if(num_args < max_args)
		{
			oberon_error(ctx, "too few arguments");
		}

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

		int num_sizes = max_args - 1;
		oberon_expr_t * size_list = list_args -> next;

		oberon_expr_t * arg = size_list;
		for(int i = 0; i < max_args - 1; i++)
		{
			oberon_check_src(ctx, arg);
			if(arg -> result -> class != OBERON_TYPE_INTEGER)
			{
				oberon_error(ctx, "size must be integer");
			}
			arg = arg -> next;
		}

		src -> item.num_args = num_sizes;
		src -> item.args = size_list;
	}
	else if(type -> class != OBERON_TYPE_RECORD)
	{
		oberon_error(ctx, "oberon_make_new_call: wat");
	}

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

	oberon_assign(ctx, src, dst);
}

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

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

	oberon_expr_t * src;
	src = list_args;
	oberon_check_src(ctx, src);

	oberon_expr_t * dst;
	dst = list_args -> next;
	oberon_check_dst(ctx, dst);

	if(!oberon_is_string_type(src -> result) && !oberon_is_array_of_char_type(src -> result))
	{
		oberon_error(ctx, "source must be string or array of char");
	}

	if(!oberon_is_array_of_char_type(dst -> result))
	{
		oberon_error(ctx, "dst must be array of char");
	}

	oberon_generate_copy(ctx, src, dst);
}

static void
oberon_make_assert_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 > 2)
	{
		oberon_error(ctx, "too mach arguments");
	}

	oberon_expr_t * cond;
	cond = list_args;
	oberon_check_src(ctx, cond);

	if(!oberon_is_boolean_type(cond -> result))
	{
		oberon_error(ctx, "expected boolean");
	}

	if(num_args == 1)
	{
		oberon_generate_assert(ctx, cond);
	}
	else
	{
		oberon_expr_t * num;
		num = list_args -> next;
		oberon_check_src(ctx, num);

		if(!oberon_is_integer_type(num -> result))
		{
			oberon_error(ctx, "expected integer");
		}

		oberon_check_const(ctx, num);

		oberon_generate_assert_n(ctx, cond, num -> item.integer);
	}
}

static void
oberon_make_halt_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 * num;
	num = list_args;
	oberon_check_src(ctx, num);

	if(num -> result -> class != OBERON_TYPE_INTEGER)
	{
		oberon_error(ctx, "expected integer");
	}

	oberon_check_const(ctx, num);

	oberon_generate_halt(ctx, num -> item.integer);
}

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

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

	oberon_expr_t * arg1;
	arg1 = list_args;
	oberon_check_src(ctx, arg1);
	if(arg1 -> result -> class != OBERON_TYPE_INTEGER)
	{
		oberon_error(ctx, "expected integer");
	}

	oberon_expr_t * arg2;
	arg2 = list_args -> next;
	oberon_check_src(ctx, arg2);
	if(arg2 -> result -> class != OBERON_TYPE_INTEGER)
	{
		oberon_error(ctx, "expected integer");
	}

	oberon_expr_t * expr;
	if(oberon_is_const(arg1) && oberon_is_const(arg2))
	{
		int64_t x = arg1 -> item.integer;
		int64_t y = arg2 -> item.integer;
		int64_t v = (y > 0) ? (x << y) : (x >> labs(y));
		expr = oberon_make_integer(ctx, v);
	}
	else
	{
		expr = oberon_new_operator(OP_ASH, arg1 -> result, arg1, arg2);
	}

	return expr;
}

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

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

	oberon_expr_t * arg1;
	arg1 = list_args;
	oberon_check_src(ctx, arg1);

	oberon_type_t * t = arg1 -> result;
	if(!oberon_is_integer_type(t)
		&& !oberon_is_char_type(t) 
		&& !oberon_is_system_byte_type(t))
	{
		oberon_error(ctx, "expected integer, char, or SYSTEM.BYTE");
	}

	oberon_expr_t * arg2;
	arg2 = list_args -> next;
	oberon_check_src(ctx, arg2);
	if(arg2 -> result -> class != OBERON_TYPE_INTEGER)
	{
		oberon_error(ctx, "expected integer");
	}

	oberon_expr_t * expr;
	if(oberon_is_const(arg1) && oberon_is_const(arg2))
	{
		uint64_t x = arg1 -> item.integer;
		int64_t y = arg2 -> item.integer;
		uint64_t v = (y > 0) ? (x << y) : (x >> labs(y));

		if(oberon_is_integer_type(t))
		{
			expr = oberon_make_integer(ctx, v);
		}
		else if(oberon_is_char_type(t))
		{
			expr = oberon_make_char(ctx, v);
		}
		else
		{
			expr = oberon_make_system_byte(ctx, v);
		}
	}
	else
	{
		expr = oberon_new_operator(OP_LSH, arg1 -> result, arg1, arg2);
		expr = oberon_cast_expr(ctx, expr, t);
	}

	return expr;
}

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

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

	oberon_expr_t * arg1;
	arg1 = list_args;
	oberon_check_src(ctx, arg1);

	oberon_type_t * t = arg1 -> result;
	if(!oberon_is_integer_type(t)
		&& !oberon_is_char_type(t) 
		&& !oberon_is_system_byte_type(t))
	{
		oberon_error(ctx, "expected integer, char, or SYSTEM.BYTE");
	}

	oberon_expr_t * arg2;
	arg2 = list_args -> next;
	oberon_check_src(ctx, arg2);
	if(arg2 -> result -> class != OBERON_TYPE_INTEGER)
	{
		oberon_error(ctx, "expected integer");
	}

	oberon_expr_t * expr;
	if(oberon_is_const(arg1) && oberon_is_const(arg2))
	{
		uint64_t x = arg1 -> item.integer;
		int64_t y = arg2 -> item.integer;

		uint64_t v = 0;
		if(y > 0)
		{
			v = (x << y) | (x >> (64 - y));
		}
		else
		{
			y = labs(y);
			v = (x >> y) | (x << (64 - y));
		}

		if(oberon_is_integer_type(t))
		{
			expr = oberon_make_integer(ctx, v);
		}
		else if(oberon_is_char_type(t))
		{
			expr = oberon_make_char(ctx, v);
		}
		else
		{
			expr = oberon_make_system_byte(ctx, v);
		}
	}
	else
	{
		expr = oberon_new_operator(OP_ROT, arg1 -> result, arg1, arg2);
		expr = oberon_cast_expr(ctx, expr, t);
	}

	return expr;
}

static oberon_expr_t *
oberon_make_cap_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_check_src(ctx, arg);

	if(!oberon_is_char_type(arg -> result))
	{
		oberon_error(ctx, "expected char");
	}

	oberon_expr_t * expr;
	if(oberon_is_const(arg))
	{
		expr = oberon_make_char(ctx, toupper(arg -> item.integer));
	}
	else
	{
		expr = oberon_new_operator(OP_CAP, arg -> result, arg, NULL);
	}

	return expr;
}

static oberon_expr_t *
oberon_make_chr_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_check_src(ctx, arg);

	if(!oberon_is_integer_type(arg -> result))
	{
		oberon_error(ctx, "expected integer");
	}

	oberon_expr_t * expr;
	if(oberon_is_const(arg))
	{
		expr = oberon_make_char(ctx, arg -> item.integer);
	}
	else
	{
		expr = oberon_cast_expr(ctx, arg, ctx -> char_type);
	}
	return expr;
}

static oberon_expr_t *
oberon_make_ord_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_check_src(ctx, arg);

	if(!oberon_is_char_type(arg -> result) && !oberon_is_string_of_one(arg))
	{
		oberon_error(ctx, "expected char");
	}

	oberon_expr_t * expr;
	if(oberon_is_const(arg))
	{
		expr = oberon_make_integer(ctx, arg -> item.integer);
	}
	else
	{
		expr = oberon_cast_expr(ctx, arg, ctx -> shortint_type);
	}
	return expr;
}

static oberon_expr_t *
oberon_make_entier_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_check_src(ctx, arg);

	if(!oberon_is_real_type(arg -> result))
	{
		oberon_error(ctx, "expected real");
	}

	oberon_expr_t * expr;
	if(oberon_is_const(arg))
	{
		expr = oberon_make_integer(ctx, floor(arg -> item.real));
	}
	else
	{
		expr = oberon_new_operator(OP_ENTIER, ctx -> int_type, arg, NULL);
	}
	return expr;
}

static oberon_expr_t *
oberon_make_odd_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_check_src(ctx, arg);

	if(!oberon_is_integer_type(arg -> result))
	{
		oberon_error(ctx, "expected integer");
	}

	oberon_expr_t * expr;
	expr = oberon_make_bin_op(ctx, MOD, arg, oberon_make_integer(ctx, 2));
	expr = oberon_make_bin_op(ctx, EQUAL, expr, oberon_make_integer(ctx, 1));
	return expr;
}

static oberon_expr_t *
oberon_make_cc_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_check_src(ctx, arg);
	oberon_check_const(ctx, arg);

	if(!oberon_is_integer_type(arg -> result))
	{
		oberon_error(ctx, "expected integer");
	}

	/* n >= 0 && n <= 15 */

	oberon_expr_t * cond1;
	oberon_expr_t * cond2;
	cond1 = oberon_make_bin_op(ctx, GEQ, arg, oberon_make_integer(ctx, 0));
	cond2 = oberon_make_bin_op(ctx, LEQ, arg, oberon_make_integer(ctx, 15));
	return oberon_make_bin_op(ctx, AND, cond1, cond2);
}

static oberon_expr_t *
oberon_make_short_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_check_src(ctx, arg);

	if(arg -> result -> shorter == NULL)
	{
		oberon_error(ctx, "already shorter");
	}

	oberon_expr_t * expr;
	expr = oberon_cast_expr(ctx, arg, arg -> result -> shorter);
	return expr;
}

static oberon_expr_t *
oberon_make_long_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_check_src(ctx, arg);

	if(arg -> result -> longer == NULL)
	{
		oberon_error(ctx, "already longer");
	}

	oberon_expr_t * expr;
	expr = oberon_cast_expr(ctx, arg, arg -> result -> longer);
	return expr;
}

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

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

	oberon_expr_t * typ;
	typ = list_args;
	if(!oberon_is_type_expr(typ))
	{
		oberon_error(ctx, "requires type");
	}

	oberon_expr_t * arg;
	arg = list_args -> next;
	oberon_check_src(ctx, arg);

	oberon_expr_t * expr;
	expr = oberon_hard_cast_expr(ctx, arg, typ -> result);
	return expr;
}

static oberon_expr_t *
oberon_make_len_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 > 2)
	{
		oberon_error(ctx, "too mach arguments");
	}

	oberon_expr_t * v;
	v = list_args;
	oberon_check_src(ctx, v);

	if(!oberon_is_array_type(v -> result))
	{
		oberon_error(ctx, "expected array");
	}

	int n = 0;
	if(num_args == 2)
	{
		oberon_expr_t * num;
		num = list_args -> next;
		oberon_check_src(ctx, num);

		if(!oberon_is_integer_type(num -> result))
		{
			oberon_error(ctx, "expected integer");
		}
		oberon_check_const(ctx, num);

		n = num -> item.integer;
	}

	int dim = 0;
	oberon_type_t * arr = v -> result;
	while(arr -> class == OBERON_TYPE_ARRAY)
	{
		dim += 1;
		arr = arr -> base;
	}

	if(n < 0 || n > dim)
	{
		oberon_error(ctx, "not in range 0..%i", dim - 1);
	}

	assert(v -> is_item);

	oberon_expr_t * expr;
	expr = oberon_new_item(MODE_LEN, ctx -> int_type, true);
	expr -> item.parent = (oberon_item_t *) v;
	expr -> item.integer = n;
	return expr;	
}

static void
oberon_new_const(oberon_context_t * ctx, char * name, oberon_expr_t * expr)
{
	oberon_object_t * constant;
	constant = oberon_define_object(ctx -> decl, name, OBERON_CLASS_CONST, true, false, false);
	oberon_check_const(ctx, expr);
	constant -> value = (oberon_item_t *) expr;
}

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

	ctx -> nil_type = oberon_new_type_ptr(OBERON_TYPE_NIL);
	oberon_generator_init_type(ctx, ctx -> nil_type);

	ctx -> string_type = oberon_new_type_string(1);
	oberon_generator_init_type(ctx, ctx -> string_type);

	ctx -> bool_type = oberon_new_type_boolean();
	oberon_generator_init_type(ctx, ctx -> bool_type);

	ctx -> char_type = oberon_new_type_char(1);
	oberon_generator_init_type(ctx, ctx -> char_type);

	ctx -> byte_type = oberon_new_type_integer(1);
	oberon_generator_init_type(ctx, ctx -> byte_type);

	ctx -> shortint_type = oberon_new_type_integer(2);
	oberon_generator_init_type(ctx, ctx -> shortint_type);

	ctx -> int_type = oberon_new_type_integer(4);
	oberon_generator_init_type(ctx, ctx -> int_type);

	ctx -> longint_type = oberon_new_type_integer(8);
	oberon_generator_init_type(ctx, ctx -> longint_type);

	ctx -> real_type = oberon_new_type_real(4);
	oberon_generator_init_type(ctx, ctx -> real_type);

	ctx -> longreal_type = oberon_new_type_real(8);
	oberon_generator_init_type(ctx, ctx -> longreal_type);

	ctx -> set_type = oberon_new_type_set(4);
	oberon_generator_init_type(ctx, ctx -> set_type);

	ctx -> system_byte_type = oberon_new_type_ptr(OBERON_TYPE_SYSTEM_BYTE);
	oberon_generator_init_type(ctx, ctx -> system_byte_type);

	ctx -> system_ptr_type = oberon_new_type_ptr(OBERON_TYPE_SYSTEM_PTR);
	oberon_generator_init_type(ctx, ctx -> system_ptr_type);

	/* LONG / SHORT support */
	ctx -> byte_type -> shorter = NULL;
	ctx -> byte_type -> longer = ctx -> shortint_type;

	ctx -> shortint_type -> shorter = ctx -> byte_type;
	ctx -> shortint_type -> longer = ctx -> int_type;

	ctx -> int_type -> shorter = ctx -> shortint_type;
	ctx -> int_type -> longer = ctx -> longint_type;

	ctx -> longint_type -> shorter = ctx -> int_type;
	ctx -> longint_type -> longer = NULL;

	ctx -> real_type -> shorter = NULL;
	ctx -> real_type -> longer = ctx -> longreal_type;

	ctx -> longreal_type -> shorter = ctx -> real_type;
	ctx -> longreal_type -> longer = NULL;
}

static void
oberon_new_intrinsic(oberon_context_t * ctx, char * name, GenerateFuncCallback f, GenerateProcCallback p)
{
	oberon_object_t * proc;
	proc = oberon_define_object(ctx -> decl, name, OBERON_CLASS_PROC, true, false, false);
	proc -> type = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
	proc -> type -> sysproc = true;
	proc -> type -> genfunc = f;
	proc -> type -> genproc = p;
}

static void oberon_new_intrinsic_type(oberon_context_t * ctx, char * name, oberon_type_t * type)
{
	oberon_object_t * id;
	id = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE, true, false, false);
	id -> type = type;
}

static void
oberon_begin_intrinsic_module(oberon_context_t * ctx, char * name, oberon_module_t ** m)
{
	oberon_scope_t * module_scope;
	module_scope = oberon_open_scope(ctx);

	oberon_module_t * module;
	module = GC_MALLOC(sizeof *module);
	memset(module, 0, sizeof *module);
	module -> name = name;
	module -> intrinsic = true;
	module -> decl = module_scope;
	module -> next = ctx -> module_list;

	ctx -> mod = module;
	ctx -> module_list = module;

	*m = module;
}

static void
oberon_end_intrinsic_module(oberon_context_t * ctx, oberon_module_t * m)
{
	oberon_close_scope(m -> decl);
	m -> ready = true;
	ctx -> mod = NULL;
}

oberon_context_t *
oberon_create_context(ModuleImportCallback import_module)
{
	oberon_context_t * ctx = GC_MALLOC(sizeof *ctx);
	memset(ctx, 0, sizeof *ctx);

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

	ctx -> import_module = import_module;

	oberon_generator_init_context(ctx);

	/* Types */
	register_default_types(ctx);

	/* Constants */
	oberon_new_const(ctx, "TRUE", oberon_make_boolean(ctx, true));
	oberon_new_const(ctx, "FALSE", oberon_make_boolean(ctx, false));

	/* Types */
	oberon_new_intrinsic_type(ctx, "BOOLEAN", ctx -> bool_type);
	oberon_new_intrinsic_type(ctx, "CHAR", ctx -> char_type);
	oberon_new_intrinsic_type(ctx, "SHORTINT", ctx -> byte_type);
	oberon_new_intrinsic_type(ctx, "INTEGER", ctx -> shortint_type);
	oberon_new_intrinsic_type(ctx, "LONGINT", ctx -> int_type);
	oberon_new_intrinsic_type(ctx, "HUGEINT", ctx -> longint_type);
	oberon_new_intrinsic_type(ctx, "REAL", ctx -> real_type);
	oberon_new_intrinsic_type(ctx, "LONGREAL", ctx -> longreal_type);
	oberon_new_intrinsic_type(ctx, "SET", ctx -> set_type);

	/* Functions */
	oberon_new_intrinsic(ctx, "ABS", oberon_make_abs_call, NULL);
	oberon_new_intrinsic(ctx, "ASH", oberon_make_ash_call, NULL);
	oberon_new_intrinsic(ctx, "CAP", oberon_make_cap_call, NULL);
	oberon_new_intrinsic(ctx, "CHR", oberon_make_chr_call, NULL);
	oberon_new_intrinsic(ctx, "ENTIER", oberon_make_entier_call, NULL);
	oberon_new_intrinsic(ctx, "LEN", oberon_make_len_call, NULL);
	oberon_new_intrinsic(ctx, "LONG", oberon_make_long_call, NULL);
	oberon_new_intrinsic(ctx, "MAX", oberon_make_max_call, NULL);
	oberon_new_intrinsic(ctx, "MIN", oberon_make_min_call, NULL);
	oberon_new_intrinsic(ctx, "ODD", oberon_make_odd_call, NULL);
	oberon_new_intrinsic(ctx, "ORD", oberon_make_ord_call, NULL);
	oberon_new_intrinsic(ctx, "SHORT", oberon_make_short_call, NULL);
	oberon_new_intrinsic(ctx, "SIZE", oberon_make_size_call, NULL);

	/* Procedures */
	oberon_new_intrinsic(ctx, "ASSERT", NULL, oberon_make_assert_call);
	oberon_new_intrinsic(ctx, "COPY", NULL, oberon_make_copy_call);
	oberon_new_intrinsic(ctx, "DEC", NULL, oberon_make_dec_call);
	oberon_new_intrinsic(ctx, "EXCL", NULL, oberon_make_excl_call);
	oberon_new_intrinsic(ctx, "HALT", NULL, oberon_make_halt_call);
	oberon_new_intrinsic(ctx, "INC", NULL, oberon_make_inc_call);
	oberon_new_intrinsic(ctx, "INCL", NULL, oberon_make_incl_call);
	oberon_new_intrinsic(ctx, "NEW", NULL, oberon_make_new_call);

	/* MODULE SYSTEM */
	oberon_begin_intrinsic_module(ctx, "SYSTEM", &ctx -> system_module);

		/* Types */
		oberon_new_intrinsic_type(ctx, "BYTE", ctx -> system_byte_type);
		oberon_new_intrinsic_type(ctx, "PTR", ctx -> system_ptr_type);
		oberon_new_intrinsic_type(ctx, "INT8", ctx -> byte_type);
		oberon_new_intrinsic_type(ctx, "INT16", ctx -> shortint_type);
		oberon_new_intrinsic_type(ctx, "INT32", ctx -> int_type);
		oberon_new_intrinsic_type(ctx, "INT64", ctx -> longint_type);
		oberon_new_intrinsic_type(ctx, "SET32", ctx -> set_type);

		/* Functions */
		oberon_new_intrinsic(ctx, "CC", oberon_make_cc_call, NULL);
		oberon_new_intrinsic(ctx, "LSH", oberon_make_lsh_call, NULL);
		oberon_new_intrinsic(ctx, "ROT", oberon_make_rot_call, NULL);
		oberon_new_intrinsic(ctx, "VAL", oberon_make_val_call, NULL);

	oberon_end_intrinsic_module(ctx, ctx -> system_module);

	return ctx;
}

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

oberon_module_t *
oberon_compile_module(oberon_context_t * ctx, oberon_scanner_t * s)
{
	const char * code = ctx -> code;
	int code_index = ctx -> code_index;
	oberon_location_t loc = ctx -> loc;
	oberon_location_t xloc = ctx -> xloc;
	char c = ctx -> c;
	int token = ctx -> token;
	char * string = ctx -> string;
	int integer = ctx -> integer;
	int real = ctx -> real;
	bool longmode = ctx -> longmode;
	oberon_scope_t * decl = ctx -> decl;
	oberon_module_t * mod = ctx -> mod;

	oberon_scope_t * module_scope;
	module_scope = oberon_open_scope(ctx);

	oberon_module_t * module;
	module = GC_MALLOC(sizeof *module);
	memset(module, 0, sizeof *module);
	module -> decl = module_scope;
	module -> next = ctx -> module_list;

	ctx -> mod = module;
	ctx -> module_list = module;

	oberon_init_scaner(ctx, s);
	oberon_parse_module(ctx);

	module -> ready = 1;

	ctx -> code = code;
	ctx -> code_index = code_index;
	ctx -> loc = loc;
	ctx -> xloc = xloc;
	ctx -> c = c;
	ctx -> token = token;
	ctx -> string = string;
	ctx -> integer = integer;
	ctx -> real = real;
	ctx -> longmode = longmode;
	ctx -> decl = decl;
	ctx -> mod = mod;

	return module;
}