builtin.cc

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

// $Header: /cvsroot/sourcenav/src/snavigator/demo/c++_demo/glish/BuiltIn.cc,v 1.1.1.1 2002/04/18 23:35:16 mdejong Exp $

#include <string.h>
#include <stream.h>
#include <stdlib.h>
#include <math.h>

// For MAXINT, MAXFLOAT, HUGE.
#include <values.h>

#include "Sds/sdsgen.h"
#include "glish_event.h"
#include "BuiltIn.h"
#include "Reporter.h"
#include "Task.h"
#include "Sequencer.h"
#include "Frame.h"

#if !defined(HUGE) /* this because it's not defined in the vxworks includes */
#define HUGE (infinity())
#define MAXINT 0x7fffffff

// Half-assed guess.
#define MAXFLOAT 1e38
#endif


Value* BuiltIn::Call( parameter_list* args, eval_type etype )
	{
	if ( num_args != NUM_ARGS_VARIES )
		{
		int num_args_present = 0;

		loop_over_list( *args, i )
			{
			if ( (*args)[i]->IsEllipsis() )
				num_args_present +=
					(*args)[i]->NumEllipsisVals();
			else
				++num_args_present;
			}

		if ( num_args_present != num_args )
			{
			error->Report( this, " takes", num_args, " argument",
					num_args == 1 ? ";" : "s;",
					num_args_present, " given" );

			return error_value();
			}
		}

	loop_over_list( *args, j )
		{
		Parameter* arg = (*args)[j];
		if ( ! arg->Arg() )
			{
			error->Report( "missing parameter invalid for", this );
			return error_value();
			}
		if ( arg->Name() )
			{
			error->Report( this,
					" does not have a parameter named \"",
					arg->Name(), "\"" );
			return error_value();
			}
		}

	const_args_list* args_vals = new const_args_list;

	int do_call = 1;

	loop_over_list( *args, i )
		{
		Parameter* arg = (*args)[i];
		const Value* arg_val;

		if ( arg->IsEllipsis() )
			{
			int len = arg->NumEllipsisVals();

			for ( int j = 0; j < len; ++j )
				{
				arg_val = arg->NthEllipsisVal( j );
				if ( do_deref )
					arg_val = arg_val->Deref();

				args_vals->append( arg_val );
				}
			}

		else
			{
			arg_val = arg->Arg()->ReadOnlyEval();
			if ( do_deref )
				arg_val = arg_val->Deref();

			args_vals->append( arg_val );
			}
		}

	Value* result;

	if ( do_call )
		{
		if ( etype == EVAL_SIDE_EFFECTS )
			{
			int side_effects_okay = 0;
			DoSideEffectsCall( args_vals, side_effects_okay );

			if ( ! side_effects_okay )
				warn->Report( "function return value ignored:",
						this );

			result = 0;
			}

		else
			result = DoCall( args_vals );
		}
	else
		result = error_value();

	loop_over_list( *args, k )
		{
		if ( ! (*args)[k]->IsEllipsis() )
			(*args)[k]->Arg()->ReadOnlyDone( (*args_vals)[k] );
		}

	delete args_vals;

	return result;
	}

void BuiltIn::DoSideEffectsCall( const_args_list* args_vals,
				int& side_effects_okay )
	{
	side_effects_okay = side_effects_call_okay;
	Unref( DoCall( args_vals ) );
	}

void BuiltIn::DescribeSelf( ostream& s ) const
	{
	s << description << "()";
	}

int BuiltIn::AllNumeric( const_args_list* args_vals, glish_type& max_type,
	int strings_okay )
	{
	max_type = TYPE_STRING;

	loop_over_list( *args_vals, i )
		{
		const Value* arg = (*args_vals)[i];

		if ( arg->IsNumeric() )
			{
			max_type = max_numeric_type( max_type, arg->Type() );
			continue;
			}

		if ( strings_okay && arg->Type() == TYPE_STRING )
			continue;

		error->Report( "argument #", i + 1, "to", this,
			"is not numeric", strings_okay ? " or a string" : "" );
		return 0;
		}

	return 1;
	}


Value* OneValueArgBuiltIn::DoCall( const_args_list* args_val )
	{
	return (*func)( (*args_val)[0] );
	}


Value* NumericVectorBuiltIn::DoCall( const_args_list* args_val )
	{
	const Value* arg = (*args_val)[0];
	Value* result;

	if ( ! arg->IsNumeric() )
		{
		error->Report( this, " requires a numeric argument" );
		return error_value();
		}

	int len = arg->Length();
	glish_type type = arg->Type();

#define NUMERIC_BUILTIN_ACTION(type,accessor,fn)	\
	{						\
	int is_copy;					\
	type* args_vec = arg->accessor( is_copy, len );	\
	type* stor = new type[len];			\
							\
	for ( int i = 0; i < len; ++i )			\
		stor[i] = (*fn)( args_vec[i] );		\
							\
	if ( is_copy )					\
		delete args_vec;			\
							\
	result = new Value( stor, len );		\
	result->CopyAttributes( arg );			\
	}

	if ( type == TYPE_COMPLEX || type == TYPE_DCOMPLEX )
		NUMERIC_BUILTIN_ACTION(dcomplex,CoerceToDcomplexArray,cfunc)
	else
		NUMERIC_BUILTIN_ACTION(double,CoerceToDoubleArray,func)

	return result;
	}

Value* RealBuiltIn::DoCall( const_args_list* args_val )
	{
	const Value* v = (*args_val)[0];

	if ( ! v->IsNumeric() )
		{
		error->Report( this, " requires a numeric argument" );
		return error_value();
		}

	Value* result;

#define RE_IM_BUILTIN_ACTION(tag,type,subtype,accessor,elem)	\
	case tag:						\
		{						\
		int is_copy;					\
		int len = v->Length();				\
		subtype* stor = new subtype[len];		\
		type* from = v->accessor( is_copy, len );	\
		for ( int i = 0; i < len; i++ )			\
			stor[i] = from[i] elem;			\
		if ( is_copy )					\
			delete from;				\
		result = new Value( stor, len );		\
		result->CopyAttributes( v );			\
		}						\
		break;

	switch ( v->Type() )
		{
RE_IM_BUILTIN_ACTION(TYPE_COMPLEX,complex,float,CoerceToComplexArray,.r)
RE_IM_BUILTIN_ACTION(TYPE_DCOMPLEX,dcomplex,double,CoerceToDcomplexArray,.r)

		default:
			result = copy_value(v);
		}

	return result;
	}

Value* ImagBuiltIn::DoCall( const_args_list* args_val )
	{
	const Value* v = (*args_val)[0];

	if ( ! v->IsNumeric() )
		{
		error->Report( this, " requires a numeric argument" );
		return error_value();
		}

	Value* result;

	switch ( v->Type() )
		{
RE_IM_BUILTIN_ACTION(TYPE_COMPLEX,complex,float,CoerceToComplexArray,.i)
RE_IM_BUILTIN_ACTION(TYPE_DCOMPLEX,dcomplex,double,CoerceToDcomplexArray,.i)

		default:
			result = new Value( 0.0 );
		}

	return result;
	}

Value* ComplexBuiltIn::DoCall( const_args_list* args_val )
	{
	int len = args_val->length();
	Value* result;

	if ( len < 1 || len > 2 )
		{
		error->Report( this, " takes 1 or 2 arguments" );
		return error_value();
		}

	if ( len == 2 )
		{
		const Value* rv = (*args_val)[0];
		const Value* iv = (*args_val)[1];

		if ( ! rv->IsNumeric() || ! iv->IsNumeric() )
			{
			error->Report( this,
				" requires one or two numeric arguments" );
			return error_value();
			}

		int rlen = rv->Length();
		int ilen = iv->Length();

		int rscalar = rlen == 1;
		int iscalar = ilen == 1;

		if ( rlen != ilen && ! rscalar && ! iscalar )
			{
			error->Report(
				"different-length operands in expression (",
					rlen, " vs. ", ilen, "):\n\t",
					this );
			return error_value();
			}

		glish_type maxt = max_numeric_type( rv->Type(), iv->Type() );

#define COMPLEXBUILTIN_TWOPARM_ACTION(tag,type,rettype,accessor,coerce)	\
	case tag:							\
		{							\
		int r_is_copy;						\
		int i_is_copy;						\
		int maxlen = rlen > ilen ? rlen : ilen;			\
		rettype* r = rv->accessor( r_is_copy, rlen );		\
		rettype* i = iv->accessor( i_is_copy, ilen );		\
		type* stor = new type[maxlen];				\
		for ( int cnt = 0; cnt < maxlen; ++cnt )		\
			{						\
			stor[cnt].r = coerce( r[rscalar ? 0 : cnt] );	\
			stor[cnt].i = coerce( i[iscalar ? 0 : cnt] );	\
			}						\
		if ( r_is_copy )					\
			delete r;					\
		if ( i_is_copy )					\
			delete i;					\
		result = new Value( stor, maxlen );			\
		}							\
		break;

		switch ( maxt )
			{
COMPLEXBUILTIN_TWOPARM_ACTION(TYPE_BOOL,complex,glish_bool,
	CoerceToBoolArray,float)
COMPLEXBUILTIN_TWOPARM_ACTION(TYPE_BYTE,complex,byte,CoerceToByteArray,float)
COMPLEXBUILTIN_TWOPARM_ACTION(TYPE_SHORT,complex,short,CoerceToShortArray,float)
COMPLEXBUILTIN_TWOPARM_ACTION(TYPE_INT,complex,int,CoerceToIntArray,float)
COMPLEXBUILTIN_TWOPARM_ACTION(TYPE_FLOAT,complex,float,CoerceToFloatArray,)
COMPLEXBUILTIN_TWOPARM_ACTION(TYPE_DOUBLE,dcomplex,double,CoerceToDoubleArray,)

			case TYPE_COMPLEX:
			case TYPE_DCOMPLEX:
				if ( rv->Type() == TYPE_COMPLEX ||
				     rv->Type() == TYPE_DCOMPLEX )
					result = copy_value( rv );
				else
					result = copy_value( iv );
				break;

			default:
				result = error_value();
			}
		}

	else
		{
		const Value* v = (*args_val)[0];

		if ( ! v->IsNumeric() )
			{
			error->Report( this,
				" requires one or two numeric arguments" );
			return error_value();
			}

#define COMPLEXBUILTIN_ONEPARM_ACTION(tag,type,rettype,accessor,coerce)	\
	case tag:						\
		{						\
		int is_copy;					\
		int vlen = v->Length();				\
		rettype* vp = v->accessor( is_copy, vlen );	\
		type* stor = new type[vlen];			\
		for ( int cnt = 0; cnt < vlen; ++cnt )		\
			{					\
			stor[cnt].r = coerce( vp[cnt] );	\
			stor[cnt].i = 0;			\
			}					\
		if ( is_copy )					\
			delete vp;				\
		result = new Value( stor, vlen );			\
		}						\
		break;

		switch ( v->Type() )
			{
COMPLEXBUILTIN_ONEPARM_ACTION(TYPE_BOOL,complex,glish_bool,
	CoerceToBoolArray,float)
COMPLEXBUILTIN_ONEPARM_ACTION(TYPE_BYTE,complex,byte,CoerceToByteArray,float)
COMPLEXBUILTIN_ONEPARM_ACTION(TYPE_SHORT,complex,short,CoerceToShortArray,float)
COMPLEXBUILTIN_ONEPARM_ACTION(TYPE_INT,complex,int,CoerceToIntArray,float)
COMPLEXBUILTIN_ONEPARM_ACTION(TYPE_FLOAT,complex,float,CoerceToFloatArray,)
COMPLEXBUILTIN_ONEPARM_ACTION(TYPE_DOUBLE,dcomplex,double,CoerceToDoubleArray,)

			case TYPE_COMPLEX:
			case TYPE_DCOMPLEX:
				result = copy_value( v );
				break;

			default:
				result = error_value();
			}
		}

	return result;
	}

Value* SumBuiltIn::DoCall( const_args_list* args_val )
	{
	glish_type max_type;
	Value* result;

	if ( ! AllNumeric( args_val, max_type ) )
		return error_value();

#define SUM_BUILTIN_ACTION(type,accessor)			\
	{							\
	type sum = 0.0;						\
	loop_over_list( *args_val, i )				\
		{						\
		const Value* val = (*args_val)[i];		\
		int len = val->Length();			\
		int is_copy;					\
		type* val_array = val->accessor(is_copy,len);	\
		for ( int j = 0; j < len; ++j )			\
			sum += val_array[j];			\
		if ( is_copy )					\
			delete val_array;			\
		}						\
	result = new Value( sum );				\
	}

	if ( max_type == TYPE_COMPLEX || max_type == TYPE_DCOMPLEX )
		SUM_BUILTIN_ACTION(dcomplex,CoerceToDcomplexArray)
	else
		SUM_BUILTIN_ACTION(double,CoerceToDoubleArray)

	return result;
	}

Value* ProdBuiltIn::DoCall( const_args_list* args_val )
	{
	glish_type max_type;
	Value* result;

	if ( ! AllNumeric( args_val, max_type ) )
		return error_value();

	switch ( max_type )
		{
#define PRODBUILTIN_ACTION(type,accessor)				\
		{							\
		type prod = 1.0;					\
		loop_over_list( *args_val, i )				\
			{						\
			const Value* val = (*args_val)[i];		\
			int len = val->Length();			\
			int is_copy;					\
			type* val_array = val->accessor(is_copy, len);	\
			for ( int j = 0; j < len; ++j )			\
				prod *= val_array[j];			\
			if ( is_copy )					\
				delete val_array;			\
			}						\
		result = new Value( prod );				\
		break;							\
		}