ack/lang/m2/comp/def.c

/*
 * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
 * See the copyright notice in the ACK home directory, in the file "Copyright".
 *
 * Author: Ceriel J.H. Jacobs
 */

/* D E F I N I T I O N   M E C H A N I S M */

/* $Header$ */

#include	"debug.h"

#include	<alloc.h>
#include	<em_arith.h>
#include	<em_label.h>
#include	<assert.h>

#include	"LLlex.h"
#include	"main.h"
#include	"def.h"
#include	"type.h"
#include	"idf.h"
#include	"scope.h"
#include	"node.h"
#include	"Lpars.h"

STATIC
DefInFront(df)
	register t_def *df;
{
	/*	Put definition "df" in front of the list of definitions
		in its scope.
		This is neccessary because in some cases the order in this
		list is important.
	*/
	register t_def *df1 = df->df_scope->sc_def;

	if (df1 != df) {
		/* Definition "df" is not in front of the list
		*/
		while (df1) {
			/* Find definition "df"
			*/
			if (df1->df_nextinscope == df) {
				/* It already was in the list. Remove it
				*/
				df1->df_nextinscope = df->df_nextinscope;
				break;
			}
			df1 = df1->df_nextinscope;
		}

		/* Now put it in front
		*/
		df->df_nextinscope = df->df_scope->sc_def;
		df->df_scope->sc_def = df;
	}
}

t_def *
MkDef(id, scope, kind)
	register t_idf *id;
	register t_scope *scope;
{
	/*	Create a new definition structure in scope "scope", with
		id "id" and kind "kind".
	*/
	register t_def *df;

	df = new_def();
	df->df_idf = id;
	df->df_scope = scope;
	df->df_kind = kind;
	df->df_next = id->id_def;
	id->id_def = df;
	if (kind == D_ERROR || kind == D_FORWARD) df->df_type = error_type;

	/* enter the definition in the list of definitions in this scope
	*/
	df->df_nextinscope = scope->sc_def;
	scope->sc_def = df;
	return df;
}

t_def *
define(id, scope, kind)
	register t_idf *id;
	register t_scope *scope;
	int kind;
{
	/*	Declare an identifier in a scope, but first check if it
		already has been defined.
		If so, then check for the cases in which this is legal,
		and otherwise give an error message.
	*/
	register t_def *df;

	df = lookup(id, scope, 1);
	if (	/* Already in this scope */
		df
	   ||	/* A closed scope, and id defined in the pervasive scope */
		( 
		  scopeclosed(scope)
		&&
		  (df = lookup(id, PervasiveScope, 1)))
	   ) {
		switch(df->df_kind) {
		case D_HIDDEN:
			/* An opaque type. We may now have found the
			   definition of this type.
			*/
			if (kind == D_TYPE && !DefinitionModule) {
				df->df_kind = D_TYPE;
				return df;
			}
			break;

		case D_FORWMODULE:
			/* A forward reference to a module. We may have found
			   another one, or we may have found the definition
			   for this module.
			*/
			if (kind == D_FORWMODULE) {
				return df;
			}

			if (kind == D_MODULE) {
				FreeNode(df->for_node);
				df->mod_vis = df->for_vis;
				df->df_kind = kind;
				DefInFront(df);
				return df;
			}
			break;

		case D_TYPE:
			if (kind == D_FORWTYPE) return df;
			break;
		case D_FORWTYPE:
			if (kind == D_FORWTYPE) return df;
			if (kind == D_TYPE) {
				df->df_kind = D_FTYPE;
			}
			else {
				error("identifier \"%s\" must be a type",
					id->id_text);
			}
			return df;

		case D_FORWARD:
			/* A forward reference, for which we may now have
			   found a definition.
			*/
			if (kind != D_FORWARD) {
				FreeNode(df->for_node);
			}

			/* Fall through */

		case D_ERROR:
			/* A definition generated by the compiler, because
			   it found an error. Maybe, the user gives a
			   definition after all.
			*/
			df->df_kind = kind;
			return df;
		}

		if (kind != D_ERROR) {
			/* Avoid spurious error messages
			*/
			error("identifier \"%s\" already declared",
			      id->id_text);
		}

		return df;
	}

	return MkDef(id, scope, kind);
}

RemoveImports(pdf)
	register t_def **pdf;
{
	/*	Remove all imports from a definition module. This is
		neccesary because the implementation module might import
		them again.
	*/
	register t_def *df = *pdf;

	while (df) {
		if (df->df_kind == D_IMPORT) {
			RemoveFromIdList(df);
			*pdf = df->df_nextinscope;
			free_def(df);
		}
		else {
			pdf = &(df->df_nextinscope);
		}
		df = *pdf;
	}
}

RemoveFromIdList(df)
	register t_def *df;
{
	/*	Remove definition "df" from the definition list
	*/
	register t_idf *id = df->df_idf;
	register t_def *df1;

	if ((df1 = id->id_def) == df) id->id_def = df->df_next;
	else {
		while (df1->df_next != df) {
			assert(df1->df_next != 0);
			df1 = df1->df_next;
		}
		df1->df_next = df->df_next;
	}
}

t_def *
DeclProc(type, id)
	register t_idf *id;
{
	/*	A procedure is declared, either in a definition or a program
		module. Create a def structure for it (if neccessary).
		Also create a name for it.
	*/
	register t_def *df;
	register t_scope *scope;
	extern char *sprint();
	static int nmcount;
	char buf[256];

	assert(type & (D_PROCEDURE | D_PROCHEAD));

	if (type == D_PROCHEAD) {
		/* In a definition module
		*/
		df = define(id, CurrentScope, type);
		df->for_node = dot2leaf(Name);
		if (CurrentScope->sc_definedby->df_flags & D_FOREIGN) {
			df->for_name = id->id_text;
		}
		else {
			sprint(buf,"%s_%s",CurrentScope->sc_name,id->id_text);
			df->for_name = Salloc(buf, (unsigned) (strlen(buf)+1));
		}
		if (CurrVis == Defined->mod_vis) {
			/* The current module will define this routine.
			   make sure the name is exported.
			*/
			C_exp(df->for_name);
		}
	}
	else {
		char *name;

		df = lookup(id, CurrentScope, 1);
		if (df && df->df_kind == D_PROCHEAD) {
			/* C_exp already generated when we saw the definition
			   in the definition module
			*/
			df->df_kind = D_PROCEDURE;
			name = df->for_name;
			DefInFront(df);
		}
		else {
			df = define(id, CurrentScope, type);
			sprint(buf,"_%d_%s",++nmcount,id->id_text);
			name = Salloc(buf, (unsigned)(strlen(buf)+1));
			if (options['x']) {
				C_exp(buf);
			}
			else	C_inp(buf);
		}
		open_scope(OPENSCOPE);
		scope = CurrentScope;
		scope->sc_name = name;
		scope->sc_definedby = df;
	}
	df->prc_vis = CurrVis;

	return df;
}

EndProc(df, id)
	register t_def *df;
	t_idf *id;
{
	/*	The end of a procedure declaration.
		Check that the closing identifier matches the name of the
		procedure, close the scope, and check that a function
		procedure has at least one RETURN statement.
	*/
	extern int return_occurred;

	match_id(id, df->df_idf);
	close_scope(SC_CHKFORW|SC_REVERSE);
	if (! return_occurred && ResultType(df->df_type)) {
		error("function procedure %s does not return a value",
		      df->df_idf->id_text);
	}
}

t_def *
DefineLocalModule(id)
	t_idf *id;
{
	/*	Create a definition for a local module. Also give it
		a name to be used for code generation.
	*/
	register t_def *df = define(id, CurrentScope, D_MODULE);
	register t_scope *sc;
	static int modulecount = 0;
	char buf[256];
	extern char *sprint();
	extern int proclevel;

	sprint(buf, "_%d%s", ++modulecount, id->id_text);

	if (!df->mod_vis) {	
		/* We never saw the name of this module before. Create a
		   scope for it.
		*/
	  	open_scope(CLOSEDSCOPE);
	  	df->mod_vis = CurrVis;
	}

	CurrVis = df->mod_vis;

	sc = CurrentScope;
	sc->sc_level = proclevel;
	sc->sc_definedby = df;
	sc->sc_name = Salloc(buf, (unsigned) (strlen(buf) + 1));

	/* Create a type for it
	*/
	df->df_type = standard_type(T_RECORD, 1, (arith) 0);
	df->df_type->rec_scope = sc;

	/* Generate code that indicates that the initialization procedure
	   for this module is local.
	*/
	if (options['x']) {
		C_exp(buf);
	}
	else	C_inp(buf);

	return df;
}

CheckWithDef(df, tp)
	register t_def *df;
	t_type *tp;
{
	/*	Check the header of a procedure declaration against a
		possible earlier definition in the definition module.
	*/

	if (df->df_type) {
		/* We already saw a definition of this type
		   in the definition module.
		*/
	  	if (!TstProcEquiv(tp, df->df_type)) {
			error("inconsistent procedure declaration for \"%s\"",
			      df->df_idf->id_text); 
		}
		FreeType(df->df_type);
	}
	df->df_type = tp;
}

#ifdef DEBUG
PrDef(df)
	register t_def *df;
{
	print("n: %s, k: %d\n", df->df_idf->id_text, df->df_kind);
}
#endif DEBUG