/* %Z%%M% %I% %E% */

/*
 * Copyright (c) 1992, 1993, 1994, 1995, 2000 by Wayne C. Gramlich.
 * All rights reserved.
 *
 * Permission to use, copy, modify, distribute, and sell this software
 * for any purpose is hereby granted without fee provided that the above
 * copyright notice and this permission are retained.  The author makes
 * no representations about the suitability of this software for any purpose.
 * It is provided "as is" without express or implied warranty.
 */

/*
 * This file contains code to generate the routines associated with a
 * generate clause:
 */

#ifndef FLAGS_DEFS_H
#include "flags_defs.h"
#endif

#ifndef GEN_DEFS_H
#include "gen_defs.h"
#endif

#ifndef GENERATE_DEFS_H
#include "generate_defs.h"
#endif

#ifndef HEAP_EXPORTS_H
#include "heap_exports.h"
#endif

#ifndef LINT_H
#include "lint.h"
#endif

#ifndef NEED_EXPORTS_H
#include "need_exports.h"
#endif

#ifndef ROUTINE_DEFS_H
#include "routine_defs.h"
#endif

#ifndef STR_EXPORTS_H
#include "str_exports.h"
#endif

#ifndef STRVEC_EXPORTS_H
#include "strvec_exports.h"
#endif

#ifndef TABLE_EXPORTS_H
#include "table_exports.h"
#endif

#ifndef TYPE_DEFS_H
#include "type_defs.h"
#endif

#ifndef VECTOR_DEFS_H
#include "vector_defs.h"
#endif

#ifndef UNIX_ASSERT_H
#include "unix_assert.h"
#endif

#ifndef UNIX_CTYPE_H
#include "unix_ctype.h"
#endif

#ifndef UNIX_UNISTD_H
#include "unix_unistd.h"
#endif

LOCAL void	type_def_access_gen(Type_def, Generate, Gen);
LOCAL void	type_address_get_gen(Type_def, Generate, Gen);
LOCAL void	type_def_new_gen(Type_def, Generate, Gen);
LOCAL int	type_opt_base_types(Str, Gen);

/*
 * type_def_access_gen(type_def, gen)
 *	This routine will generate the access routines for "type_def"
 *	"type_def" using "gen".
 */
/* ARGSUSED */
LOCAL void
type_def_access_gen(
	Type_def	type_def,
	Generate	generate,
	Gen		gen)
{
	int		is_parameterized;
	static Strvec	routine_strvec = (Strvec)0;
	Str		type_name;

	if (routine_strvec == (Strvec)0) {
		routine_strvec = strvec_create(gen->heap);
	}
	is_parameterized = type_ref_is_parameterized(type_def->type_ref);
	type_name = type_def->name;
	switch (type_def->kind) {
	    case Type_kind_record:
	      {
		Type_field	field;
		Str		field_name;
		Str		field_type;
		Type_fields	fields;
		Str		name;
		int		is_parameter;

		fields = type_def->value.record->fields;
		VEC_LOOP(Type_field, fields, field) {
			/* Generate the get routine: */
			field_name = field->name;
			field_type = field->type_ref->name;
			name = type_translate(field_type, gen->heap);
			is_parameter = type_ref_is_parameter(field->type_ref);
			if (is_parameter) {
				gen_out(gen, "void *");
			} else {
				gen_out(gen, "%s ", name);
			}
			gen_out(gen, "%s__%s_get(", type_name, field_name);
			gen_out(gen, "%T %s", type_name, type_name);
			if (is_parameterized > 0) {
				gen_out(gen, ", void *_block_");
			}
			gen_out(gen, ")\n");
			gen_out(gen, "{\n");
			gen_out(gen, "%\treturn %s->%s;\n",
				1, type_name, field_name);
			gen_out(gen, "}\n");
			gen_out(gen, "\n");

			/* Generate the set routine: */
			gen_out(gen, "void %s__%s_set(%T %s, ",
				type_name, field_name, type_name, type_name);
			if (is_parameter) {
				gen_out(gen, "void *%S", field_name);
			} else if (type_opt_base_types(field_type, gen)) {
				gen_out(gen, "%s %S", name, field_name);
			} else {
				gen_out(gen, "%T %S", field_type, field_name);
			}
			if (is_parameterized > 0) {
				gen_out(gen, ", void *_block_");
			}
			gen_out(gen, ")\n");
			gen_out(gen, "{\n");
			gen_out(gen, "%\t%s->%S = %S;\n", 1,
				type_name, field_name, field_name);
			gen_out(gen, "}\n");
			gen_out(gen, "\n");
		}
		break;
	      }
	    case Type_kind_variant:
	      {
		Type_field	field;
		Str		field_name;
		Str		field_type;
		Type_fields	fields;
		Type_field	tag_field;
		Str		tag_field_name;
		Str		tag_field_type;
		Type_variant	variant;

		variant = type_def->value.variant;

		/* Generate tag field access routine: */
		tag_field = variant->tag_field;
		tag_field_name = tag_field->name;
		tag_field_type = tag_field->type_ref->name;
		gen_out(gen, "%T %s__%s_get(%T %s%s)\n",
			tag_field_type, type_name, tag_field_name,
			type_name, type_name,
			is_parameterized ? ", void *_block_" : "");
		gen_out(gen, "{\n");
		gen_out(gen, "%\treturn %s->_tag_.%s;\n",
			1, type_name, tag_field_name);
		gen_out(gen, "}\n");
		gen_out(gen, "\n");

		fields = variant->fields;
		VEC_LOOP(Type_field, fields, field) {
			/* Generate the get routine: */
			field_name = field->name;
			field_type = field->type_ref->name;
			gen_out(gen, "%T %s__%s_get(%T %s%s)\n",
				field_type, type_name, field_name,
				type_name, type_name,
				is_parameterized ? ", void *_block_" : "");
			gen_out(gen, "{\n");

			/* Output local variable: */
			gen_out(gen, "%\tunion %s___variant _temp_;\n",
				1, type_name);
			gen_out(gen, "\n");

			/* Output the statements: */
			gen_out(gen, "%\t_temp_._entire_ = %s->_entire_;\n",
				1, type_name);
			gen_out(gen,
				"%\tif (_temp_._tag_.%S != %s__item__%s) {\n",
				1, tag_field_name, tag_field_type, field_name);
			gen_out(gen, "%\trun__time__signal(%\");\n",
				2, "Bad tag");
			gen_out(gen, "%\t}\n", 1);
			gen_out(gen, "%\treturn _temp_.%S;\n", 1, field_name);
			gen_out(gen, "}\n");
			gen_out(gen, "\n");

			/* Generate the set routine: */
			field_name = field->name;
			field_type = field->type_ref->name;
			gen_out(gen, "void %s__%s_set(%T %s, %s %S %s)\n",
				type_name, field_name, type_name, type_name,
				type_translate(field_type, gen->heap),
				field_name,
				is_parameterized ? ", void *_block" : "");
			gen_out(gen, "{\n");

			/* Output local variable: */
			gen_out(gen, "%\tunion %s___variant _temp_;\n",
				1, type_name);
			gen_out(gen, "\n");

			/* Output the statements: */
			gen_out(gen, "%\t_temp_._tag_.%S = %s__item__%s;\n",
				1, tag_field_name,
				tag_field_type, field_name);
			gen_out(gen, "%\t_temp_.%S = %S;\n",
				1, field_name, field_name);
			gen_out(gen, "%\t%s->_entire_ = _temp_._entire_;\n",
				1, type_name);

			gen_out(gen, "}\n");
			gen_out(gen, "\n");
		}
		break;
	      }
	}
}

/*
 * type_def_address_get_gen(type_def, gen)
 *	This routine will generate the address_get routine for "type_def"
 *	using "gen".
 */
/* ARGSUSED */
LOCAL void
type_def_address_get_gen(
	Type_def	type_def,
	Generate	generate,
	Gen		gen)
{
	Str		type_name;

	type_name = type_def->name;
	gen_out(gen, "void *%s__address_get(%T %s1",
		type_name, type_name, type_name);
	if (type_ref_is_parameterized(type_def->type_ref) > 0) {
		gen_out(gen, ", void *_block_");
	}
	gen_out(gen, ")\n");
	gen_out(gen, "{\n");
	gen_out(gen, "%\treturn (void *)%s1;\n", 1, type_name);
	gen_out(gen, "}\n");
	gen_out(gen, "\n");
}

/*
 * type_def_new_gen(type_def, gen)
 *	This routine will generate the new routine for "type_def"
 *	using "gen".
 */
/* ARGSUSED */
LOCAL void
type_def_allocate_gen(
	Type_def	type_def,
	Generate	generate,
	Gen		gen)
{
	Str		type_name;

	type_name = type_def->name;
	gen_out(gen, "%T %s__allocate__helper(void",
		type_name, type_name);
	if (type_ref_is_parameterized(type_def->type_ref)) {
		gen_out(gen, " *_block_");
	}
	gen_out(gen, ")\n");
	gen_out(gen, "{\n");
	switch (type_def->kind) {
	    case Type_kind_enumeration:
	      {
		Type_item	item;
		Vec(Type_item)	items;

		items = type_def->value.enumeration->items;
		item = vec_fetch(Type_item, items, 0);
		gen_out(gen, "%\treturn %s__item__%s;\n",
			1, type_name, item->name);
		break;
	      }
	    case Type_kind_record:
	    case Type_kind_variant:
		gen_out(gen, "%\textern void *malloc(unsigned int);\n", 1);
		gen_out(gen, "%\t%T %s;\n", 1, type_name, type_name);
		gen_out(gen, "\n");
		gen_out(gen, "%\t%s = (%T)malloc(sizeof(*%s));\n",
			1, type_name, type_name, type_name);
		gen_out(gen, "%\treturn %s;\n", 1, type_name);
		break;
	    default:
		assert(gen != gen);
	}
	gen_out(gen, "}\n");
	gen_out(gen, "\n");
}

/*
 * type_def_equal_gen(type_def, gen)
 *	This routine will generate the equal routine for "type_def"
 *	using "gen".
 */
/* ARGSUSED */
LOCAL void
type_def_equal_gen(
	Type_def	type_def,
	Generate	generate,
	Gen		gen)
{
	Str		type_name;

	type_name = type_def->name;
	gen_out(gen, "int %s__equal(%T %s1, %T %s2",
		type_name, type_name, type_name, type_name, type_name);
	if (type_ref_is_parameterized(type_def->type_ref) > 0) {
		gen_out(gen, ", void *_block_");
	}
	gen_out(gen, ")\n");
	gen_out(gen, "{\n");
	switch (type_def->kind) {
	    case Type_kind_enumeration:
		gen_out(gen, "%\treturn %s1 == %s2;\n",
			1, type_name, type_name);
		break;
	    case Type_kind_record:
	      {
		Type_field	field;
		Str		field_name;
		Type_fields	fields;
		int		index;
		Str		name;
		int		size;

		fields = type_def->value.record->fields;
		size = vec_size(Type_field, fields);
		for (index = 0; index < size; index++) {
			field = vec_fetch(Type_field, fields, index);
			field_name = field->name;
			if (index == 0) {
				gen_out(gen, "%\treturn ", 1);
			} else {
				gen_out(gen, "%\t", 2);
			}

			name = field->type_ref->name;
			if (type_opt_base_types(name, gen)) {
				gen_out(gen, "(%s1->%s == %s2->%s)",
					type_name, field_name,
					type_name, field_name);
			} else {
				gen_out(gen, "%s__equal(%s1->%s, %s2->%s)",
					name, type_name, field_name,
					type_name, field_name);
			}

			if (index + 1 == size) {
				gen_out(gen, ";\n");
			} else {
				gen_out(gen, " &&\n");
			}
		}
		break;
	      }
	    case Type_kind_variant:
	      {
		Type_field	field;
		Str		field_name;
		Str		field_type;
		Type_fields	fields;
		Type_field	tag_field;
		Str		tag_field_type;
		Type_variant	variant;

		/* Output the local variable: */
		variant = type_def->value.variant;
		tag_field = variant->tag_field;
		tag_field_type = tag_field->type_ref->name;
		gen_out(gen, "%\t%T _tag_;\n", 1, tag_field_type);
		gen_out(gen, "\n");

		/* Output the if statement: */
		gen_out(gen, "%\t_tag_ = %s1->_tag_.%s;\n",
			1, type_name, tag_field->name);
		gen_out(gen, "%\tif (_tag_ != %s2->_tag_.%s) {\n",
			1, type_name, tag_field->name);
		gen_out(gen, "%\treturn 0;\n", 2);
		gen_out(gen, "%\t}\n", 1);

		/* Output the switch statement: */
		gen_out(gen, "%\tswitch (_tag_) {\n", 1);
		fields = variant->fields;
		VEC_LOOP(Type_field, fields, field) {
			field_name = field->name;
			field_type = field->type_ref->name;
			gen_out(gen, "%\tcase %s__item__%s:\n",
				1, tag_field_type, field_name);
			if (type_opt_base_types(field_type, gen)) {
				gen_out(gen,
					"%\treturn %s1->%s == %s2->%s;\n",
					2, type_name, field_name,
					type_name, field_name);
			} else {
				gen_out(gen,
					"%\treturn %s__equal(%s1->%s, "
					"%s2->%s);\n",
					2, field_type, type_name, field_name,
					type_name, field_name);
			}
		}
		gen_out(gen, "%\t}\n", 1);
		break;
	      }
	    default:
		assert(gen != gen);
	}
	gen_out(gen, "}\n");
	gen_out(gen, "\n");
}

/*
 * type_def_identical_gen(type_def, gen)
 *	This routine will generate the identical routine for "type_def"
 *	using "gen".
 */
/* ARGSUSED */
LOCAL void
type_def_identical_gen(
	Type_def	type_def,
	Generate	generate,
	Gen		gen)
{
	Str		type_name;

	type_name = type_def->name;
	gen_out(gen, "int %s__identical(%T %s1, %T %s2",
		type_name, type_name, type_name, type_name, type_name);
	if (type_ref_is_parameterized(type_def->type_ref) > 0) {
		gen_out(gen, ", void *_block_");
	}
	gen_out(gen, ")\n");
	gen_out(gen, "{\n");
	gen_out(gen, "%\treturn %s1 == %s2;\n", 1, type_name, type_name);
	gen_out(gen, "}\n");
	gen_out(gen, "\n");
}

/*
 * type_def_initial_object_gen(type_def, gen)
 *	This routine will generate the initial object(s) for "type_def"
 *	using "gen".
 */
void
type_def_initial_object_gen(
	Type_def	type_def,
	Gen		gen)
{
	Str		type_name;

	type_name = type_def->name;
	switch (type_def->kind) {
	    case Type_kind_enumeration:
	      {
		int		index;
		Type_item	item;
		Str		item_name;
		Vec(Type_item)	items;
		int		size;

		items = type_def->value.enumeration->items;
		size = vec_size(Type_item, items);
		for (index = 0; index < size; index++) {
			item = vec_fetch(Type_item, items, index);
			item_name = item->name;
			if (index == 0) {
				gen_out(gen,
					"%T %s___initial = %s__item__%s;\n",
					type_name, type_name,
					type_name, item_name);
				gen_out(gen, "%T %s__first = %s__item__%s;\n",
					type_name, type_name,
					type_name, item_name);
			}
			gen_out(gen, "%T %s__%s = %s__item__%s;\n",
				type_name, type_name, item_name,
				type_name, item_name);
			if (index + 1 == size) {
				gen_out(gen, "%T %s__last = %s__item__%s;\n",
					type_name, type_name,
					type_name, item_name);
			}
		}
		gen_out(gen, "int %s__enumeration__size = %d;\n",
			type_name, size);
		break;
	      }
	    case Type_kind_record:
		gen_out(gen,
			"struct %s___record %I_object;\n",
			type_name, type_name);
		gen_out(gen, "%T %I = &%s___initial_object;\n",
			type_name, type_name, type_name);
		break;
	    case Type_kind_variant:
		gen_out(gen,
			"union %s___variant %I_object;\n",
			type_name, type_name);
		gen_out(gen, "%T %I = &%s___initial_object;\n",
			type_name, type_name, type_name);
		break;
	}
}

/*
 * type_def_new_gen(type_def, gen)
 *	This routine will generate the new routine for "type_def"
 *	using "gen".
 */
/* ARGSUSED */
LOCAL void
type_def_new_gen(
	Type_def	type_def,
	Generate	generate,
	Gen		gen)
{
	Str		type_name;

	type_name = type_def->name;
	gen_out(gen, "%T %s__new__helper(%T _heap_",
		type_name, type_name, "heap");
	if (type_ref_is_parameterized(type_def->type_ref)) {
		gen_out(gen, ", void *_block_");
	}
	gen_out(gen, ")\n");
	gen_out(gen, "{\n");
	switch (type_def->kind) {
	    case Type_kind_enumeration:
	      {
		Type_item	item;
		Vec(Type_item)	items;

		items = type_def->value.enumeration->items;
		item = vec_fetch(Type_item, items, 0);
		gen_out(gen, "%\treturn %s__item__%s;\n",
			1, type_name, item->name);
		break;
	      }
	    case Type_kind_record:
	    case Type_kind_variant:
		gen_out(gen, "%\t%T %s;\n", 1, type_name, type_name);
		gen_out(gen, "\n");
		gen_out(gen, "%\t%s = (%T)heap_alloc(_heap_, sizeof(*%s));\n",
				1, type_name, type_name, type_name);
		gen_out(gen, "%\treturn %s;\n", 1, type_name);
		break;
	    default:
		assert(gen != gen);
	}
	gen_out(gen, "}\n");
	gen_out(gen, "\n");
}

/*
 * type_def_routines_gen(type_def, gen)
 *	This routine will generate all of the access routines for "type_def"
 *	using "gen".
 */
void
type_def_routines_gen(
	Type_def	type_def,
	Gen		gen)
{
	Generate	generate;
	Vec(Generate) generates;

	generates = type_def->generates;
	switch (type_def->kind) {
	    case Type_kind_enumeration:
		VEC_LOOP(Generate, generates, generate) {
			switch (generate->kind) {
			    case Generate_address_get:
				break;
			    case Generate_allocate:
				break;
			    case Generate_copy:
				break;
			    case Generate_equal:
				type_def_equal_gen(type_def, generate, gen);
				break;
			    case Generate_hash:
				break;
			    case Generate_identical:
				type_def_identical_gen(type_def, generate, gen);
				break;
			    case Generate_input:
				break;
			    case Generate_integer_convert:
				break;
			    case Generate_new:
				break;
			    case Generate_output:
				break;
			    case Generate_print:
				break;
			    case Generate_save:
				break;
			    case Generate_unsigned_convert:
				break;
			    default:
				assert_fail();
			}
		}
		break;
	    case Type_kind_record:
	    case Type_kind_variant:
		type_def_access_gen(type_def, generate, gen);
		VEC_LOOP(Generate, generates, generate) {
			switch (generate->kind) {
			    case Generate_address_get:
				type_def_address_get_gen(type_def,
							 generate, gen);
				break;
			    case Generate_allocate:
				type_def_allocate_gen(type_def, generate, gen);
				break;
			    case Generate_copy:
				break;
			    case Generate_erase:
				break;
			    case Generate_equal:
				break;
			    case Generate_hash:
				break;
			    case Generate_identical:
				type_def_identical_gen(type_def, generate, gen);
				break;
			    case Generate_input:
				break;
			    case Generate_integer_convert:
				break;
			    case Generate_new:
				type_def_new_gen(type_def, generate, gen);
				break;
			    case Generate_output:
				break;
			    case Generate_print:
				break;
			    case Generate_save:
				break;
			    case Generate_unsigned_convert:
				break;
			    default:
				assert_fail();
			}
		}
		break;
	    case Type_kind_external:
		break;
	    default:
		assert_fail();
	}
}

/*
 * type_opt_base_types(type_name, gen)
 *	This routine will return 1 if "type_name" is an integer base type
 *	and "gen"->flags->opt_base_types is enabled.  Otherwise, 0 is
 *	returned.
 */
LOCAL int
type_opt_base_types(
	Str		type_name,
	Gen		gen)
{
	return (gen->flags->opt_base_types && 
		(strequal(type_name, "integer") ||
		 strequal(type_name, "unsigned") ||
		 strequal(type_name, "logical") ||
		 strequal(type_name, "character")));
}