builtin.cc

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

		case TYPE_COMPLEX:
		case TYPE_DCOMPLEX:
			PRODBUILTIN_ACTION(dcomplex,CoerceToDcomplexArray)

		case TYPE_BOOL:
		case TYPE_BYTE:
		case TYPE_SHORT:
		case TYPE_INT:
		case TYPE_FLOAT:
		case TYPE_DOUBLE:
			PRODBUILTIN_ACTION(double,CoerceToDoubleArray)

		default:
			error->Report( "bad type in ProdBuiltIn::DoCall()" );
			return 0;
		}

	return result;
	}

Value* LengthBuiltIn::DoCall( const_args_list* args_val )
	{
	int num = args_val->length();

	if ( num > 1 )
		{
		int* len = new int[args_val->length()];
		loop_over_list( *args_val, i )
			len[i] = (*args_val)[i]->Length();
		return new Value( len, num );
		}

	else if ( num == 1 )
		return new Value( int( (*args_val)[0]->Length() ) );

	else
		return empty_value();
	}

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

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

#define RANGEBUILTIN_ACTION(tag,type,accessor,max)			\
	case tag:							\
		{							\
		type min_val = (type) max;				\
		type max_val = (type) -max;				\
									\
		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 )			\
				{					\
				if ( val_array[j] < min_val )		\
					min_val = val_array[j];		\
									\
				if ( val_array[j] > max_val )		\
					max_val = val_array[j];		\
				}					\
									\
			if ( is_copy )					\
				delete val_array;			\
			}						\
		type* range = new type[2];				\
		range[0] = min_val;					\
		range[1] = max_val;					\
									\
		result = new Value( range, 2 );				\
		}							\
			break;

	switch ( max_type )
		{
RANGEBUILTIN_ACTION(TYPE_DCOMPLEX,dcomplex,CoerceToDcomplexArray,HUGE)
RANGEBUILTIN_ACTION(TYPE_COMPLEX,complex,CoerceToComplexArray,MAXFLOAT)
RANGEBUILTIN_ACTION(TYPE_DOUBLE,double,CoerceToDoubleArray,HUGE)
RANGEBUILTIN_ACTION(TYPE_FLOAT,float,CoerceToFloatArray,MAXFLOAT)
		case TYPE_BOOL:
		case TYPE_BYTE:
		case TYPE_SHORT:
RANGEBUILTIN_ACTION(TYPE_INT,int,CoerceToIntArray,MAXINT)
		default:
			result = error_value();
		}

	return result;
	}

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

	if ( len == 0 || len > 3 )
		{
		error->Report( this, " takes from one to three arguments" );
		return error_value();
		}

	double starting_point = 1.0;
	double stopping_point;
	double stride = 1.0;

	const Value* arg;

	if ( len == 1 )
		{
		arg = (*args_val)[0];

		if ( arg->Length() != 1 )
			stopping_point = double( arg->Length() );
		else
			stopping_point = double( arg->IntVal() );
		}

	else
		{
		starting_point = (*args_val)[0]->DoubleVal();
		stopping_point = (*args_val)[1]->DoubleVal();

		if ( len == 3 )
			stride = (*args_val)[2]->DoubleVal();

		else if ( starting_point > stopping_point )
			stride = -1;
		}

	if ( stride == 0 )
		{
		error->Report( "in call to ", this, ", stride = 0" );
		return error_value();
		}

	if ( (starting_point < stopping_point && stride < 0) ||
	     (starting_point > stopping_point && stride > 0) )
		{
		error->Report( "in call to ", this,
				", stride has incorrect sign" );
		return error_value();
		}

	double range = stopping_point - starting_point;
	int num_vals = int( range / stride ) + 1;

	if ( num_vals > 1e6 )
		{
		error->Report( "ridiculously large sequence in call to ",
				this );
		return error_value();
		}

	double* result = new double[num_vals];

	double val = starting_point;
	for ( int i = 0; i < num_vals; ++i )
		{
		result[i] = val;
		val += stride;
		}

	Value* result_val = new Value( result, num_vals );

	if ( starting_point == double( int( starting_point ) ) &&
	     stopping_point == double( int( stopping_point ) ) &&
	     stride == double( int( stride ) )  )
		result_val->Polymorph( TYPE_INT );

	return result_val;
	}

Value* RepBuiltIn::DoCall( const_args_list* args_val )
	{
	const Value* element = (*args_val)[0];
	const Value* times = (*args_val)[1];

	if ( ! times->IsNumeric() )
		{
		error->Report( "non-numeric parameters invalid for", this );
		return error_value();
		}

	if ( times->Length() != 1 && times->Length() != element->Length() )
		{
		error->Report( this,
				": parameter vectors have unequal lengths" );
		return error_value();
		}

	int times_is_copy;
	int times_len = times->Length();
	int* times_vec = times->CoerceToIntArray( times_is_copy, times_len );

	for ( int x = 0; x < times_len; ++x )
		if ( times_vec[x] < 0 )
			{
			error->Report( "invalid replication parameter, 2nd (",
					times_vec[x], "), in ", this );
			if ( times_is_copy )
				delete times_vec;
			return error_value();
			}

	Value* ret = 0;
	if ( times_len > 1 )
		{
		// Here we know that BOTH the length of the element and the
		// length of the multiplier are greater than zero.
		int off = 0;
		int veclen = 0;

		for ( int i = 0; i < times_len; ++i )
			veclen += times_vec[i];

		switch ( element->Type() )
			{
#define REPBUILTIN_ACTION_A(tag,type,accessor,copy_func)			\
			case tag:					\
				{					\
				type* vec = new type[veclen];		\
				type* elm = element->accessor;			\
				for ( i=0; i < times_len; ++i )		\
					for ( int j=0; j < times_vec[i]; ++j )\
					  vec[off++] = copy_func( elm[i] );	\
				ret = new Value( vec, veclen );		\
				}					\
				break;

		REPBUILTIN_ACTION_A(TYPE_BOOL,glish_bool,BoolPtr(),)
		REPBUILTIN_ACTION_A(TYPE_BYTE,byte,BytePtr(),)
		REPBUILTIN_ACTION_A(TYPE_SHORT,short,ShortPtr(),)
		REPBUILTIN_ACTION_A(TYPE_INT,int,IntPtr(),)
		REPBUILTIN_ACTION_A(TYPE_FLOAT,float,FloatPtr(),)
		REPBUILTIN_ACTION_A(TYPE_DOUBLE,double,DoublePtr(),)
		REPBUILTIN_ACTION_A(TYPE_COMPLEX,complex,ComplexPtr(),)
		REPBUILTIN_ACTION_A(TYPE_DCOMPLEX,dcomplex,DcomplexPtr(),)
		REPBUILTIN_ACTION_A(TYPE_STRING,charptr,StringPtr(),strdup)

			default:
				error->Report(
					"bad type in RepBuiltIn::DoCall()" );
			}
		}
	else
		{
		int len = times_vec[0];

		if ( element->Length() == 1 )
			{
			switch ( element->Type() )
				{
#define REPBUILTIN_ACTION_B(tag,type,accessor,copy_func,CLEANUP_VAL)	\
				case tag:				\
					{				\
					type val = element->accessor();	\
					type *vec = new type[len];	\
					for (int i = 0; i < len; i++)	\
						vec[i] = copy_func(val);\
					ret = new Value( vec, len );	\
					CLEANUP_VAL			\
					}				\
					break;

			REPBUILTIN_ACTION_B(TYPE_BOOL,glish_bool,BoolVal,,)
			REPBUILTIN_ACTION_B(TYPE_BYTE,byte,ByteVal,,)
			REPBUILTIN_ACTION_B(TYPE_SHORT,short,ShortVal,,)
			REPBUILTIN_ACTION_B(TYPE_INT,int,IntVal,,)
			REPBUILTIN_ACTION_B(TYPE_FLOAT,float,FloatVal,,)
			REPBUILTIN_ACTION_B(TYPE_DOUBLE,double,DoubleVal,,)
			REPBUILTIN_ACTION_B(TYPE_COMPLEX,complex,ComplexVal,,)
			REPBUILTIN_ACTION_B(TYPE_DCOMPLEX,dcomplex,DcomplexVal,,)
			REPBUILTIN_ACTION_B(TYPE_STRING,charptr,StringVal,strdup,delete (char *)val;)

				default:
					error->Report(
					"bad type in RepBuiltIn::DoCall()" );
				}
			}
		else
			{
			int off = 0;
			int repl = times_vec[0];
			int e_len = element->Length();
			int veclen = e_len * repl;

			switch ( element->Type() )
				{
#define REPBUILTIN_ACTION_C(tag,type,accessor,copy_func)		\
			case tag:					\
				{					\
				type* val = element->accessor;		\
				type* vec = new type[veclen];		\
				for ( int j = 0; j < repl; ++j )	\
					for ( int i = 0; i < e_len; ++i )\
						vec[off++] =  copy_func(val[i]);\
				ret = new Value( vec, veclen );		\
				}					\
				break;

	REPBUILTIN_ACTION_C(TYPE_BOOL,glish_bool,BoolPtr(),)
	REPBUILTIN_ACTION_C(TYPE_BYTE,byte,BytePtr(),)
	REPBUILTIN_ACTION_C(TYPE_SHORT,short,ShortPtr(),)
	REPBUILTIN_ACTION_C(TYPE_INT,int,IntPtr(),)
	REPBUILTIN_ACTION_C(TYPE_FLOAT,float,FloatPtr(),)
	REPBUILTIN_ACTION_C(TYPE_DOUBLE,double,DoublePtr(),)
	REPBUILTIN_ACTION_C(TYPE_COMPLEX,complex,ComplexPtr(),)
	REPBUILTIN_ACTION_C(TYPE_DCOMPLEX,dcomplex,DcomplexPtr(),)
	REPBUILTIN_ACTION_C(TYPE_STRING,charptr,StringPtr(),strdup)

				default:
					error->Report(
					"bad type in RepBuiltIn::DoCall()" );
				}
			}
		}

	if ( times_is_copy )
		delete times_vec;

	return ret ? ret : error_value();
	}

Value* NumArgsBuiltIn::DoCall( const_args_list* args_val )
	{
	return new Value( args_val->length() );
	}

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

	if ( len <= 0 )
		{
		error->Report( "first argument missing in call to", this );
		return error_value();
		}

	int n = (*args_val)[0]->IntVal();

	if ( n < 0 || n >= len )
		{
		error->Report( "first argument (=", n, ") to", this,
				" out of range: ", len - 1,
				"additional arguments supplied" );
		return error_value();
		}

	return copy_value( (*args_val)[n] );
	}

Value* MissingBuiltIn::DoCall( const_args_list* /* args_val */ )
	{
	Frame* cur = sequencer->CurrentFrame();
	if ( ! cur )
		return empty_value();

	return copy_value( cur->Missing() );
	}


Value* PasteBuiltIn::DoCall( const_args_list* args_val )
	{
	if ( args_val->length() == 0 )
		{
		error->Report( "paste() invoked with no arguments" );
		return error_value();
		}

	// First argument gives separator string.
	char* separator = (*args_val)[0]->StringVal();

	charptr* string_vals = new charptr[args_val->length()];

	int len = 1;	// Room for end-of-string.
	int sep_len = strlen( separator );

	for ( int i = 1; i < args_val->length(); ++i )
		{
		string_vals[i] = (*args_val)[i]->StringVal( ' ', 1 );
		len += strlen( string_vals[i] ) + sep_len;
		}

	char* paste_val = new char[len];
	paste_val[0] = '\0';

	for ( int j = 1; j < i; ++j )
		{
		strcat( paste_val, string_vals[j] );

		if ( j < i - 1 )
			strcat( paste_val, separator );

		delete (char*) string_vals[j];
		}

	delete string_vals;
	delete separator;

	charptr* result = new charptr[1];
	result[0] = paste_val;

	return new Value( result, 1 );
	}

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

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

	char* source = (*args_val)[0]->StringVal();

	char* split_chars = " \t\n";
	if ( len == 2 )
		split_chars = (*args_val)[1]->StringVal();

	Value* result = split( source, split_chars );

	delete source;
	if ( len == 2 )
		delete split_chars;

	return result;
	}


Value* ReadValueBuiltIn::DoCall( const_args_list* args_val )
	{
	char* file_name = (*args_val)[0]->StringVal();

	int sds = (int) sds_access( file_name, SDS_FILE, SDS_READ );

	Value* result;

	if ( sds < 0 )
		{
		error->Report( "could not read value from \"", file_name,
				"\"" );
		result = error_value();
		}

	else
		result = read_value_from_SDS( sds );

	delete file_name;

	return result;
	}


Value* WriteValueBuiltIn::DoCall( const_args_list* args_val )
	{
	char* file_name = (*args_val)[1]->StringVal();
	const Value* v = (*args_val)[0];

	int result = 1;

	if ( v->Type() == TYPE_OPAQUE )
		{
		int sds = v->SDS_IndexVal();

		if ( sds_ass( sds, file_name, SDS_FILE ) != sds )
			{
			error->Report( "could not save opaque value to \"",
					file_name, "\"" );
			result = 0;
			}