/* Typing for Ksi.
   Copyright (C) 2002 Michal Moskal (malekith@pld-linux.org)

This file is part of GCC.

GCC is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GCC is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GCC; see the file COPYING.  If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */


#include "ksi.h"
#include "ggc.h"

static void make_tydef(tree type, tree name, struct attr_info *ai)
{
	tree decl;
	
	if (ai->alias_set)
		TYPE_ALIAS_SET(type) = ai->alias_set;

	set_align(type, ai);

	if (ai->packed)
		TYPE_PACKED(type) = 1;

	decl = build_decl(TYPE_DECL, name, type);
	TYPE_NAME(type) = decl;

	pushdecl(decl);

	/* pushdecl() above has already copied DECL_NAME() to 
	 * DECL_KSI_NAME(). */
	if (ai->export_name)
		DECL_NAME(decl) = ai->export_name;
	
	TYPE_STUB_DECL(type) = decl;
	layout_type(type);
	
	rest_of_decl_compilation(decl, NULL, global_bindings_p(), 0);
}

/* (tyalias [ATTRS] (var TYPE NAME)) */
void parse_tyalias(void)
{
	struct term_state ctx;
	struct attr_info ai;
	tree type, copied_type, name;
	
	init_term(&ctx, kw_tyalias);
	maybe_attr_then_keyword(&ctx, &ai, ak_type, kw_var);
	parse_var(&type, &name);
	fini_term(&ctx);

	copied_type = copy_node(type);
	TYPE_MAIN_VARIANT(copied_type) = type;
	make_tydef(copied_type, name, &ai);
}

/* (abstract_type [ATTRS] name) */
void parse_abstract_type(void)
{
	static int last_abstract_type = 0;
	
	struct term_state ctx;
	struct attr_info ai;
	struct arg a;
	tree type;
	
	init_term(&ctx, kw_abstract_type);
	maybe_attr(&ctx, &ai, ak_type, arg_id, &a);
	fini_term(&ctx);

	type = copy_node(poly_type_node);

	/* Abstract type ain't polymorphic. */
	TYPE_POLYMORPHIC(type) = 0;
	
	TYPE_LANG_SPECIFIC(type) = ggc_alloc(sizeof(struct lang_type));
	TYPE_LANG_SPECIFIC(type)->abstract_type = ++last_abstract_type;
	
	make_tydef(type, get_identifier(a.u.val_id), &ai);
}

/* Check whatever given two types are equal or if allow_poly is set, 
 * if t1 < t2. */
void same_types_ex(keyword_t kw, tree t1, tree t2, int allow_poly)
{
	if (t1 == t2)
		return;
		
	if (TYPE_POLYMORPHIC(t1) && TYPE_POLYMORPHIC(t2))
		return;

	if (allow_poly && TYPE_POLYMORPHIC(t2))
		if (TYPE_PRECISION(t1) != TYPE_PRECISION(t2))
			fatal_error("value to be polymorphic has wrong "
				    "size");
		else
			return;
		
	if (TYPE_POLYMORPHIC(t1) || TYPE_POLYMORPHIC(t2))
		fatal_error("(%s ...) type clash (one of types is (poly))",
			    keyword_name(kw));
	
	if (TYPE_ABSTRACT_TYPE(t1) || TYPE_ABSTRACT_TYPE(t2)) {
		if (TYPE_ABSTRACT_TYPE(t1) == TYPE_ABSTRACT_TYPE(t2))
			return;
		else
			fatal_error("(%s ...) type clash -- different "
				    "abstract types", keyword_name(kw));
	}

	if (TREE_CODE(t1) != TREE_CODE(t2))
		fatal_error("(%s ...) type clash (different kinds)",
			    keyword_name(kw));
		
	switch (TREE_CODE(t1)) {
	case INTEGER_TYPE:
		if (!TREE_UNSIGNED(t1) != !TREE_UNSIGNED(t2))
			fatal_error("(%s ...) type clash (signedness)",
				    keyword_name(kw));
		/* fall */
	case REAL_TYPE:
		if (TYPE_PRECISION(t1) != TYPE_PRECISION(t2))
			fatal_error("(%s ...) type clash (type size)",
				    keyword_name(kw));
		break;
	case VOID_TYPE:
	case BOOLEAN_TYPE:
		/* always OK */
		break;
	case POINTER_TYPE:
		if (TREE_CODE(TREE_TYPE(t1)) == VOID_TYPE ||
		    TREE_CODE(TREE_TYPE(t2)) == VOID_TYPE)
		    	break;
		same_types_ex(kw, TREE_TYPE(t1), TREE_TYPE(t2), allow_poly);
		break;
	case REFERENCE_TYPE:
		same_types_ex(kw, TREE_TYPE(t1), TREE_TYPE(t2), allow_poly);
		break;
	case RECORD_TYPE:
	case UNION_TYPE:
	case ENUMERAL_TYPE:
		if (TYPE_MAIN_VARIANT(t1) != TYPE_MAIN_VARIANT(t2))
			fatal_error("(%s ...) type clash (different structure, "
				    "union or enum)", keyword_name(kw));
		break;
	
	case FUNCTION_TYPE:
		same_types_ex(kw, TREE_TYPE(t2), TREE_TYPE(t1), allow_poly);
		t1 = TYPE_ARG_TYPES(t1);
		t2 = TYPE_ARG_TYPES(t2);
		while (t1 && t2) {
			same_types_ex(kw, TREE_VALUE(t2), TREE_VALUE(t1), allow_poly);
			t1 = TREE_CHAIN(t1);
			t2 = TREE_CHAIN(t2);
		}
		if (t1 || t2)
			fatal_error("(%s ...) type clash (different number "
				    "of arguments to function)", 
				    keyword_name(kw));
		break;
		
	default:
		ice();
	}
}

void same_types(keyword_t kw, tree t1, tree t2)
{
	same_types_ex(kw, t1, t2, 0);
}

tree bool_type_node, poly_type_node;

/*
 * Return 1 if given keyword introduces type expression.
 */
int type_keyword(keyword_t kw)
{
	switch (kw) {
	case kw_int:
	case kw_uint:
	case kw_float:
	case kw_ptr:
	case kw_reference:
	case kw_void:
	case kw_bool:
	case kw_func_ptr:
	case kw_union:
	case kw_struct:
	case kw_tyref:
		return 1;
	default:
		return 0;
	}
}

/* (func_ptr TYPE PARMS) */
static tree parse_func_ptr(struct term_state *ctx)
{
	tree ret, list = NULL;
	struct list_state ltx;
	int halt = 0;
	
	ret = parse_type(get_keyword(ctx));

	expect_list(&ltx);

	while (!halt) {
		keyword_t kw;
		
		kw = get_keyword_from_list(&ltx);
	
		switch (kw) {
		case kw__error:
			list = tree_cons(NULL_TREE, void_type_node, list);
			halt++;
			break;
		case kw_ellipsis:
			arg0_term(kw);
			if ((kw = get_keyword_from_list(&ltx)) != kw__error)
				fatal_error("found (%s ...) after (ellipsis) "
					    "in parm list in (func_ptr ...)", 
					    keyword_name(kw));
			halt++;
			break;
		default:
			if (type_keyword(kw))
				list = tree_cons(NULL_TREE, 
						 parse_type(kw), 
						 list);
			else
				fatal_error("found (%s ...) where type "
					    "expression was expected in "
					    "(func_ptr ...)", 
					    keyword_name(kw));
			break;	
		}
	}

	fini_term(ctx);

	return build_pointer_type(build_function_type(ret, nreverse(list)));
}

/* TODO: types generally could be aligned and/or packed. Now we
 * only allow this for structures. This is wrong. 
 */ 
tree parse_type(keyword_t kw)
{
	struct term_state ctx;
	struct arg a;
	int size = 0;
	tree t, id;

	init_term(&ctx, kw);

	switch (kw) {
	case kw_bool:
	case kw_void:
		fini_term(&ctx);	/* 0 args */
		return kw == kw_bool ? bool_type_node : void_type_node;
		
	case kw_poly:
		fini_term(&ctx);
		return poly_type_node;
		
	case kw_int:
	case kw_uint:
	case kw_float:
		get_term_arg(&ctx, arg_int|arg_uint, &a);
		size = a.u.val_int.low;
		fini_term(&ctx);
		if (kw == kw_float) {
			switch (size) {
			case FLOAT_TYPE_SIZE:
				return float_type_node;
			case DOUBLE_TYPE_SIZE:
				return double_type_node;
			default:
				/* non-integer constant */
				if (size == LONG_DOUBLE_TYPE_SIZE)
					return long_double_type_node;
			    	fatal_error("float type cannot have %d bits", 
					    size);
				return NULL;
			}
		} else {
		       if (size != 8 && size != 16 && size != 32 && 
	        	   size != 64 && size != 128)
			    	fatal_error("int type cannot have %d bits", 
					    size);
			return type_for_size(size, kw == kw_uint);
		}
		
	case kw_ptr:
		t = parse_type(get_keyword(&ctx));
		fini_term(&ctx);
		return build_pointer_type(t);
		
	case kw_reference:
		t = parse_type(get_keyword(&ctx));
		fini_term(&ctx);
		return build_reference_type(t);
		
	case kw_struct:
	case kw_union:
		id = get_id(&ctx);
		t = lookup_type(id, kw == kw_struct ? RECORD_TYPE : UNION_TYPE);
		if (t == NULL)
			fatal_error("%s %s undefined",
				    kw == kw_struct ? "struct" : "union",
			            IDENTIFIER_POINTER(id));
		fini_term(&ctx);
		return TREE_TYPE(t);
		
	case kw_tyref:
		id = get_id(&ctx);
		t = lookup_type(id, TYPE_DECL);
		if (t == NULL)
			fatal_error("tyalias or abstract type `%s' undefined",
			            IDENTIFIER_POINTER(id));
		fini_term(&ctx);
		return TREE_TYPE(t);
		
	case kw_func_ptr:
		return parse_func_ptr(&ctx);
		
	default:
		fatal_error("(%s ...) is not valid type expression",
			    keyword_name(kw));
		return NULL;
	}
}

void parse_enumdef(void)
{
	struct term_state ctx, etx;
	struct list_state ltx;
	tree enum_type, decl;
	tree chain = NULL_TREE, id, val;
	tree minnode = NULL_TREE, maxnode = NULL_TREE;
	struct arg a;
	keyword_t kw;

	enum_type = make_node(ENUMERAL_TYPE);
	decl = build_decl(TYPE_DECL, NULL_TREE, enum_type);
	TYPE_STUB_DECL(enum_type) = decl;
	pushdecl(decl);
		
	init_term(&ctx, kw_enumdef);
	expect_list(&ltx);

	while ((kw = get_keyword_from_list(&ltx)) != kw__error) {
		if (kw != kw_entry)
			fatal_error("found (%s ...) where (entry ...) was "
				    "expected", keyword_name(kw));
		init_term(&etx, kw_entry);
		id = get_id(&etx);
		get_term_arg(&etx, arg_int|arg_uint, &a);
		val = build_int_2(a.u.val_int.low, a.u.val_int.high);
		TREE_TYPE(val) = enum_type;
		fini_term(&etx);

		if (IDENTIFIER_ENUM_VALUE(id))
			fatal_error("enumerator `%s' redefined",
				    IDENTIFIER_POINTER(id));
		IDENTIFIER_ENUM_VALUE(id) = val;

		chain = tree_cons(id, val, chain);

		if (maxnode == NULL_TREE || tree_int_cst_lt (maxnode, val))
			maxnode = val;
		if (minnode == NULL_TREE || tree_int_cst_lt (val, minnode))
			minnode = val;
	}

	fini_term(&ctx);

	TYPE_MIN_VALUE(enum_type) = minnode;
	TYPE_MAX_VALUE(enum_type) = maxnode;
	TYPE_PRECISION(enum_type) = POINTER_SIZE;
	TREE_UNSIGNED(enum_type) = tree_int_cst_sgn(minnode) >= 0;
	TYPE_SIZE(enum_type) = 0;
	TYPE_VALUES(enum_type) = chain;
	layout_type(enum_type);

	rest_of_type_compilation(enum_type, global_bindings_p());
}
