builtin.cc

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

		}

	else
		{
		int sds = (int) sds_new( (char*) "" );

		if ( sds < 0 )
			{
			error->Report( "problem saving value to \"", file_name,
					"\", SDS error code = ", sds );
			result = 0;
			}

		else
			{
			del_list d;

			(*args_val)[0]->AddToSds( sds, &d );

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

			sds_destroy( sds );

			delete_list( &d );
			}
		}

	delete file_name;

	return new Value( result );
	}


Value* WheneverStmtsBuiltIn::DoCall( const_args_list* args_val )
	{
	Agent* agent = (*args_val)[0]->AgentVal();

	if ( ! agent )
		return error_value();

	else
		return agent->AssociatedStatements();
	}


Value* ActiveAgentsBuiltIn::DoCall( const_args_list* /* args_val */ )
	{
	Value* r = create_record();

	loop_over_list( agents, i )
		{
		Value* a = agents[i]->AgentRecord();
		r->SetField( r->NewFieldName(), new Value( a, VAL_REF ) );
		}

	return r;
	}


Value* CreateAgentBuiltIn::DoCall( const_args_list* /* args_val */ )
	{
	Agent* user_agent = new UserAgent( sequencer );
	return user_agent->AgentRecord();
	}


Value* CurrentWheneverBuiltIn::DoCall( const_args_list* /* args_val */ )
	{
	Notification* n = sequencer->LastNotification();

	if ( ! n )
		{
		error->Report( "no active whenever, in call to", this );
		return new Value( 0 );
		}

	return new Value( n->notifiee->stmt->Index() );
	}

Value* LastWheneverExecutedBuiltIn::DoCall( const_args_list* /* args_val */ )
	{
	Stmt* s = sequencer->LastWheneverExecuted();

	if ( ! s )
		{
		error->Report( "no whenever's executed, in call to", this );
		return new Value( 0 );
		}

	return new Value( s->Index() );
	}


#define DEFINE_AS_XXX_BUILT_IN(name,type,tag,stringcvt,coercer,text,zero) \
Value* name( const Value* arg )						\
	{								\
	int len = arg->Length();					\
									\
	if ( arg->Type() == TYPE_STRING )				\
		{							\
		const charptr* strings = arg->StringPtr();		\
		type* result = new type[len];				\
									\
		for ( int i = 0; i < len; ++i )				\
			result[i] = stringcvt( strings[i] );		\
									\
		return new Value( result, len );			\
		}							\
									\
	if ( ! arg->IsNumeric() )					\
		{							\
		error->Report( "non-numeric argument to ", text );	\
		return new Value( type(zero) );				\
		}							\
									\
	if ( arg->Type() == tag )					\
		return copy_value( arg );				\
									\
	int is_copy;							\
	type* result = arg->coercer( is_copy, len );			\
									\
	Value* ret = new Value( result, len );				\
	ret->CopyAttributes( arg );					\
	return ret;							\
	}

glish_bool string_to_bool( const char* string )
	{
	int successful;
	double d = text_to_double( string, successful );
	if ( successful )
		return glish_bool( int( d ) );
	else
		return glish_false;
	}

DEFINE_AS_XXX_BUILT_IN(as_boolean_built_in, glish_bool, TYPE_BOOL,
	string_to_bool, CoerceToBoolArray, "as_boolean", glish_false)

DEFINE_AS_XXX_BUILT_IN(as_short_built_in, short, TYPE_SHORT, atoi,
	CoerceToShortArray, "as_short", 0)

DEFINE_AS_XXX_BUILT_IN(as_integer_built_in, int, TYPE_INT, atoi,
	CoerceToIntArray, "as_integer", 0)

DEFINE_AS_XXX_BUILT_IN(as_float_built_in, float, TYPE_FLOAT, atof,
	CoerceToFloatArray, "as_float", 0.0)

DEFINE_AS_XXX_BUILT_IN(as_double_built_in, double, TYPE_DOUBLE, atof,
	CoerceToDoubleArray, "as_double", 0.0)

DEFINE_AS_XXX_BUILT_IN(as_complex_built_in, complex, TYPE_COMPLEX, atocpx,
	CoerceToComplexArray, "as_complex", complex(0.0, 0.0))

DEFINE_AS_XXX_BUILT_IN(as_dcomplex_built_in, dcomplex, TYPE_DCOMPLEX, atodcpx,
	CoerceToDcomplexArray, "as_dcomplex", dcomplex(0.0, 0.0))

Value* as_byte_built_in( const Value* arg )
	{
	if ( arg->Type() == TYPE_STRING )
		{
		char* arg_str = arg->StringVal();
		int len = strlen( arg_str );
		byte* result = new byte[len];

		for ( int i = 0; i < len; ++i )
			result[i] = byte(arg_str[i]);

		delete arg_str;

		return new Value( result, len );
		}

	int len = arg->Length();
	if ( ! arg->IsNumeric() )
		{
		error->Report( "non-numeric argument to ", "byte" );
		return new Value( byte(0) );
		}

	if ( arg->Type() == TYPE_BYTE )
		return copy_value( arg );

	int is_copy;
	byte* result = arg->CoerceToByteArray( is_copy, len );

	return new Value( result, len );
	}


Value* as_string_built_in( const Value* arg )
	{
	if ( arg->Type() == TYPE_STRING )
		return copy_value( arg );

	if ( ! arg->IsNumeric() )
		{
		error->Report( "non-numeric argument to as_string()" );
		return new Value( "" );
		}

	int len = arg->Length();

	if ( arg->Type() == TYPE_BYTE )
		{
		byte* vals = arg->BytePtr();
		char* s = new char[len+1];

		for ( int i = 0; i < len; ++i )
			s[i] = char(vals[i]);

		s[i] = '\0';

		Value* result = new Value( s );
		delete s;

		return result;
		}

	charptr* result = new charptr[len];
	int i;
	char buf[256];

	switch ( arg->Type() )
		{
		case TYPE_BOOL:
			{
			glish_bool* vals = arg->BoolPtr();
			for ( i = 0; i < len; ++i )
				result[i] = strdup( vals[i] ? "T" : "F" );
			}
			break;

#define COMMA_SEPARATED_SERIES(x,y) x,y
#define COERCE_XXX_TO_STRING(tag,type,accessor,format,rest)		\
	case tag:							\
		{							\
		type* vals = arg->accessor();				\
		for ( i = 0; i < len; ++i )				\
			{						\
			sprintf( buf, format, vals[i] rest );		\
			result[i] = strdup( buf );			\
			}						\
		}							\
		break;

		COERCE_XXX_TO_STRING(TYPE_SHORT,short,ShortPtr,"%d",)
		COERCE_XXX_TO_STRING(TYPE_INT,int,IntPtr,"%d",)
		COERCE_XXX_TO_STRING(TYPE_FLOAT,float,FloatPtr,"%.6g",)
		COERCE_XXX_TO_STRING(TYPE_DOUBLE,double,DoublePtr,"%.12g",)
		COERCE_XXX_TO_STRING(TYPE_COMPLEX,complex,ComplexPtr,(vals[i].i>=0.0?"%.6g+%.6g":"%.6g%.6g"),COMMA_SEPARATED_SERIES(.r,vals[i].i))
		COERCE_XXX_TO_STRING(TYPE_DCOMPLEX,dcomplex,DcomplexPtr,(vals[i].i>=0.0?"%.12g+%.12g":"%.12g%.12g"),COMMA_SEPARATED_SERIES(.r,vals[i].i))

		default:
			fatal->Report( "bad type tag in as_string()" );
		}

	return new Value( result, len );
	}


Value* type_name_built_in( const Value* arg )
	{
	glish_type t = arg->Type();

	if ( t == TYPE_REF || t == TYPE_CONST )
		{
		Value* deref_val = type_name_built_in( arg->RefPtr() );
		char* deref_name = deref_val->StringVal();

		char buf[512];

		sprintf( buf, "%s %s", t == TYPE_REF ? "ref" : "const",
			deref_name );

		delete deref_name;
		Unref( deref_val );

		return new Value( buf );
		}

	if ( arg->IsVecRef() )
		t = arg->VecRefDeref()->Type();

	return new Value( type_names[t] );
	}

Value* length_built_in( const Value* arg )
	{
	return new Value( int( arg->Length() ) );
	}

Value* field_names_built_in( const Value* arg )
	{
	if ( arg->Type() != TYPE_RECORD )
		{
		error->Report( "argument to field_names is not a record" );
		return error_value();
		}

	recordptr record_dict = arg->RecordPtr();
	IterCookie* c = record_dict->InitForIteration();

	charptr* names = new charptr[record_dict->Length()];
	const char* key;

	for ( int i = 0; record_dict->NextEntry( key, c ); ++i )
		names[i] = strdup( key );

	return new Value( names, i );
	}


char* paste( parameter_list* args )
	{
	PasteBuiltIn paste;

	// Create another parameter list with the separator at the
	// beginning.
	parameter_list args2;
	Value sep( " " );
	ConstExpr sep_expr( &sep );
	Parameter sep_parm( 0, VAL_CONST, &sep_expr );

	args2.append( &sep_parm );

	loop_over_list( *args, i )
		args2.append( (*args)[i] );

	Value* args_value = paste.Call( &args2, EVAL_COPY );

	// ### could save on some string copies here by returning the
	// value instead, and using StringPtr() instead of StringVal()
	// to get its string value.
	char* result = args_value->StringVal();
	Unref( args_value );

	return result;
	}


char* paste( const_args_list* args )
	{
	PasteBuiltIn paste;

	// Create another args list with the separator at the beginning.
	const_args_list args2;
	Value sep( " " );
	args2.append( &sep );

	loop_over_list( *args, i )
		args2.append( (*args)[i] );

	Value* args_value = paste.DoCall( &args2 );
	char* result = args_value->StringVal();
	Unref( args_value );

	return result;
	}


Value* split( char* source, char* split_chars )
	{
	// First see how many pieces the split will result in.
	int num_pieces = 0;
	char* source_copy = strdup( source );
	charptr next_string = strtok( source_copy, split_chars );
	while ( next_string )
		{
		++num_pieces;
		next_string = strtok( 0, split_chars );
		}
	delete source_copy;

	charptr* strings = new charptr[num_pieces];
	charptr* sptr = strings;
	next_string = strtok( source, split_chars );
	while ( next_string )
		{
		*(sptr++) = strdup( next_string );
		next_string = strtok( 0, split_chars );
		}

	return new Value( strings, num_pieces );
	}


static void add_one_arg_built_in( Sequencer* s, value_func_1_value_arg func,
					const char* name, int do_deref = 1 )
	{
	BuiltIn* b = new OneValueArgBuiltIn( func, name );
	b->SetDeref( do_deref );
	s->AddBuiltIn( b );
	}

//
//### Dummy complex functions
//	These should be supplied later, probably from the `fn' library
//	on `netlib'.
//
dcomplex asin( const dcomplex )
	{
	error->Report( "Sorry, complex arcsine not yet implemented" );
	return dcomplex( 0, 0 );
	}
dcomplex acos( const dcomplex )
	{
	error->Report( "Sorry, complex arccosine not yet implemented" );
	return dcomplex( 0, 0 );
	}
dcomplex atan( const dcomplex )
	{
	error->Report( "Sorry, complex arctangent not yet implemented" );
	return dcomplex( 0, 0 );
	}

void create_built_ins( Sequencer* s )
	{
	add_one_arg_built_in( s, as_boolean_built_in, "as_boolean" );
	add_one_arg_built_in( s, as_byte_built_in, "as_byte" );
	add_one_arg_built_in( s, as_short_built_in, "as_short" );
	add_one_arg_built_in( s, as_integer_built_in, "as_integer" );
	add_one_arg_built_in( s, as_float_built_in, "as_float" );
	add_one_arg_built_in( s, as_double_built_in, "as_double" );
	add_one_arg_built_in( s, as_complex_built_in, "as_complex" );
	add_one_arg_built_in( s, as_dcomplex_built_in, "as_dcomplex" );
	add_one_arg_built_in( s, as_string_built_in, "as_string" );

	add_one_arg_built_in( s, type_name_built_in, "type_name", 0 );
	add_one_arg_built_in( s, field_names_built_in, "field_names" );

	s->AddBuiltIn( new NumericVectorBuiltIn( sqrt, sqrt, "sqrt" ) );
	s->AddBuiltIn( new NumericVectorBuiltIn( exp, exp, "exp" ) );
	s->AddBuiltIn( new NumericVectorBuiltIn( log, log, "log" ) );
	s->AddBuiltIn( new NumericVectorBuiltIn( sin, sin, "sin" ) );
	s->AddBuiltIn( new NumericVectorBuiltIn( cos, cos, "cos" ) );
	s->AddBuiltIn( new NumericVectorBuiltIn( tan, tan, "tan" ) );
	s->AddBuiltIn( new NumericVectorBuiltIn( asin, asin, "asin" ) );
	s->AddBuiltIn( new NumericVectorBuiltIn( acos, acos, "acos" ) );
	s->AddBuiltIn( new NumericVectorBuiltIn( atan, atan, "atan" ) );

	s->AddBuiltIn( new RealBuiltIn );
	s->AddBuiltIn( new ImagBuiltIn );
	s->AddBuiltIn( new ComplexBuiltIn );

	s->AddBuiltIn( new SumBuiltIn );
	s->AddBuiltIn( new ProdBuiltIn );
	s->AddBuiltIn( new LengthBuiltIn );
	s->AddBuiltIn( new RangeBuiltIn );
	s->AddBuiltIn( new SeqBuiltIn );
	s->AddBuiltIn( new RepBuiltIn );
	s->AddBuiltIn( new NumArgsBuiltIn );
	s->AddBuiltIn( new NthArgBuiltIn );
	s->AddBuiltIn( new MissingBuiltIn( s ) );

	s->AddBuiltIn( new PasteBuiltIn );
	s->AddBuiltIn( new SplitBuiltIn );

	s->AddBuiltIn( new ReadValueBuiltIn );
	s->AddBuiltIn( new WriteValueBuiltIn );

	s->AddBuiltIn( new WheneverStmtsBuiltIn );

	s->AddBuiltIn( new ActiveAgentsBuiltIn );

	s->AddBuiltIn( new CreateAgentBuiltIn( s ) );
	s->AddBuiltIn( new CreateTaskBuiltIn( s ) );

	s->AddBuiltIn( new LastWheneverExecutedBuiltIn( s ) );
	s->AddBuiltIn( new CurrentWheneverBuiltIn( s ) );

	sds_init();
	}