X-Git-Url: http://deadsoftware.ru/gitweb?p=dsw-obn.git;a=blobdiff_plain;f=oberon.c;h=65803c0d7eaf5924fdc96b42858b0eb3834c016d;hp=98928fbe7c4e1629b2519b0f505e54fb921ef63b;hb=063ba732ee8778c34a3781270b18d52481dbf0cd;hpb=d465a8b1fddbbabcf4f9739e80e9e82dc945028e

diff --git a/oberon.c b/oberon.c
index 98928fb..65803c0 100644
--- a/oberon.c
+++ b/oberon.c
@@ -3,6 +3,7 @@
 #include <stdarg.h>
 #include <ctype.h>
 #include <string.h>
+#include <assert.h>
 
 #include "oberon.h"
 #include "generator.h"
@@ -38,7 +39,15 @@ enum {
 	MOD,
 	AND,
 	NOT,
-	PROCEDURE
+	PROCEDURE,
+	COMMA,
+	RETURN,
+	CONST,
+	TYPE,
+	ARRAY,
+	OF,
+	LBRACE,
+	RBRACE,
 };
 
 // =======================================================================
@@ -60,6 +69,33 @@ oberon_error(oberon_context_t * ctx, const char * fmt, ...)
 	exit(1);
 }
 
+static oberon_type_t *
+oberon_new_type_ptr(int class)
+{
+	oberon_type_t * x = malloc(sizeof *x);
+	memset(x, 0, sizeof *x);
+	x -> class = class;
+	return x;
+}
+
+static oberon_type_t *
+oberon_new_type_integer(int size)
+{
+	oberon_type_t * x;
+	x = oberon_new_type_ptr(OBERON_TYPE_INTEGER);
+	x -> size = size;
+	return x;
+}
+
+static oberon_type_t *
+oberon_new_type_boolean(int size)
+{
+	oberon_type_t * x;
+	x = oberon_new_type_ptr(OBERON_TYPE_BOOLEAN);
+	x -> size = size;
+	return x;
+}
+
 // =======================================================================
 //   TABLE
 // ======================================================================= 
@@ -143,13 +179,14 @@ oberon_find_object(oberon_scope_t * scope, char * name)
 	return result;
 }
 
-static void
+static oberon_object_t *
 oberon_define_type(oberon_scope_t * scope, char * name, oberon_type_t * type)
 {
 	oberon_object_t * id;
 	id = oberon_define_object(scope, name, OBERON_CLASS_TYPE);
 	id -> type = type;
 	oberon_generator_init_type(scope -> ctx, type);
+	return id;
 }
 
 static oberon_type_t *
@@ -164,13 +201,14 @@ oberon_find_type(oberon_scope_t * scope, char * name)
 	return x -> type;
 }
 
-static void
-oberon_define_var(oberon_scope_t * scope, char * name, oberon_type_t * type)
+static oberon_object_t *
+oberon_define_var(oberon_scope_t * scope, int class, char * name, oberon_type_t * type)
 {
 	oberon_object_t * var;
-	var = oberon_define_object(scope, name, OBERON_CLASS_VAR);
+	var = oberon_define_object(scope, name, class);
 	var -> type = type;
 	oberon_generator_init_var(scope -> ctx, var);
+	return var;
 }
 
 /*
@@ -189,10 +227,11 @@ oberon_find_var(oberon_scope_t * scope, char * name)
 */
 
 static oberon_object_t *
-oberon_define_proc(oberon_scope_t * scope, char * name)
+oberon_define_proc(oberon_scope_t * scope, char * name, oberon_type_t * signature)
 {
 	oberon_object_t * proc;
 	proc = oberon_define_object(scope, name, OBERON_CLASS_PROC);
+	proc -> type = signature;
 	oberon_generator_init_proc(scope -> ctx, proc);
 	return proc;
 }
@@ -279,6 +318,26 @@ oberon_read_ident(oberon_context_t * ctx)
 	{
 		ctx -> token = PROCEDURE;
 	}
+	else if(strcmp(ident, "RETURN") == 0)
+	{
+		ctx -> token = RETURN;
+	}
+	else if(strcmp(ident, "CONST") == 0)
+	{
+		ctx -> token = CONST;
+	}
+	else if(strcmp(ident, "TYPE") == 0)
+	{
+		ctx -> token = TYPE;
+	}
+	else if(strcmp(ident, "ARRAY") == 0)
+	{
+		ctx -> token = ARRAY;
+	}
+	else if(strcmp(ident, "OF") == 0)
+	{
+		ctx -> token = OF;
+	}
 }
 
 static void
@@ -399,6 +458,18 @@ oberon_read_symbol(oberon_context_t * ctx)
 			ctx -> token = NOT;
 			oberon_get_char(ctx);
 			break;
+		case ',':
+			ctx -> token = COMMA;
+			oberon_get_char(ctx);
+			break;
+		case '[':
+			ctx -> token = LBRACE;
+			oberon_get_char(ctx);
+			break;
+		case ']':
+			ctx -> token = RBRACE;
+			oberon_get_char(ctx);
+			break;
 		default:
 			oberon_error(ctx, "invalid char");
 			break;
@@ -433,6 +504,7 @@ static void oberon_expect_token(oberon_context_t * ctx, int token);
 static oberon_expr_t * oberon_expr(oberon_context_t * ctx);
 static void oberon_assert_token(oberon_context_t * ctx, int token);
 static char * oberon_assert_ident(oberon_context_t * ctx);
+static oberon_type_t * oberon_type(oberon_context_t * ctx);
 
 static oberon_expr_t *
 oberon_new_operator(int op, oberon_type_t * result, oberon_expr_t * left, oberon_expr_t * right)
@@ -498,38 +570,167 @@ oberon_make_unary_op(oberon_context_t * ctx, int token, oberon_expr_t * a)
 	return expr;
 }
 
+static void
+oberon_expr_list(oberon_context_t * ctx, int * num_expr, oberon_expr_t ** first)
+{
+	oberon_expr_t * last;
+
+	*num_expr = 1;
+	*first = last = oberon_expr(ctx);
+	while(ctx -> token == COMMA)
+	{
+		oberon_assert_token(ctx, COMMA);
+		oberon_expr_t * current;
+		current = oberon_expr(ctx);
+		last -> next = current;
+		last = current;
+		*num_expr += 1;
+	}
+}
+
 static oberon_expr_t *
-oberon_factor(oberon_context_t * ctx)
+oberon_autocast_to(oberon_context_t * ctx, oberon_expr_t * expr, oberon_type_t * pref)
+{
+	if(expr -> result -> class != pref -> class)
+	{
+		oberon_error(ctx, "incompatible types");
+	}
+
+	if(pref -> class == OBERON_TYPE_INTEGER)
+	{
+		if(expr -> result -> class > pref -> class)
+		{
+			oberon_error(ctx, "incompatible size");
+		}
+	}
+
+	// TODO cast
+
+	return expr;
+}
+
+static void
+oberon_autocast_call(oberon_context_t * ctx, oberon_expr_t * desig)
+{
+	if(desig -> is_item == 0)
+	{
+		oberon_error(ctx, "expected item");
+	}
+
+	if(desig -> item.mode != MODE_CALL)
+	{
+		oberon_error(ctx, "expected mode CALL");
+	}
+
+	if(desig -> item.var -> class != OBERON_CLASS_PROC)
+	{
+		oberon_error(ctx, "only procedures can be called");
+	}
+
+	oberon_type_t * fn = desig -> item.var -> type;
+	int num_args = desig -> item.num_args;
+	int num_decl = fn -> num_decl;
+
+	if(num_args < num_decl)
+	{
+		oberon_error(ctx, "too few arguments");
+	}
+	else if(num_args > num_decl)
+	{
+		oberon_error(ctx, "too many arguments");
+	}
+
+	oberon_expr_t * arg = desig -> item.args;
+	oberon_object_t * param = fn -> decl;
+	for(int i = 0; i < num_args; i++)
+	{
+		oberon_autocast_to(ctx, arg, param -> type);
+		arg = arg -> next;
+		param = param -> next;
+	}
+}
+
+#define ISEXPR(x) \
+	(((x) == PLUS) \
+	|| ((x) == MINUS) \
+	|| ((x) == IDENT) \
+	|| ((x) == INTEGER) \
+	|| ((x) == LPAREN) \
+	|| ((x) == NOT) \
+	|| ((x) == TRUE) \
+	|| ((x) == FALSE))
+
+static oberon_expr_t *
+oberon_designator(oberon_context_t * ctx)
 {
 	char * name;
 	oberon_object_t * var;
 	oberon_expr_t * expr;
 
+	name = oberon_assert_ident(ctx);
+	var = oberon_find_object(ctx -> decl, name);
+
+	switch(var -> class)
+	{
+		case OBERON_CLASS_CONST:
+			// TODO copy value
+			expr = (oberon_expr_t *) var -> value;
+			break;
+		case OBERON_CLASS_VAR:
+		case OBERON_CLASS_VAR_PARAM:
+		case OBERON_CLASS_PARAM:
+			expr = oberon_new_item(MODE_VAR, var -> type);
+			break;
+		case OBERON_CLASS_PROC:
+			expr = oberon_new_item(MODE_CALL, var -> type);
+			break;
+		default:
+			oberon_error(ctx, "invalid designator");
+			break;
+	}
+
+	expr -> item.var = var;
+	return expr;
+}
+
+static oberon_expr_t *
+oberon_opt_proc_parens(oberon_context_t * ctx, oberon_expr_t * expr)
+{
+	assert(expr -> is_item == 1);
+	if(ctx -> token == LPAREN)
+	{
+		oberon_assert_token(ctx, LPAREN);
+
+		int num_args = 0;
+		oberon_expr_t * arguments = NULL;
+
+		if(ISEXPR(ctx -> token))
+		{
+			oberon_expr_list(ctx, &num_args, &arguments);
+		}
+
+		expr -> result = expr -> item.var -> type -> base;
+		expr -> item.mode = MODE_CALL;
+		expr -> item.num_args = num_args;
+		expr -> item.args = arguments;
+		oberon_assert_token(ctx, RPAREN);
+
+		oberon_autocast_call(ctx, expr);
+	}
+
+	return expr;
+}
+
+static oberon_expr_t *
+oberon_factor(oberon_context_t * ctx)
+{
+	oberon_expr_t * expr;
+
 	switch(ctx -> token)
 	{
 		case IDENT:
-			name = oberon_assert_ident(ctx);
-			var = oberon_find_object(ctx -> decl, name);
-			if(var -> class == OBERON_CLASS_VAR)
-			{
-				expr = oberon_new_item(MODE_VAR, var -> type);
-			}
-			else if(var -> class == OBERON_CLASS_PROC)
-			{
-				expr = oberon_new_item(MODE_CALL, var -> type);
-			}
-			else
-			{
-				oberon_error(ctx, "invalid designator");
-			}
-
-			expr -> item.var = var;
-			if(ctx -> token == LPAREN)
-			{
-				oberon_assert_token(ctx, LPAREN);
-				expr -> item.mode = MODE_CALL;
-				oberon_assert_token(ctx, RPAREN);
-			}
+			expr = oberon_designator(ctx);
+			expr = oberon_opt_proc_parens(ctx, expr);
 			break;
 		case INTEGER:
 			expr = oberon_new_item(MODE_INTEGER, ctx -> int_type);
@@ -613,14 +814,12 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
 	oberon_expr_t * expr;
 	oberon_type_t * result;
 
-	oberon_autocast_binary_op(ctx, a -> result, b -> result, &result);
-
 	if(ITMAKESBOOLEAN(token))
 	{
 		if(ITUSEONLYINTEGER(token))
 		{
 			if(a -> result -> class != OBERON_TYPE_INTEGER
-				&& b -> result -> class != OBERON_TYPE_INTEGER)
+				|| b -> result -> class != OBERON_TYPE_INTEGER)
 			{
 				oberon_error(ctx, "used only with integer types");
 			}
@@ -628,12 +827,14 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
 		else if(ITUSEONLYBOOLEAN(token))
 		{
 			if(a -> result -> class != OBERON_TYPE_BOOLEAN
-				&& b -> result -> class != OBERON_TYPE_BOOLEAN)
+				|| b -> result -> class != OBERON_TYPE_BOOLEAN)
 			{
 				oberon_error(ctx, "used only with boolean type");
 			}
 		}
 
+		result = ctx -> bool_type;
+
 		if(token == EQUAL)
 		{
 			expr = oberon_new_operator(OP_EQ, result, a, b);
@@ -673,6 +874,8 @@ oberon_make_bin_op(oberon_context_t * ctx, int token, oberon_expr_t * a, oberon_
 	}
 	else
 	{
+		oberon_autocast_binary_op(ctx, a -> result, b -> result, &result);
+
 		if(token == PLUS)
 		{
 			expr = oberon_new_operator(OP_ADD, result, a, b);
@@ -786,6 +989,20 @@ oberon_expr(oberon_context_t * ctx)
 	return expr;
 }
 
+static oberon_item_t *
+oberon_const_expr(oberon_context_t * ctx)
+{
+	oberon_expr_t * expr;
+	expr = oberon_expr(ctx);
+
+	if(expr -> is_item == 0)
+	{
+		oberon_error(ctx, "const expression are required");
+	}
+
+	return (oberon_item_t *) expr;
+}
+
 // =======================================================================
 //   PARSER
 // =======================================================================
@@ -817,11 +1034,49 @@ oberon_assert_ident(oberon_context_t * ctx)
 	return ident;
 }
 
+static oberon_type_t *
+oberon_make_array_type(oberon_context_t * ctx, int dim, oberon_item_t * size, oberon_type_t * base)
+{
+	assert(dim == 1);
+	oberon_type_t * newtype;
+
+	if(size -> mode != MODE_INTEGER)
+	{
+		oberon_error(ctx, "requires integer constant");
+	}
+
+	newtype = oberon_new_type_ptr(OBERON_TYPE_ARRAY);
+	newtype -> dim = dim;
+	newtype -> size = size -> integer;
+	newtype -> base = base;
+	oberon_generator_init_type(ctx, newtype);
+
+	return newtype;
+}
+
 static oberon_type_t *
 oberon_type(oberon_context_t * ctx)
 {
-	char * name = oberon_assert_ident(ctx);
-	oberon_type_t * type = oberon_find_type(ctx -> decl, name);
+	oberon_type_t * type;
+
+	if(ctx -> token == IDENT)
+	{
+		char * name = oberon_assert_ident(ctx);
+		type = oberon_find_type(ctx -> decl, name);
+	}
+	else if(ctx -> token == ARRAY)
+	{
+		oberon_assert_token(ctx, ARRAY);
+		oberon_item_t * size = oberon_const_expr(ctx);
+		oberon_assert_token(ctx, OF);
+		oberon_type_t * base = oberon_type(ctx);
+		type = oberon_make_array_type(ctx, 1, size, base);
+	}
+	else
+	{
+		oberon_error(ctx, "invalid type declaration");
+	}
+
 	return type;
 }
 
@@ -831,26 +1086,113 @@ oberon_var_decl(oberon_context_t * ctx)
 	char * name = oberon_assert_ident(ctx);
 	oberon_assert_token(ctx, COLON);
 	oberon_type_t * type = oberon_type(ctx);
-	oberon_define_var(ctx -> decl, name, type);
+	oberon_define_var(ctx -> decl, OBERON_CLASS_VAR, name, type);
 }
 
-static void
-oberon_make_procedure_begin(oberon_context_t * ctx, char * name)
+static oberon_object_t *
+oberon_make_param(oberon_context_t * ctx, int token, char * name, oberon_type_t * type)
 {
-	oberon_object_t * proc;
-	proc = oberon_define_proc(ctx -> decl, name);
+	oberon_object_t * param;
 
-	oberon_open_scope(ctx);
+	if(token == VAR)
+	{
+		param = oberon_define_var(ctx -> decl, OBERON_CLASS_VAR_PARAM, name, type);
+	}
+	else if(token == IDENT)
+	{
+		param = oberon_define_var(ctx -> decl, OBERON_CLASS_PARAM, name, type);
+	}
+	else
+	{
+		oberon_error(ctx, "oberon_make_param: wat");
+	}
 
-	oberon_generate_begin_proc(ctx, proc);
+	return param;
+}
+
+static oberon_object_t *
+oberon_fp_section(oberon_context_t * ctx, int * num_decl)
+{
+	int modifer_token = ctx -> token;
+	if(ctx -> token == VAR)
+	{
+		oberon_read_token(ctx);
+	}
+
+	char * name;
+	name = oberon_assert_ident(ctx);
+
+	oberon_assert_token(ctx, COLON);
+
+	oberon_type_t * type;
+	type = oberon_type(ctx);
+
+	oberon_object_t * first;
+	first = oberon_make_param(ctx, modifer_token, name, type);
+
+	*num_decl += 1;
+	return first;
+}
+
+#define ISFPSECTION \
+	((ctx -> token == VAR) || (ctx -> token == IDENT))
+
+static oberon_type_t *
+oberon_formal_pars(oberon_context_t * ctx)
+{
+	oberon_type_t * tp;
+	tp = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
+	tp -> num_decl = 0;
+	tp -> base = ctx -> void_type;
+	tp -> decl = NULL;
+
+	oberon_assert_token(ctx, LPAREN);
+
+	if(ISFPSECTION)
+	{
+		tp -> decl = oberon_fp_section(ctx, &tp -> num_decl);
+		while(ctx -> token == SEMICOLON)
+		{
+			oberon_assert_token(ctx, SEMICOLON);
+			oberon_fp_section(ctx, &tp -> num_decl);
+		}
+	}
+
+	oberon_assert_token(ctx, RPAREN);
+
+	if(ctx -> token == COLON)
+	{
+		oberon_assert_token(ctx, COLON);
+		tp -> base = oberon_type(ctx);
+	}
+
+	oberon_generator_init_type(ctx, tp);
+	return tp;
 }
 
 static void
-oberon_make_procedure_end(oberon_context_t * ctx)
+oberon_make_return(oberon_context_t * ctx, oberon_expr_t * expr)
 {
-	oberon_generate_end_proc(ctx);
+	if(ctx -> result_type -> class == OBERON_TYPE_VOID)
+	{
+		if(expr != NULL)
+		{
+			oberon_error(ctx, "procedure has no result type");
+		}
+	}
+	else
+	{
+		if(expr == NULL)
+		{
+			oberon_error(ctx, "procedure requires expression on result");
+		}
 
-	oberon_close_scope(ctx -> decl);
+		oberon_autocast_to(ctx, expr, ctx -> result_type);
+	}
+
+	ctx -> has_return = 1;
+
+	oberon_generate_return(ctx, expr);
 }
 
 static void
@@ -861,28 +1203,116 @@ oberon_proc_decl(oberon_context_t * ctx)
 	char * name;
 	name = oberon_assert_ident(ctx);
 
+	oberon_scope_t * this_proc_def_scope = ctx -> decl;
+	oberon_open_scope(ctx);
+
+	oberon_type_t * signature;
+	if(ctx -> token == LPAREN)
+	{
+		signature = oberon_formal_pars(ctx);
+	}
+	else
+	{
+		signature = oberon_new_type_ptr(OBERON_TYPE_PROCEDURE);
+		signature -> num_decl = 0;
+		signature -> base = ctx -> void_type;
+		signature -> decl = NULL;
+		oberon_generator_init_type(ctx, signature);
+	}
+
+	oberon_object_t * proc;
+	proc = oberon_define_proc(this_proc_def_scope, name, signature);
+
+	ctx -> result_type = signature -> base;
+	ctx -> has_return = 0;
+
 	oberon_assert_token(ctx, SEMICOLON);
 
-	oberon_make_procedure_begin(ctx, name);
+	oberon_generate_begin_proc(ctx, proc);
+
+	// TODO declarations
+
 	if(ctx -> token == BEGIN)
 	{
 		oberon_assert_token(ctx, BEGIN);
 		oberon_statement_seq(ctx);
 	}
-	oberon_make_procedure_end(ctx);
 
 	oberon_assert_token(ctx, END);
 	char * name2 = oberon_assert_ident(ctx);
-
 	if(strcmp(name2, name) != 0)
 	{
 		oberon_error(ctx, "procedure name not matched");
 	}
+
+	if(signature -> base -> class == OBERON_TYPE_VOID)
+	{
+		oberon_make_return(ctx, NULL);
+	}
+
+	if(ctx -> has_return == 0)
+	{
+		oberon_error(ctx, "procedure requires return");
+	}
+	ctx -> result_type = NULL;
+
+	oberon_generate_end_proc(ctx);
+	oberon_close_scope(ctx -> decl);
+}
+
+static void
+oberon_const_decl(oberon_context_t * ctx)
+{
+	char * name;
+	oberon_item_t * value;
+	oberon_object_t * constant;
+
+	name = oberon_assert_ident(ctx);
+	oberon_assert_token(ctx, EQUAL);
+	value = oberon_const_expr(ctx);
+
+	constant = oberon_define_object(ctx -> decl, name, OBERON_CLASS_CONST);
+	constant -> value = value;
+}
+
+static void
+oberon_type_decl(oberon_context_t * ctx)
+{
+	char * name;
+	oberon_object_t * newtype;
+	oberon_type_t * type;
+
+	name = oberon_assert_ident(ctx);
+	oberon_assert_token(ctx, EQUAL);
+	type = oberon_type(ctx);
+
+	newtype = oberon_define_object(ctx -> decl, name, OBERON_CLASS_TYPE);
+	newtype -> type = type;
 }
 
 static void
 oberon_decl_seq(oberon_context_t * ctx)
 {
+	if(ctx -> token == CONST)
+	{
+		oberon_assert_token(ctx, CONST);
+		while(ctx -> token == IDENT)
+		{
+			oberon_const_decl(ctx);
+			oberon_assert_token(ctx, SEMICOLON);
+		}
+	}
+
+	if(ctx -> token == TYPE)
+	{
+		oberon_assert_token(ctx, TYPE);
+		while(ctx -> token == IDENT)
+		{
+			oberon_type_decl(ctx);
+			oberon_assert_token(ctx, SEMICOLON);
+		}
+	}
+
 	if(ctx -> token == VAR)
 	{
 		oberon_assert_token(ctx, VAR);
@@ -893,7 +1323,7 @@ oberon_decl_seq(oberon_context_t * ctx)
 		}
 	}
 
-	if(ctx -> token == PROCEDURE)
+	while(ctx -> token == PROCEDURE)
 	{
 		oberon_proc_decl(ctx);
 		oberon_assert_token(ctx, SEMICOLON);
@@ -903,42 +1333,14 @@ oberon_decl_seq(oberon_context_t * ctx)
 static void
 oberon_assign(oberon_context_t * ctx, oberon_expr_t * src, oberon_expr_t * dst)
 {
-	if(src -> result -> class != dst -> result -> class)
-	{
-		oberon_error(ctx, "incompatible assignment types");
-	}
-
-	if(dst -> result -> class == OBERON_TYPE_INTEGER)
-	{
-		if((dst -> result -> size) < (src -> result -> size))
-		{
-			oberon_error(ctx, "incompatible assignment type size");
-		}
-	}
-
+	oberon_autocast_to(ctx, src, dst -> result);
 	oberon_generate_assign(ctx, src, dst);
 }
 
 static void
 oberon_make_call(oberon_context_t * ctx, oberon_expr_t * desig)
 {
-	if(desig -> is_item == 0)
-	{
-		oberon_error(ctx, "expected item");
-	}
-
-	if(desig -> item.mode != MODE_CALL)
-	{
-		oberon_error(ctx, "expected mode CALL");
-	}
-
-	if(desig -> item.var -> class != OBERON_CLASS_PROC)
-	{
-		oberon_error(ctx, "only procedures can be called");
-	}
-
-	// TODO check arguments
-
+	oberon_autocast_call(ctx, desig);
 	oberon_generate_call_proc(ctx, desig);
 }
 
@@ -950,7 +1352,7 @@ oberon_statement(oberon_context_t * ctx)
 
 	if(ctx -> token == IDENT)
 	{
-		item1 = oberon_expr(ctx);
+		item1 = oberon_designator(ctx);
 		if(ctx -> token == ASSIGN)
 		{
 			oberon_assert_token(ctx, ASSIGN);
@@ -959,9 +1361,24 @@ oberon_statement(oberon_context_t * ctx)
 		}
 		else
 		{
+			item1 = oberon_opt_proc_parens(ctx, item1);
 			oberon_make_call(ctx, item1);
 		}
 	}
+	else if(ctx -> token == RETURN)
+	{
+		oberon_assert_token(ctx, RETURN);
+		if(ISEXPR(ctx -> token))
+		{
+			oberon_expr_t * expr;
+			expr = oberon_expr(ctx);
+			oberon_make_return(ctx, expr);
+		}
+		else
+		{
+			oberon_make_return(ctx, NULL);
+		}
+	}
 }
 
 static void
@@ -1010,40 +1427,16 @@ oberon_parse_module(oberon_context_t * ctx)
 //   LIBRARY
 // =======================================================================
 
-static oberon_type_t *
-oberon_new_type_ptr(int class)
-{
-	oberon_type_t * x = malloc(sizeof *x);
-	memset(x, 0, sizeof *x);
-	x -> class = class;
-	return x;
-}
-
-static oberon_type_t *
-oberon_new_type_integer(int size)
-{
-	oberon_type_t * x;
-	x = oberon_new_type_ptr(OBERON_TYPE_INTEGER);
-	x -> size = size;
-	return x;
-}
-
-static oberon_type_t *
-oberon_new_type_boolean(int size)
-{
-	oberon_type_t * x;
-	x = oberon_new_type_ptr(OBERON_TYPE_BOOLEAN);
-	x -> size = size;
-	return x;
-}
-
 static void
 register_default_types(oberon_context_t * ctx)
 {
-	ctx -> int_type = oberon_new_type_integer(sizeof(int));
-	ctx -> bool_type = oberon_new_type_boolean(sizeof(int));
+	ctx -> void_type = oberon_new_type_ptr(OBERON_TYPE_VOID);
+	oberon_generator_init_type(ctx, ctx -> void_type);
 
+	ctx -> int_type = oberon_new_type_integer(sizeof(int));
 	oberon_define_type(ctx -> world_scope, "INTEGER", ctx -> int_type);
+
+	ctx -> bool_type = oberon_new_type_boolean(sizeof(int));
 	oberon_define_type(ctx -> world_scope, "BOOLEAN", ctx -> bool_type);
 }