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

/*
 * Copyright (c) 1990, 1991, 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 responsible for creating call objects.
 */

#ifndef CALL_DEFS_H
#include "call_defs.h"
#endif

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

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

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

#ifndef MSG_EXPORTS_H
#include "msg_exports.h"
#endif

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

#ifndef OBJECT_DEFS_H
#include "object_defs.h"
#endif

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

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

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

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

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

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

LOCAL Call	call_create(Convert, Call_type, int, Type_refs);

/*
 * call_assign_create(convert, left_call, right_call)
 *	This routine will create and return an assignment node consisting of
 *	"left_call" and "right_call".  "left_call" must be a variable.
 */
Call
call_assign_create(
	Convert		convert,
	Call		left_call,
	Call		right_call)
{
	Call		call;
	Call_assign	call_assign;

	if (!type_refs_equal(left_call->type_refs,
				 right_call->type_refs)) {
		msg_out(convert->msg, left_call->position,
			"Left type of ':=' is %q and right type is %q",
			left_call->type_refs, right_call->type_refs);
	}

	call_assign = heap_allocate(convert->heap, Call_assign);
	call_assign->left = left_call;	
	call_assign->right = right_call;
	call = call_create(convert, Call_type_assign,
			   left_call->position, convert->type_refs_empty);
	call->value.assign = call_assign;
	return call;
}

/*
 * call_binary_create(convert, call_type, left_call, right_call)
 *	This routine will create and return a binary call node consisting
 *	of "left_call" and "right_call".
 */
Call
call_binary_create(
	Convert		convert,
	Call_type	call_type,
	Call		left_call,
	Call		right_call)
{
	Call		call;
	Call_binary	call_binary;

	call_binary = heap_allocate(convert->heap, Call_binary);
	call_binary->left = left_call;
	call_binary->right = right_call;
	call = call_create(convert, call_type, left_call->position,
			   convert->type_ref_logical->type_refs);
	call->value.binary = call_binary;
	return call;
}

/*
 * call_cast_create(convert, call, type_ref)
 *	This routine will return a cast call node consisting of "call"
 *	and "type_ref".
 */
Call
call_cast_create(
	Convert		convert,
	Call		call,
	Type_ref	type_ref)
{
	Heap		heap;
	Call_cast	call_cast;

	heap = convert->heap;
	call_cast = heap_allocate(heap, Call_cast);
	call_cast->call = call;
	call_cast->type_ref = type_ref;
	call = call_create(convert, Call_type_cast,
			   call->position, call->type_refs);
	call->value.cast = call_cast;
	return call;
}

/*
 * call_create(convert, type, position, type_refs)
 *	This routine will return a new Call object allocated from "heap"
 *	with a type of "type" and a position of "position".  Immediately
 *	after creating a call object, the value field must be assigned.
 */
Call
call_create(
	Convert		convert,
	Call_type	type,
	int		position,
	Type_refs	type_refs)
{
	Call		call;

	call = heap_allocate(convert->heap, Call);
	call->type = type;
	call->position = position;
	call->type_refs = type_refs;
	return call;
}

/*
 * call_error_create(convert, position, error)
 *	This routine will return an error call node.
 */
Call
call_error_create(
	Convert		convert,
	int		position,
	Str		error)
{
	Call		call;

	call = call_create(convert, Call_type_error,
			   position, convert->type_refs_empty);
	call->value.error = error;
	return call;
}

/*
 * call_if_create(convert, cond_call, true_call, false_call)
 *	This routine will create and return an arithmetic if node
 *	consisting of "cond_call", "true_call", and "false_call".
 */
Call
call_if_create(
	Convert		convert,
	Call		cond_call,
	Call		true_call,
	Call		false_call)
{
	Call		call;
	Call_if		call_if;

	call_if = heap_allocate(convert->heap, Call_if);
	call_if->condition = cond_call;
	call_if->true = true_call;
	call_if->false = false_call;
	call = call_create(convert, Call_type_if,
			   cond_call->position, true_call->type_refs);
	call->value.xif = call_if;
	return call;
}

/*
 * call_integer_create(convert, number)
 *	This routine will create an return an integer call object.
 */
Call
call_integer_create(
	Convert		convert,
	int		number,
	int		position)
{
	Call		call;

	call = call_create(convert, Call_type_integer, position,
			   convert->type_ref_unsigned->type_refs);
	call->value.integer = number;
	return call;
}

/*
 * call_invoke_check(convert, call, actuals, type_proto)
 *	This routine will verify that the types of "actuals" matches the
 *	prototype associated with "call" (which is of type "type_proto".)
 *	1 is returned if any error is detected; otherwise 0 is returned.
 */
LOCAL int
call_invoke_check(
	Convert		convert,
	Call		call,
	Vec(Call)	actuals,
	Type_proto	type_proto)
{
	Call		actual_call;
	Type_ref	actual_type_ref;
	Type_refs	actual_type_refs;
	int		actual_type_refs_size;
	Type_ref	take_type_ref;
	Type_refs	take_type_refs;
	int		take_type_refs_size;
	int		index;

	/* Assemble the list of actual types: */
	actual_type_refs = type_refs_empty_create(convert->type_tables);
	VEC_LOOP(Call, actuals, actual_call) {
		actual_type_refs = type_refs_concat(actual_type_refs,
						    actual_call->type_refs,
						    convert->type_tables);
	}
	actual_type_refs_size = type_refs_size(actual_type_refs);

	/* Check each argument: */
	take_type_refs = type_proto->takes;
	take_type_refs_size = type_refs_size(take_type_refs);
	if (take_type_refs_size != actual_type_refs_size) {
		msg_out(convert->msg, call->position,
			"Routine expected %d arguments, but got %d arguments",
			take_type_refs_size, actual_type_refs_size);
		return 1;
	}
	for (index = 0; index < take_type_refs_size; index++) {
		take_type_ref = type_refs_fetch(take_type_refs, index);
		actual_type_ref = type_refs_fetch(actual_type_refs, index);
		if (!type_ref_equal(take_type_ref, actual_type_ref)) {
			msg_out(convert->msg, call->position,
			    "Argument %d has type of %r instead of type %r",
			    index + 1, actual_type_ref, take_type_ref);
			return 1;
		}
	}
	return 0;
}

/*
 * call_invoke_create(convert, call, actuals, type_proto)
 *	This routine will create an return a Call_invoke object.
 */
/* ARGSUSED */
Call
call_invoke_create(
	Convert		convert,
	Call		call,
	Vec(Call)	actuals)
{
	Call_invoke	call_invoke;
	Call_routine	call_routine;
	Type_ref	call_type_ref;
	Type_refs	call_type_refs;
	Type_proto	call_type_proto;
	Call		new_call;

	if (call->type == Call_type_routine) {
		call_routine = call->value.routine;
		call_routine->routine_ref->constant--;
	}

	/* Get the routine prototype: */
	call_type_refs = call->type_refs;
	if (type_refs_size(call_type_refs) != 1) {
		msg_out(convert->msg, call->position,
			"Trying to invoke a non-routine");
		return call_error_create(convert, call->position,
					 "Trying to invoke a non-routine");
	}
	call_type_ref = type_refs_fetch(call_type_refs, 0);
	call_type_proto = type_proto_from_type_ref(call_type_ref,
						   convert->type_tables);
	if (call_type_proto == (Type_proto)0) {
		msg_out(convert->msg, call->position,
			"Trying to invoke a non-routine");
		return call_error_create(convert, call->position,
					 "Trying to invoke a non-routine");
	}

	if (call_invoke_check(convert, call, actuals, call_type_proto)) {
		msg_out(convert->msg, call->position, "Argument mismatch");
		return call_error_create(convert, call->position,
					 "Argument mismatch");
	}

	call_invoke = heap_allocate(convert->heap, Call_invoke);
	call_invoke->call = call;
	call_invoke->actuals = actuals;
	new_call = call_create(convert, Call_type_invoke,
			       call->position, call_type_proto->returns);
	new_call->value.invoke = call_invoke;
	return new_call;
}

/*
 * call_object_create(convert, object_ref, position)
 *	This routine will create and return a const call node consisting
 *	of "object_ref".
 */
Call
call_object_create(
	Convert		convert,
	Object_ref	object_ref,
	int		position)
{
	Call		call;

	if (type_ref_is_parameterized(object_ref->type_ref)) {
		Need_table	need_table;

		need_table = convert->routine->need_table;
		need_table_object_insert(need_table,
					 object_ref->name,
					 object_ref->type_ref,
					 object_ref->actual_type_ref);
	}
	call = call_create(convert, Call_type_object,
			   position, object_ref->type_ref->type_refs);
	call->value.object = object_ref;
	return call;
}

/*
 * call_routine_create(convert, routine_ref, position)
 *	This routine will return a call routine object with a value
 *	of "routine_ref" and a position of "position".
 */
Call
call_routine_create(
	Convert		convert,
	Routine_ref	routine_ref,
	int		position)
{
	Call		call;
	Call_routine	call_routine;
	Routine		routine;

	call_routine = heap_allocate(convert->heap, Call_routine);
	call_routine->routine_ref = routine_ref;

	routine_ref->constant++;

	if (!type_refs_is_empty(routine_ref->type_ref->parameters)) {
		routine = convert->routine;
		/*XXX: Argument types should be checked! */
		need_table_routine_insert(routine->need_table,
				routine_ref->name,
				routine_ref->type_ref,
				routine_ref->routine_entry->type_proto); /*Yes*/
	}

	call = call_create(convert, Call_type_routine, position,
			   routine_ref->type_proto->type_ref->type_refs);
	call->value.routine = call_routine;
	return call;
}

/*
 * call_multi_create(convert, invoke, type_refs)
 *	This routine will return a multiple assignment call object.
 */
Call
call_multi_create(
	Convert		convert,
	Call		invoke,
	Type_refs	type_refs)
{
	Call		call;
	Call_multi	call_multi;

	call_multi = heap_allocate(convert->heap, Call_multi);
	call_multi->invoke = invoke;
	call_multi->type_refs = type_refs;
	call_multi->vars = vec_create(Call, convert->heap);
	type_refs = invoke->type_refs;
	call = call_create(convert, Call_type_multi,
			   invoke->position, type_refs);
	type_refs_multiple_needed(type_refs, convert->type_tables);
	call->value.multi = call_multi;
	return call;
}

/*
 * call_not_create(convert, call)
 *	This routine will create and return a not call for "call".
 */
Call
call_not_create(
	Convert		convert,
	Call		call)
{
	Call		not_call;

	not_call = call_create(convert, Call_type_not, call->position,
			       convert->type_ref_logical->type_refs);
	not_call->value.not = call;
	return not_call;
}

/*
 * call_string_create(convert, string, position)
 *	This routine will return a string call object.
 */
Call
call_string_create(
	Convert		convert,
	Str		string,
	int		position)
{
	Call		call;

	call = call_create(convert, Call_type_string, position,
			   convert->type_ref_string->type_refs);
	call->value.string = string;
	return call;
}


/*
 * call_temp_create(convert, position, type_ref)
 *	This routine will return a temporary variable allocated from
 *	"convert" with a type of "type_ref".
 */
Call
call_temp_create(
	Convert		convert,
	int		position,
	Type_ref	type_ref)
{
	Call		call;
	Call_temp	call_temp;
	Heap		heap;
	Type_refs	type_refs;

	heap = convert->heap;
	type_refs = type_ref->type_refs;
	call_temp = heap_allocate(heap, Call_temp);
	call_temp->number = vec_size(Type_ref, convert->temps);
	vec_append(Type_ref, convert->temps, type_ref);
	call = call_create(convert, Call_type_temp, position, type_refs);
	call->value.temp = call_temp;
	return call;
}

/*
 * call_var_create(convert, name, position, type_refs)
 *	This routine will return a call reference to a variable named "name"
 *	at "position" and of type "type_refs".
 */
Call
call_var_create(
	Convert		convert,
	Str		name,
	int		position,
	Type_refs	type_refs)
{
	Call		call;
	Call_var	call_var;
	Heap		heap;

	heap = convert->heap;
	call_var = heap_allocate(heap, Call_var);
	call_var->name = name;
	call = call_create(convert, Call_type_var, position, type_refs);
	call->value.var = call_var;
	return call;
}

/*
 * convert_create(gen)
 *	This routine will create an return a Convert object using "gen".
 */
Convert
convert_create(
	Gen		gen)
{
	Convert		convert;
	Heap		heap;
	Type_tables	type_tables;

	heap = gen->heap;
	type_tables = gen->type_tables;
	convert = heap_allocate(heap, Convert);
	convert->flags = gen->flags;
	convert->heap = heap;
	convert->msg = gen->msg;
	convert->object_table = gen->object_table;
	convert->routine = (Routine)0;
	convert->synonyms = table_create(Str, Type_ref,
					 10, strequal, strhash,
					 (Type_ref)0, heap);
	convert->temps = gen->temps;
	convert->type_def_table = gen->type_def_table;
	convert->type_tables = gen->type_tables;
	convert->routine_table = gen->routine_table;
	convert->var_table = (Var_table)0;

	convert->type_ref_heap = type_ref_create("heap", type_tables);
	convert->type_ref_in_stream = type_ref_create("in_stream",
						      type_tables);
	convert->type_ref_global = type_ref_create("global__", type_tables);
	convert->type_ref_logical = type_ref_create("logical", type_tables);
	convert->type_ref_out_stream = type_ref_create("out_stream",
						       type_tables);
	convert->type_ref_integer = type_ref_create("integer",
						     type_tables);
	convert->type_ref_string = type_ref_create("string", type_tables);
	convert->type_ref_unsigned = type_ref_create("unsigned",
						       type_tables);
	convert->type_refs_empty = type_refs_empty_create(type_tables);
	convert->type_refs_logical = type_refs_append(convert->type_refs_empty,
						convert->type_ref_logical,
						type_tables);

	convert->type_tables = type_tables;
	gen->convert = convert;
	return convert;
}