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

/*
 * Copyright (c) 1992, 1993, 1995 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 the routines for manipulating Type_proto's, Type_need's,
 * and Type_signal's:
 */

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

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

#ifndef LIBC_EXPORTS_H
#include "libc_exports.h"
#endif

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

#ifndef OUT_EXPORTS_H
#include "out_exports.h"
#endif

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

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

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

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

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

#ifndef UNIX_STDLIB_H
#include "unix_stdlib.h"
#endif

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

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

LOCAL int		type_need_compare(Type_need, Type_need, int);
LOCAL int		type_need_equal(Type_need, Type_need);
LOCAL int		type_need_hash(Type_need);
LOCAL Type_need	type_need_read(Stdio, Heap, Type_tables);
LOCAL Type_need	type_need_replace(Type_need, Type_refs,
					  Type_refs, Type_tables);
LOCAL void		type_need_write(Type_need, Stdio, Type_tables);

LOCAL int		type_needs_compare(Type_needs, Type_needs, int);
LOCAL int		type_needs_equal(Type_needs, Type_needs);
LOCAL int		type_needs_hash(Type_needs);
LOCAL void		type_needs_print(Type_needs, int, Stdio);
LOCAL Type_needs	type_needs_read(Stdio, Heap, Type_tables);
LOCAL Type_needs	type_needs_replace(Type_needs, Type_refs,
					       Type_refs, Type_tables);
LOCAL void		type_needs_write(Type_needs, Stdio, Type_tables);

LOCAL int		type_proto_equal(Type_proto, Type_proto);
LOCAL int		type_proto_hash(Type_proto);

LOCAL int		type_signal_compare(Type_signal, Type_signal, int);
LOCAL int		type_signal_equal(Type_signal, Type_signal);
LOCAL int		type_signal_hash(Type_signal);
LOCAL void		type_signal_needed(Type_signal, Type_tables);
LOCAL void		type_signal_print(Type_signal, Stdio);
LOCAL Type_signal	type_signal_read(Stdio, Heap, Type_tables);
LOCAL Type_signal	type_signal_replace(Type_signal, Type_refs,
					    Type_refs, Type_tables);
LOCAL void		type_signal_write(Type_signal, Stdio, Type_tables);

LOCAL int		type_signals_compare(Type_signals, Type_signals, int);
LOCAL int		type_signals_equal(Type_signals, Type_signals);
LOCAL int		type_signals_hash(Type_signals);
LOCAL void		type_signals_needed(Type_signals, Type_tables);
LOCAL void		type_signals_print(Type_signals, int, Stdio);
LOCAL Type_signals	type_signals_read(Stdio, Heap, Type_tables);
LOCAL Type_signals	type_signals_replace(Type_signals, Type_refs,
					     Type_refs, Type_tables);
LOCAL void		type_signals_write(Type_signals, Stdio, Type_tables);


LOCAL Type_needs	type_needs_table_lookup(Type_need_table);
LOCAL Type_signals	type_signals_table_lookup(Type_signal_table);

/*
 * Type_need routines:
 */

/*
 * type_need_compare(type_need1, type_need2, zilch)
 *	This routine will return -1, 0, or 1 depending upon whether
 *	"type_need1" is less than, equal to, or greater than "type_need2".
 */
/* ARGSUSED */
int
type_need_compare(
	Type_need	type_need1,
	Type_need	type_need2,
	int		zilch)
{
	int		result;

	result = strcmp(type_need1->type_ref->name,
			type_need2->type_ref->name);
	if (result != 0) {
		return result;
	}
	return strcmp(type_need1->name, type_need2->name);
}

/*
 * type_need_create(type_ref, name, proto, type_tables)
 *	This routine will create and return a new type need object
 *	consisting of, "type_ref", "name", and "proto" using "type_tables".
 */
Type_need
type_need_create(
	Type_ref	type_ref,
	Str		name,
	Type_proto	proto,
	Type_tables	type_tables)
{
	Type_need	need_key;
	Table(Type_need, Type_need) need_table;
	Type_need	type_need;
	Type_need_table	type_need_table;

	type_need_table = type_tables->type_need_table;
	need_table = type_need_table->need_table;
	need_key = type_need_table->need_key;
	need_key->name = name;
	need_key->type_ref = type_ref;
	need_key->proto = proto;
	type_need = table_lookup(Type_need, Type_need,
				 need_table, need_key);
	if (type_need == (Type_need)0) {
		type_need = heap_allocate(type_need_table->heap, Type_need);
		type_need->type_ref = type_ref;
		type_need->name = name;
		type_need->proto = proto;
		assert(table_insert(Type_need, Type_need,
				    need_table, type_need, type_need) == 0);
	}
	return type_need;
}

/*
 * type_need_equal(type_need1, type_need2)
 *	This routine will return 1 if "type_need1" equals "type_need2" and
 *	0 otherwise.
 */
int
type_need_equal(
	Type_need		type_need1,
	Type_need		type_need2)
{
	return (type_ref_equal(type_need1->type_ref, type_need2->type_ref) &&
		strequal(type_need1->name, type_need2->name) &&
		type_proto_equal(type_need1->proto, type_need2->proto));
}

/*
 * type_need_hash(type_need)
 *	This routine will return a hash value for "type_need".
 */
int
type_need_hash(
	Type_need	type_need)
{
	return (type_ref_hash(type_need->type_ref) +
		strhash(type_need->name) +
		type_proto_hash(type_need->proto));
}

/*
 * type_need_print(type_need, indent, out_file)
 *	This routine will print "type_need" to "out_file".
 */
void
type_need_print(
	Type_need	type_need,
	int		indent,
	Stdio		out_file)
{
	out(out_file, "%\t%s%@ ", indent, type_need->name, type_need->type_ref);
	type_proto_print(type_need->proto, indent + 1, out_file);
}

/*
 * type_need_read(in_file, heap, type_tables)
 *	This routine will read in and return a Type_need from "in_file" using
 *	"heap".
 */
Type_need
type_need_read(
	Stdio		in_file,
	Heap		heap,
	Type_tables	type_tables)
{
	Str		name;
	Type_proto	type_proto;
	Type_ref	type_ref;
	Type_need	type_need;

	out_marker_read(in_file, "type_need");
	type_ref = type_ref_read(in_file, heap, type_tables);
	name = strread(in_file, heap);
	type_proto = type_proto_read(in_file, heap, type_tables);
	type_need = type_need_create(type_ref, name, type_proto, type_tables);
	return type_need;
}

/*
 * type_need_replace(old_type_need, old_type_refs, new_type_refs, type_tables)
 *	This routine will replace all occurances of "old_type_refs" with
 *	"new_type_refs" in "old_type_need" and return the new Type_need object.
 */
Type_need
type_need_replace(
	Type_need	old_type_need,
	Type_refs	old_type_refs,
	Type_refs	new_type_refs,
	Type_tables	type_tables)
{
	return type_need_create(type_ref_replace(old_type_need->type_ref,
						 old_type_refs,
						 new_type_refs,
						 type_tables),
				old_type_need->name,
				type_proto_replace(old_type_need->proto,
						   old_type_refs,
						   new_type_refs,
						   type_tables),
				type_tables);
}

/*
 * type_need_write(type_need, out_file, type_tables)
 *	This routine will write "type_need" to "out_file".
 */
void
type_need_write(
	Type_need	type_need,
	Stdio		out_file,
	Type_tables	type_tables)
{
	out_marker_write(out_file, "type_need");
	type_ref_write(type_need->type_ref, out_file, type_tables);
	(void)strwrite(type_need->name, out_file);
	type_proto_write(type_need->proto, out_file, type_tables);
}

/*
 * type_need_table_create(type_ref_table, heap)
 *	This routine will create and return a new prototype table.
 */
/* ARGSUSED */
Type_need_table
type_need_table_create(
	Type_ref_table	type_ref_table,
	Heap		heap)
{
	Type_need_table type_need_table;

	type_need_table = heap_allocate(heap, Type_need_table);
	type_need_table->heap = heap;
	type_need_table->need_key = heap_allocate(heap, Type_need);
	type_need_table->need_table = table_create(Type_need, Type_need, 50,
						   type_need_equal,
						   type_need_hash,
						   (Type_need)0,
						   heap);
	type_need_table->needs_table = table_create(Type_needs, Type_needs, 50,
						    type_needs_equal,
						    type_needs_hash,
						    (Type_needs)0,
						    heap);
	type_need_table->needs_key = vec_create(Type_need, heap);
	type_need_table->needs_empty = type_needs_table_lookup(type_need_table);
	return type_need_table;
}

/*
 * type_need_table_dump(type_need_table, out_file)
 *	This routine will dump the contents of "type_need_table" to
 *	"out_file" in human readable format.
 */
void
type_need_table_dump(
	Type_need_table type_need_table,
	Stdio		out_file)
{
	Type_need	type_need;
	Vec(Type_need)	type_need_list;
	Type_needs	type_needs;
	Vec(Type_needs)	type_needs_list;

	type_need_list = table_value_list_extract(Type_need, Type_need,
						  type_need_table->need_table);
	vec_sort(Type_need, type_need_list, type_need_compare, 0);
	out(out_file, "Type Need Table:\n");
	if (vec_empty(Type_need, type_need_list)) {
		out(out_file, "<Empty>\n");
	} else {
		VEC_LOOP(Type_need, type_need_list, type_need) {
			type_need_print(type_need, 0, out_file);
		}
	}
	out(out_file, "\n");

	type_needs_list = table_value_list_extract(Type_needs, Type_needs,
						type_need_table->needs_table);
	out(out_file, "Type Need List Table:\n");
	VEC_LOOP(Type_needs, type_needs_list, type_needs) {
		out(out_file, "----\n");
		type_needs_print(type_needs, 0, out_file);
	}
	out(out_file, "--------\n");
	out(out_file, "\n");
}

/*
 * Type_needs routines:
 */

/*
 * type_needs_append(type_needs, type_need, type_tables)
 *	This routine will return a new type needs list that consists of
 *	"type_needs" appended wity "type_need" allocated from "type_tables".
 */
Type_needs
type_needs_append(
	Type_needs	type_needs,
	Type_need	type_need,
	Type_tables	type_tables)
{
	Type_needs	needs_key;
	Type_need_table	type_need_table;

	type_need_table = type_tables->type_need_table;
	needs_key = type_need_table->needs_key;
	assert(vec_empty(Type_need, needs_key));
	vec_vec_append(Type_need, needs_key, type_needs);
	vec_append(Type_need, needs_key, type_need);
	type_needs = type_needs_table_lookup(type_need_table);
	return type_needs;
}

/*
 * type_needs_compare(type_needs1, type_needs2, zilch)
 *	This routine will return <0, =0, >0, depending upon whether
 *	"type_needs1" is smaller, equal to, or greater than "type_needs2".
 */
/* ARGSUSED */
int
type_needs_compare(
	Type_needs	type_needs1,
	Type_needs	type_needs2,
	int		zilch)
{	
	int		index;
	int		result;
	int		size1;
	int		size2;
	Type_need	type_need1;
	Type_need	type_need2;

	size1 = vec_size(Type_need, type_needs1);
	size2 = vec_size(Type_need, type_needs2);
	result = size1 - size2;
	if (result != 0) {
		return result;
	}
	for (index = 0; index < size1; index++) {
		type_need1 = vec_fetch(Type_need, type_needs1, index);
		type_need2 = vec_fetch(Type_need, type_needs2, index);
		result = type_need_compare(type_need1, type_need2, 0);
		if (result != 0) {
			return result;
		}
	}
	return 0;
}

/*
 * type_needs_empty_create(type_tables)
 *	This routine will return an empty type needs list.
 */
Type_needs
type_needs_empty_create(
	Type_tables	type_tables)
{
	return type_tables->type_need_table->needs_empty;
}

/*
 * type_needs_equal(type_needs1, type_needs2)
 *	This routine will return 1 if "type_needs1" is equal to "type_needs2"
 *	and 0 otherwise.
 */
int
type_needs_equal(
	Type_needs	type_needs1,
	Type_needs	type_needs2)
{
	return (type_needs_compare(type_needs1, type_needs2, 0) == 0);
}

/*
 * type_needs_hash(type_needs)
 *	This routine will return a hash value for "type_needs".
 */
int
type_needs_hash(
	Type_needs	type_needs)
{
	int		hash;
	Type_need	type_need;

	hash = 0;
	VEC_LOOP(Type_need, type_needs, type_need) {
		hash += type_need_hash(type_need);
	}
	return hash;
}

/*
 * type_needs_is_empty(type_needs)
 *	This routine will return 1 if "type_needs" is empty and 0 otherwise.
 */
int
type_needs_is_empty(
	Type_needs	type_needs)
{
	return vec_empty(Type_need, type_needs);
}

/*
 * type_needs_print(type_needs, indent, out_file)
 *	This routine will print "type_needs" to "out_file" indented by "indent".
 */
void
type_needs_print(
	Type_needs	type_needs,
	int		indent,
	Stdio		out_file)
{
	Type_need	type_need;

	VEC_LOOP(Type_need, type_needs, type_need) {
		type_need_print(type_need, indent, out_file);
	}
}

/*
 * type_needs_replace(old_type_needs, old_type_refs,
 *			  new_type_refs, type_tables)
 *	This routine will replace all occurances of "old_type_refs" with
 *	"new_type_refs" in "old_type_needs" and return the resulting list.
 */
Type_needs
type_needs_replace(
	Type_needs	old_type_needs,
	Type_refs	old_type_refs,
	Type_refs	new_type_refs,
	Type_tables	type_tables)
{
	Type_need	new_type_need;
	Type_needs	new_type_needs;
	Type_need	old_type_need;

	new_type_needs = type_tables->type_need_table->needs_empty;
	VEC_LOOP(Type_need, old_type_needs, old_type_need) {
		new_type_need = type_need_replace(old_type_need,
						  old_type_refs,
						  new_type_refs,
						  type_tables);
		new_type_needs = type_needs_append(new_type_needs,
						   new_type_need,
						   type_tables);
	}
	return new_type_needs;
}

/*
 * type_needs_read(in_file, heap, type_tables)
 *	This routine will read in and return list of type references from
 *	"in_file" allocated from "heap".
 */
Type_needs
type_needs_read(
	Stdio		in_file,
	Heap		heap,
	Type_tables	type_tables)
{
	int		count;
	Type_need	type_need;
	Type_needs	type_needs;

	out_marker_read(in_file, "type_needs");
	type_needs = type_tables->type_need_table->needs_empty;
	count = out_count_read(in_file);
	while (count-- > 0) {
		type_need = type_need_read(in_file, heap, type_tables);
		type_needs = type_needs_append(type_needs,
					       type_need, type_tables);
	}
	return type_needs;
}

/*
 * type_needs_write(type_needs, out_file, type_tables)
 *	This routine will write "type_needs" to "out_file".  0 is always
 *	returned.
 */
void
type_needs_write(
	Type_needs	type_needs,
	Stdio		out_file,
	Type_tables	type_tables)
{
	int		index;
	int		size;
	Type_need	type_need;

	out_marker_write(out_file, "type_needs");
	size = vec_size(Type_need, type_needs);
	out_count_write(out_file, size);
	for (index = 0; index < size; index++) {
		type_need = vec_fetch(Type_need, type_needs, index);
		type_need_write(type_need, out_file, type_tables);
	}
}

/*
 * type_needs_table_lookup(type_need_table)
 *	This routine will return the type need list corresponding to
 *	"type_need_table"->needs_key.
 */
LOCAL Type_needs
type_needs_table_lookup(
	Type_need_table	type_need_table)
{
	Type_needs	needs_key;
	Type_needs	type_needs;
	Table(Type_need, Type_need) needs_table;

	needs_key = type_need_table->needs_key;
	vec_sort(Type_need, needs_key, type_need_compare, 0);
	needs_table = type_need_table->needs_table;
	type_needs = table_lookup(Type_needs, Type_needs,
				  needs_table, needs_key);
	if (type_needs == (Type_needs)0) {
		type_needs = vec_create(Type_need, type_need_table->heap);
		vec_vec_append(Type_need, type_needs, needs_key);
		assert(table_insert(Type_needs, Type_needs, needs_table,
				    type_needs, type_needs) == 0);
	}
	vec_trim(Type_needs, needs_key, 0);
	return type_needs;
}

/*
 * Type_proto routines:
 */

#ifdef OLD
/*
 * type_proto_compare(type_proto1, type_proto2, zilch)
 *	This routine is returns <0, 0, or >0 depending upon whether
 *	"type_proto1" is less than, equal to, or greater than "type_proto2".
 */
/* ARGSUSED */
int
type_proto_compare(
	Type_proto	type_proto1,
	Type_proto	type_proto2,
	int		zilch)
{
	Routine_ref	routine_ref1;
	Routine_ref	routine_ref2;
	int		result;

	/* This implementation seems bogus! */

	routine_ref1 = type_proto1->routine_ref;
	routine_ref2 = type_proto2->routine_ref;
	result = type_ref_compare(routine_ref1->type_ref,
				  routine_ref2->type_ref);
	if (result != 0) {
		return result;
	}
	return strcmp(routine_ref1->name, routine_ref2->name);
}
#endif /* OLD */

/*
 * type_proto_create(kind, params, takes, returns, yields,
 *		     signals, needs, no_return, type_tables)
 *	This routine will create and return a type prototype object consisting
 *	of type "kind", having "params" parameters, "takes" arguments,
 *	"returns" return types, "yields" yields types, "signals"
 *	signals, "needs" needs, and "no_return" allocted from "heap".
 *	A side-effect of this routine is that "signals" and "needs"
 *	will be sorted.
 */
Type_proto
type_proto_create(
	Type_proto_kind	kind,
	Type_refs	params,
	Type_refs	takes,
	Type_refs	returns,
	Type_refs	yields,
	Type_signals	signals,
	Type_needs	needs,
	int		no_return,
	Type_tables	type_tables)
{
	char		anonymous[20];
	Heap		heap;
	Type_proto	type_proto;
	Type_proto	key;
	Table(Type_proto, Type_proto) table;
	Vec(Type_proto)	type_proto_list;
	Type_proto_table type_proto_table;
	Type_ref	type_ref;
	Vec(Type_ref)	type_ref_list;

	type_proto_table = type_tables->type_proto_table;
	key = type_proto_table->key;
	key->kind = kind;
	key->params = params;
	key->takes = takes;
	key->returns = returns;
	key->yields = yields;
	key->signals = signals;
	key->needs = needs;
	key->no_return = no_return;
	table = type_proto_table->table;
	type_proto = table_lookup(Type_proto, Type_proto, table, key);
	if (type_proto == (Type_proto)0) {
		heap = type_proto_table->heap;

		type_ref_list = type_proto_table->type_ref_list;
		(void)sprintf(anonymous, "anonymous__%d",
			      vec_size(Type_ref, type_ref_list));
		type_ref = type_ref_create(strdupl(anonymous, heap),
					   type_tables);
		vec_append(Type_ref, type_ref_list, type_ref);

		type_proto = heap_allocate(heap, Type_proto);
		type_proto->generated = 0;
		type_proto->kind = kind;
		type_proto->needs = needs;
		type_proto->needed = 0;
		type_proto->no_return = no_return;
		type_proto->params = params;
		type_proto->returns = returns;
		type_proto->signals = signals;
		type_proto->takes = takes;
		type_proto->type_ref = type_ref;
		type_proto->yields = yields;
		assert(table_insert(Type_proto, Type_proto,
				    table, type_proto, type_proto) == 0);

		type_proto_list = type_proto_table->type_proto_list;
		vec_append(Type_proto, type_proto_list, type_proto);
	}
	return type_proto;
}

/*
 * type_proto_equal(proto1, proto1)
 *	This routine will return 1 if "proto1" equals "proto2" and 0 otherwise.
 */
int
type_proto_equal(
	Type_proto	proto1,
	Type_proto	proto2)
{
	if (proto1 == (Type_proto)0) {
		if (proto2 == (Type_proto)0) {
			return 1;
		} else {
			return 0;
		}
	} else if (proto2 == (Type_proto)0) {
		return 0;
	}
	if (!type_refs_equal(proto1->takes, proto2->takes)) {
		return 0;
	}
	if (proto1->kind != proto2->kind) {
		return 0;
	}
	if (!type_refs_equal(proto1->params, proto2->params)) {
		return 0;
	}
	if (!type_needs_equal(proto1->needs, proto2->needs)) {
		return 0;
	}
	if (proto1->no_return != proto2->no_return) {
		return 0;
	}
	if (!type_refs_equal(proto1->returns, proto2->returns)) {
		return 0;
	}
	if (!type_signals_equal(proto1->signals, proto2->signals)) {
		return 0;
	}
	if (!type_refs_equal(proto1->yields, proto2->yields)) {
		return 0;
	}
	return 1;
#ifdef OLD
	return (type_refs_equal(proto1->takes, proto2->takes) &&
		(proto1->kind == proto2->kind) &&
		(proto1->params == proto2->params) &&
		type_needs_equal(proto1->needs, proto2->needs) &&
		(proto1->no_return == proto2->no_return) &&
		type_refs_equal(proto1->returns, proto2->returns) &&
		type_signals_equal(proto1->signals, proto2->signals) &&
		type_refs_equal(proto1->yields, proto2->yields) &&
		type_proto_equal(proto1->param_proto, proto2->param_proto));
#endif /* OLD */
}

/*
 * type_proto_from_type_ref(type_ref, type_tables)
 *	This routine will return the prototype corresponding to "type_ref"
 *	using "type_tables".  If "type_ref" does not correspond to a
 *	routine type, a fatal error ensues.
 */
Type_proto
type_proto_from_type_ref(
	Type_ref	type_ref,
	Type_tables	type_tables)
{
	Type_proto	type_proto;

	assert(type_ref_is_routine(type_ref));
	type_proto = vec_fetch(Type_proto,
			       type_tables->type_proto_table->type_proto_list,
			       atoi(type_ref->name + 11));
			/* 11 = strlen("anonymous__" */
	return type_proto;
}

/*
 * type_proto_hash(proto)
 *	This routine will return a hash value for "proto".
 */
int
type_proto_hash(
	Type_proto	proto)
{
	if (proto == (Type_proto)0) {
		return 0;
	}
	return (type_refs_hash(proto->takes) +
		(int)proto->kind +
		type_refs_hash(proto->params) +
		type_needs_hash(proto->needs) +
		proto->no_return +
		type_refs_hash(proto->returns) +
		type_signals_hash(proto->signals) +
		type_refs_hash(proto->yields));
}

/*
 * type_proto_is_parameter(type_proto, type_ref)
 *	This routine will return 1 if "type_ref" contains any parameter from
 *	"type_proto".
 */
int
type_proto_is_parameter(
	Type_proto	type_proto,
	Type_ref	type_ref)
{
	Type_ref	param;
	Type_refs	params;

	params = type_proto->params;
	TYPE_REFS_LOOP(params, param) {
		if (type_ref_equal(type_ref, param)) {
			return 1;
		}
	}
	return 0;
}

/*
 * type_proto_is_parameterized(type_proto)
 *	This routine will return 1 if "type_prot" is parameterized and
 *	0 otherwise.
 */
int
type_proto_is_parameterized(
	Type_proto	type_proto)
{
	return !type_refs_is_empty(type_proto->params);
}

/*
 * type_proto_needed(type_proto, type_tables)
 *	This routine will mark "type_proto" as being needed.
 */
void
type_proto_needed(
	Type_proto	type_proto,
	Type_tables	type_tables)
{
	if (!type_proto->needed) {
		type_proto->needed = 1;
	
		type_refs_needed(type_proto->returns, type_tables);
		type_refs_needed(type_proto->takes, type_tables);
		type_signals_needed(type_proto->signals, type_tables);
		type_refs_needed(type_proto->yields, type_tables);

		if (type_refs_size(type_proto->returns) > 1) {
			type_refs_multiple_needed(type_proto->returns,
						  type_tables);
		}
	}
}

/*
 * type_proto_print(type_proto, indent, out_file)
 *	This routine will print "type_proto" to "out_file" indented by
 *	"indent".
 */
void
type_proto_print(
	Type_proto	type_proto,
	int		indent,
	Stdio		out_file)
{
	Type_refs	params;
	Str		separator;

	if (indent < 0) {
		indent -= 3;
		separator = "; ";
	} else {
		separator = "\n";
	}
	params = type_proto->params;
	if (!type_refs_is_empty(params)) {
		out(out_file, "[");
		type_refs_print(params, out_file);
		out(out_file, "] ");
	}
	switch (type_proto->kind) {
	    case Type_proto_procedure:
		out(out_file, "procedure");
		break;
	    case Type_proto_iterator:
		out(out_file, "iterator");
		break;
	    default:
		assert_fail();
	}
	out(out_file, "%s", separator);

	if (type_refs_is_empty(type_proto->takes)) {
		out(out_file, "%\ttakes_nothing%s", indent, separator);
	} else {
		out(out_file, "%\ttakes ", indent);
		type_refs_print(type_proto->takes, out_file);
		out(out_file, "%s", separator);
	}
	if (type_proto->no_return) {
		out(out_file, "%\treturns_never%s", indent, separator);
	} else if (type_refs_is_empty(type_proto->returns)) {
		out(out_file, "%\treturns_nothing%s", indent, separator);
	} else {
		out(out_file, "%\treturns ", indent);
		type_refs_print(type_proto->returns, out_file);
		out(out_file, "%s", separator);
	}
	if (type_proto->kind == Type_proto_iterator) {
		if (type_refs_is_empty(type_proto->yields)) {
			out(out_file, "%\tyields_nothing%s", indent, separator);
		} else {
			out(out_file, "%\tyields ", indent);
			type_refs_print(type_proto->yields, out_file);
			out(out_file, "%s", separator);
		}
	}
	if (!vec_empty(Type_signal, type_proto->signals)) {
		Type_signal	type_signal;

		out(out_file, "%\tsignals%s", indent, separator);
		VEC_LOOP(Type_signal, type_proto->signals, type_signal) {
			out(out_file, "%\t%s ",
			    indent + 1, type_signal->name);
			type_refs_print(type_signal->type_refs, out_file);
			out(out_file, "%s", separator);
		}
	}
	if (!vec_empty(Type_need, type_proto->needs)) {
		Type_need	type_need;

		out(out_file, "%\tneeds%s", indent, separator);
		VEC_LOOP(Type_need, type_proto->needs, type_need) {
			out(out_file, "%\t%s ",
			    indent + 1, type_need->name);
			type_proto_print(type_need->proto,
					 indent + 2, out_file);
		}
	}
}

/*
 * type_proto_replace(old_type_proto, old_type_refs,
 *		      new_type_refs, type_tables)
 *	This routine will replace all occurrances of "old_type_refs" with
 *	"new_type_refs" in "old_type_proto".
 */
Type_proto
type_proto_replace(
	Type_proto	old_type_proto,
	Type_refs	old_type_refs,
	Type_refs	new_type_refs,
	Type_tables	type_tables)
{
	Type_needs	needs;
	Type_proto	new_type_proto;
	Type_refs	params;
	Type_refs	returns;
	Type_signals	signals;
	Type_refs	takes;
	Type_refs	yields;

	params = type_refs_replace(old_type_proto->params,
				   old_type_refs,
				   new_type_refs,
				   type_tables);
	takes = type_refs_replace(old_type_proto->takes,
				  old_type_refs,
				  new_type_refs,
				  type_tables);
	returns = type_refs_replace(old_type_proto->returns,
				    old_type_refs,
				    new_type_refs,
				    type_tables);
	yields = type_refs_replace(old_type_proto->yields,
				   old_type_refs,
				   new_type_refs,
				   type_tables);
	signals = type_signals_replace(old_type_proto->signals,
				       old_type_refs,
				       new_type_refs,
				       type_tables);
	needs = type_needs_replace(old_type_proto->needs,
				   old_type_refs,
				   new_type_refs,
				   type_tables);
	new_type_proto = type_proto_create(old_type_proto->kind,
					   params,
					   takes,
					   returns,
					   yields,
					   signals,
					   needs,
					   old_type_proto->no_return,
					   type_tables);
	return new_type_proto;
}

/*
 * type_proto_read(in_file, heap, type_tables)
 *	This routine will read in and return type proto object from "in_file"
 *	and allocated from "heap".
 */
Type_proto
type_proto_read(
	Stdio		in_file,
	Heap		heap,
	Type_tables	type_tables)
{
	Type_refs	takes;
	Type_proto_kind	kind;
	Type_needs	needs;
	int		no_return;
	Type_refs	params;
	Type_refs	returns;
	Type_signals	signals;
	Type_refs	yields;

	out_marker_read(in_file, "type_proto");
	kind = (Type_proto_kind)getc(in_file);
	params = type_refs_read(in_file, heap, type_tables);
	takes = type_refs_read(in_file, heap, type_tables);
	returns = type_refs_read(in_file, heap, type_tables);
	yields = type_refs_read(in_file, heap, type_tables);
	signals = type_signals_read(in_file, heap, type_tables);
	needs = type_needs_read(in_file, heap, type_tables);
	no_return = (int)getc(in_file);
	return type_proto_create(kind, params, takes, returns, yields,
				 signals, needs, no_return, type_tables);
}

#ifndef lint
/*
 * type_proto_show(type_proto)
 *	This routine is used for debugging and will show "type_proto"
 *	on standard out.
 */ 
void
type_proto_show(
	Type_proto	type_proto)
{
	type_proto_print(type_proto, 0, stdout);
}
#endif /* lint */

/*
 * type_proto_write(type_proto, out_file, type_tables)
 *	This routine will write "type_proto" to "out_file".
 */
void
type_proto_write(
	Type_proto	type_proto,
	Stdio		out_file,
	Type_tables	type_tables)
{
	out_marker_write(out_file, "type_proto");
	(void)putc((char)type_proto->kind, out_file);
	type_refs_write(type_proto->params, out_file, type_tables);
	type_refs_write(type_proto->takes, out_file, type_tables);
	type_refs_write(type_proto->returns, out_file, type_tables);
	type_refs_write(type_proto->yields, out_file, type_tables);
	type_signals_write(type_proto->signals, out_file, type_tables);
	type_needs_write(type_proto->needs, out_file, type_tables);
	(void)putc((char)type_proto->no_return, out_file);
}

/*
 * type_proto_table_create(type_ref_table, heap)
 *	This routine will create and return a new prototype table.
 */
/* ARGSUSED */
Type_proto_table
type_proto_table_create(
	Type_ref_table	type_ref_table,
	Heap		heap)
{
	Type_proto_table type_proto_table;

	type_proto_table = heap_allocate(heap, Type_proto_table);
	type_proto_table->heap = heap;
	type_proto_table->key = heap_allocate(heap, Type_proto);
	type_proto_table->table = table_create(Type_proto, Type_proto, 50,
					       type_proto_equal,
					       type_proto_hash,
					       (Type_proto)0,
					       heap);
	type_proto_table->type_proto_list = vec_create(Type_proto, heap);
	type_proto_table->type_ref_list = vec_create(Type_ref, heap);
	return type_proto_table;
}

/*
 * type_proto_table_dump(type_proto_table, out_file)
 *	This routine will dump the contents of "type_proto_table" to
 *	"out_file" in human readable format.
 */
void
type_proto_table_dump(
	Type_proto_table type_proto_table,
	Stdio		out_file)
{
	Type_proto	type_proto;
	Vec(Type_proto)	type_proto_list;

	type_proto_list = table_value_list_extract(Type_proto, Type_proto,
						   type_proto_table->table);
	out(out_file, "Type Proto Table:\n");
	VEC_LOOP(Type_proto, type_proto_list, type_proto) {
		type_proto_print(type_proto, 1, out_file);
	}
	out(out_file, "\n");
}

/*
 * type_proto_table_gen(type_proto_table, gen)
 *	This routine will generate the type definitions for each type
 *	prototype in "proto" using "gen".
 */
void
type_proto_table_gen(
	Type_proto_table type_proto_table,
	Gen		gen)
{
	int		index;
	int		size;
	Type_proto	type_proto;
	Vec(Type_proto)	type_proto_list;

	Type_refs	takes;
	Type_ref	type_ref;
	Str		type_str;

	type_proto_list = type_proto_table->type_proto_list;
	size = vec_size(Type_proto, type_proto_list);
	for (index = 0; index < size; index++) {
		type_proto = vec_fetch(Type_proto, type_proto_list, index);
		assert(index == atoi(type_proto->type_ref->name + 11));
		if (type_proto->needed == 0) {
			continue;
		}
		type_str = type_refs_multiple_string(type_proto->returns,
						     gen->heap);
		gen_out(gen, "typedef %s (*anonymous__%d___routine)(",
			type_str, index);
		takes = type_proto->takes;
		TYPE_REFS_LOOP(takes, type_ref) {
			gen_out(gen, "%s, ",
				type_ref_string(type_ref, gen->heap));
		}
		gen_out(gen, "void *);\n");
		gen_out(gen, "typedef struct {\n");
		gen_out(gen, "%\tanonymous__%d___routine routine;\n", 1, index);
		gen_out(gen, "%\tvoid *parameter;\n", 1);
		gen_out(gen,
			"} *anonymous__%d___type, anonymous__%d___struct;\n",
			index, index);
	}
	if (size != 0) {
		gen_out(gen, "\n");
	}
}

/*
 * Type_signal routines:
 */

/*
 * type_signal_compare(type_signal1, type_signal2, zilch)
 *	This routine will return -1, 0, or 1 depending upon whether
 *	"type_signal1" is less than, equal to, or greater than "type_signal2".
 */
/* ARGSUSED */
int
type_signal_compare(
	Type_signal	type_signal1,
	Type_signal	type_signal2,
	int		zilch)
{
	int		result;

	result = strcmp(type_signal1->name, type_signal2->name);
	if (result != 0) {
		return result;
	}
	result = type_refs_compare(type_signal1->type_refs,
				   type_signal2->type_refs, 0);
	return result;
}

/*
 * type_signal_create(name, type_refs, type_tables)
 *	This routine will create and return a new type signal object
 *	consisting of "name" and "type_refs" using "type_tables".
 */
Type_signal
type_signal_create(
	Str		name,
	Type_refs	type_refs,
	Type_tables	type_tables)
{
	Heap		heap;
	Type_signal	signal_key;
	Table(Type_signal, Type_signal) signal_table;
	Type_signal	type_signal;
	Type_signal_table type_signal_table;

	type_signal_table = type_tables->type_signal_table;
	signal_key = type_signal_table->signal_key;
	signal_key->name = name;
	signal_key->type_refs = type_refs;
	signal_table = type_signal_table->signal_table;
	type_signal = table_lookup(Type_signal, Type_signal,
				   signal_table, signal_key);
	if (type_signal == (Type_signal)0) {
		heap = type_tables->type_signal_table->heap;
		type_signal = heap_allocate(heap, Type_signal);
		type_signal->name = name;
		type_signal->type_refs = type_refs;
		assert(table_insert(Type_signal, Type_signal,
				    signal_table, type_signal,
				    type_signal) == 0);
	}
	return type_signal;
}

/*
 * type_signal_equal(type_signal1, type_signal2)
 *	This routine will return 1 if "type_signal1" equals "type_signal2" and
 *	0 otherwise.
 */
int
type_signal_equal(
	Type_signal		type_signal1,
	Type_signal		type_signal2)
{
	return (type_signal_compare(type_signal1, type_signal2, 0) == 0);
}

/*
 * type_signal_hash(type_signal)
 *	This routine will return a hash value for "type_signal".
 */
int
type_signal_hash(
	Type_signal	type_signal)
{
	return (strhash(type_signal->name) +
		type_refs_hash(type_signal->type_refs));
}

/*
 * type_signal_needed(type_signal, type_tables)
 *	This routine will mark all of the type references in "type_signal"
 *	as being needed in the output file.
 */
LOCAL void
type_signal_needed(
	Type_signal	type_signal,
	Type_tables	type_tables)
{
	type_refs_needed(type_signal->type_refs, type_tables);
}

/*
 * type_signal_print(type_signal, out_file)
 *	This routine will print "type_signal" to "out_file".
 */
void
type_signal_print(
	Type_signal	type_signal,
	Stdio		out_file)
{
	out(out_file, "%s ", type_signal->name);
	type_refs_print(type_signal->type_refs, out_file);
	out(out_file, "\n");
}

/*
 * type_signal_read(in_file, heap, type_tables)
 *	This routine will read in and return a Type_signal from "in_file"
 *	using "heap".
 */
Type_signal
type_signal_read(
	Stdio		in_file,
	Heap		heap,
	Type_tables	type_tables)
{
	Str		name;
	Type_refs	type_refs;

	out_marker_read(in_file, "type_signal");
	name = strread(in_file, heap);
	type_refs = type_refs_read(in_file, heap, type_tables);
	return type_signal_create(name, type_refs, type_tables);
}

/*
 * type_signal_replace(old_type_signal, old_type_refs,
 *		       new_type_refs, type_tables)
 *	This routine will replace all occurances of "old_type_refs" with
 *	"new_type_refs" in "old_type_signal" and return the new Type_signal
 *	object.
 */
Type_signal
type_signal_replace(
	Type_signal	old_type_signal,
	Type_refs	old_type_refs,
	Type_refs	new_type_refs,
	Type_tables	type_tables)
{
	Type_refs	type_refs;

	type_refs = type_refs_replace(old_type_signal->type_refs,
				      old_type_refs,
				      new_type_refs,
				      type_tables);
	return type_signal_create(old_type_signal->name,
				  type_refs, type_tables);
}

/*
 * type_signal_write(type_signal, out_file, type_tables)
 *	This routine will write "type_signal" to "out_file".
 */
void
type_signal_write(
	Type_signal	type_signal,
	Stdio		out_file,
	Type_tables	type_tables)
{
	out_marker_write(out_file, "type_signal");
	(void)strwrite(type_signal->name, out_file);
	type_refs_write(type_signal->type_refs, out_file, type_tables);
}


/*
 * type_signal_table_create(type_ref_table, heap)
 *	This routine will create and return a new prototype table.
 */
/* ARGSUSED */
Type_signal_table
type_signal_table_create(
	Type_ref_table	type_ref_table,
	Heap		heap)
{
	Type_signal_table type_signal_table;

	type_signal_table = heap_allocate(heap, Type_signal_table);
	type_signal_table->heap = heap;
	type_signal_table->signal_key = heap_allocate(heap, Type_signal);
	type_signal_table->signal_table = table_create(Type_signal, Type_signal,
						       50, type_signal_equal,
						       type_signal_hash,
						       (Type_signal)0,
						       heap);
	type_signal_table->signals_table = table_create(Type_signals,
							Type_signals,
							50,
							type_signals_equal,
							type_signals_hash,
							(Type_signals)0,
							heap);
	type_signal_table->signals_key = vec_create(Type_signa, heap);
	type_signal_table->signals_empty =
				type_signals_table_lookup(type_signal_table);
	return type_signal_table;
}

/*
 * type_signal_table_dump(type_signal_table, out_file)
 *	This routine will dump the contents of "type_signal_table" to
 *	"out_file" in human readable format.
 */
void
type_signal_table_dump(
	Type_signal_table type_signal_table,
	Stdio		out_file)
{
	Type_signal	type_signal;
	Vec(Type_signal) type_signal_list;
	Type_signals	type_signals;
	Vec(Type_signals) type_signals_list;

	type_signal_list = table_value_list_extract(Type_signal, Type_signal,
					type_signal_table->signal_table);
	vec_sort(Type_signal, type_signal_list, type_signal_compare, 0);
	out(out_file, "Type Signal Table:\n");
	if (vec_empty(Type_signal, type_signal_list)) {
		out(out_file, "<Empty>\n");
	} else {
		VEC_LOOP(Type_signal, type_signal_list, type_signal) {
			type_signal_print(type_signal, out_file);
		}
	}
	out(out_file, "\n");

	type_signals_list = table_value_list_extract(Type_signals, Type_signals,
					type_signal_table->signals_table);
	vec_sort(Type_signals, type_signals_list, type_signals_compare, 0);
	out(out_file, "Type Signal List Table:\n");
	VEC_LOOP(Type_signals, type_signals_list, type_signals) {
		out(out_file, "----\n");
		type_signals_print(type_signals, 0, out_file);
	}
	out(out_file, "--------\n");
	out(out_file, "\n");
}

/*
 * Type_signals routines:
 */

/*
 * type_signals_append(type_signals, type_signal, type_tables)
 *	This routine will create and return an new type signal list
 *	that consists of "type_signals" with "type_signal" appended to
 *	the end.
 */
Type_signals
type_signals_append(
	Type_signals	type_signals,
	Type_signal	type_signal,
	Type_tables	type_tables)
{
	Type_signals	signals_key;
	Type_signal_table type_signal_table;

	type_signal_table = type_tables->type_signal_table;
	signals_key = type_signal_table->signals_key;
	assert(vec_empty(Type_signal, signals_key));
	vec_vec_append(Type_signal, signals_key, type_signals);
	vec_append(Type_signal, signals_key, type_signal);
	type_signals = type_signals_table_lookup(type_signal_table);
	return type_signals;
}

/*
 * type_signals_compare(type_signals1, type_signals2, zilch)
 *	This routine will order "type_signals1" with respect to "type_siganls2"
 *	by returning <0, =0, or >1 depending upon whether "type_signals1"
 *	should come before, is equal to, or should come after "type_signals2".
 */
/* ARGSUSED */
int
type_signals_compare(
	Type_signals	type_signals1,
	Type_signals	type_signals2,
	int		zilch)
{	
	int		index;
	int		result;
	int		size1;
	int		size2;
	Type_signal	type_signal1;
	Type_signal	type_signal2;

	size1 = vec_size(Type_signal, type_signals1);
	size2 = vec_size(Type_signal, type_signals2);
	result = size1 - size2;
	if (result != 0) {
		return result;
	}
	for (index = 0; index < size1; index++) {
		type_signal1 = vec_fetch(Type_signal, type_signals1, index);
		type_signal2 = vec_fetch(Type_signal, type_signals2, index);
		result = type_signal_compare(type_signal1, type_signal2, 0);
		if (result != 0) {
			return result;
		}
	}
	return 0;
}

/*
 * type_signals_empty_create(type_tables)
 *	This routine will return an empty type signal list using "type_tables".
 */
Type_signals
type_signals_empty_create(
	Type_tables	type_tables)
{
	return type_tables->type_signal_table->signals_empty;
}

/*
 * type_signals_equal(type_signals1, type_signals2)
 *	This routine will return 1 if "type_signals1" is equal to
 *	"type_signals2" and 0 otherwise.
 */
int
type_signals_equal(
	Type_signals	type_signals1,
	Type_signals	type_signals2)
{
	return (type_signals_compare(type_signals1, type_signals2, 0) == 0);
}

/*
 * type_signals_hash(type_signals)
 *	This routine will return a hash value for "type_signals".
 */
int
type_signals_hash(
	Type_signals	type_signals)
{
	int			hash;
	Type_signal		type_signal;

	hash = 0;
	VEC_LOOP(Type_signal, type_signals, type_signal) {
		hash += type_signal_hash(type_signal);
	}
	return hash;
}

/*
 * type_signals_needed(type_signals, type_tables)
 *	This routine will mark all of the type references in "type_signals"
 *	as being needed in the output file.
 */
LOCAL void
type_signals_needed(
	Type_signals	type_signals,
	Type_tables	type_tables)
{
	Type_signal	type_signal;

	VEC_LOOP(Type_signal, type_signals, type_signal) {
		type_signal_needed(type_signal, type_tables);
	}
}

/*
 * type_signals_print(type_signals, indent, out_file)
 *	This routine will print "type_signals" to "out_file" indented
 *	by "indent".
 */
/* ARGSUSED */
void
type_signals_print(
	Type_signals	type_signals,
	int		indent,
	Stdio		out_file)
{
	Type_signal	type_signal;

	VEC_LOOP(Type_signal, type_signals, type_signal) {
		type_signal_print(type_signal, out_file);
	}
}

/*
 * type_signals_read(in_file, heap, type_tables)
 *	This routine will read in and return list of type references from
 *	"in_file" allocated from "heap".
 */
Type_signals
type_signals_read(
	Stdio		in_file,
	Heap		heap,
	Type_tables	type_tables)
{
	int		count;
	Type_signal	type_signal;
	Type_signals	type_signals;

	out_marker_read(in_file, "type_signals");
	type_signals = type_tables->type_signal_table->signals_empty;
	count = out_count_read(in_file);
	while (count-- > 0) {
		type_signal = type_signal_read(in_file, heap, type_tables);
		type_signals = type_signals_append(type_signals,
						   type_signal, type_tables);
	}
	return type_signals;
}

/*
 * type_signals_replace(old_type_signals, old_type_refs,
 *			    new_type_refs, type_tables, heap)
 *	This routine will replace all occurances of "old_type_refs" with
 *	"new_type_refs" in "old_type_signals" and return the resulting list.
 */
Type_signals
type_signals_replace(
	Type_signals	old_type_signals,
	Type_refs	old_type_refs,
	Type_refs	new_type_refs,
	Type_tables	type_tables)
{
	Type_signal	new_type_signal;
	Type_signals	new_type_signals;
	Type_signal	old_type_signal;

	new_type_signals = type_tables->type_signal_table->signals_empty;
	VEC_LOOP(Type_signal, old_type_signals, old_type_signal) {
		new_type_signal = type_signal_replace(old_type_signal, 
						      old_type_refs,
						      new_type_refs,
						      type_tables);
		new_type_signals = type_signals_append(new_type_signals,
						       new_type_signal,
						       type_tables);
	}
	return new_type_signals;
}

/*
 * type_signals_write(type_signals, out_file, type_tables)
 *	This routine will write "type_signals" to "out_file".
 */
void
type_signals_write(
	Type_signals	type_signals,
	Stdio		out_file,
	Type_tables	type_tables)
{
	int		index;
	int		size;
	Type_signal	type_signal;

	out_marker_write(out_file, "type_signals");
	size = vec_size(Type_signal, type_signals);
	out_count_write(out_file, size);
	for (index = 0; index < size; index++) {
		type_signal = vec_fetch(Type_signal, type_signals, index);
		type_signal_write(type_signal, out_file, type_tables);
	}
}

/*
 * type_signals_table_lookup(type_signal_table)
 *	This routine will return the type signal list corresponding to
 *	"type_signal_table"->signals_key.
 */
LOCAL Type_signals
type_signals_table_lookup(
	Type_signal_table	type_signal_table)
{
	Type_signals	signals_key;
	Type_signals	type_signals;
	Table(Type_signal, Type_signal) signals_table;

	signals_key = type_signal_table->signals_key;
	vec_sort(Type_signal, signals_key, type_signal_compare, 0);
	signals_table = type_signal_table->signals_table;
	type_signals = table_lookup(Type_signals, Type_signals,
				    signals_table, signals_key);
	if (type_signals == (Type_signals)0) {
		type_signals = vec_create(Type_signal, type_signal_table->heap);
		vec_vec_append(Type_signal, type_signals, signals_key);
		assert(table_insert(Type_signals, Type_signals, signals_table,
				    type_signals, type_signals) == 0);
	}
	vec_trim(Type_signals, signals_key, 0);
	return type_signals;
}