/tags/SN-NG4.1/snavigator/demo/c++/glish/Value.cc
C++ | 2024 lines | 1668 code | 309 blank | 47 comment | 299 complexity | 31fa4c309afeaf373a199cffb3d261aa MD5 | raw file
- // $Header$
- #include "system.h"
- #include <string.h>
- #include <stream.h>
- #include <stdlib.h>
- #include "Sds/sdsgen.h"
- #include "Glish/Value.h"
- #include "glish_event.h"
- #include "BinOpExpr.h"
- #include "Func.h"
- #include "Reporter.h"
- int num_Values_created = 0;
- int num_Values_deleted = 0;
- const char* type_names[NUM_GLISH_TYPES] =
- {
- "error", "ref", "const", "subref", "subconst",
- "boolean", "byte", "short", "integer",
- "float", "double", "string", "agent", "function", "record",
- "complex", "dcomplex", "opaque",
- };
- const Value* false_value;
- #define AGENT_MEMBER_NAME "*agent*"
- class SDS_ValueManager : public GlishObject {
- public:
- SDS_ValueManager( int sds_index ) { sds = sds_index; }
- ~SDS_ValueManager()
- {
- sds_destroy( sds );
- sds_discard( sds );
- }
- protected:
- int sds;
- };
- class DelObj : public GlishObject {
- public:
- DelObj( GlishObject* arg_obj ) { obj = arg_obj; ptr = 0; }
- DelObj( void* arg_ptr ) { obj = 0; ptr = arg_ptr; }
- ~DelObj();
- protected:
- GlishObject* obj;
- void* ptr;
- };
- DelObj::~DelObj()
- {
- Unref( obj );
- delete ptr;
- }
- #define DEFINE_SINGLETON_CONSTRUCTOR(constructor_type) \
- Value::Value( constructor_type value ) \
- { \
- InitValue(); \
- SetValue( &value, 1, COPY_ARRAY ); \
- }
- #define DEFINE_ARRAY_CONSTRUCTOR(constructor_type) \
- Value::Value( constructor_type value[], int len, array_storage_type storage )\
- { \
- InitValue(); \
- SetValue( value, len, storage ); \
- }
- #define DEFINE_ARRAY_REF_CONSTRUCTOR(constructor_type) \
- Value::Value( constructor_type& value_ref ) \
- { \
- InitValue(); \
- SetValue( value_ref ); \
- }
- #define DEFINE_CONSTRUCTORS(type,reftype) \
- DEFINE_SINGLETON_CONSTRUCTOR(type) \
- DEFINE_ARRAY_CONSTRUCTOR(type) \
- DEFINE_ARRAY_REF_CONSTRUCTOR(reftype)
- DEFINE_CONSTRUCTORS(glish_bool,glish_boolref)
- DEFINE_CONSTRUCTORS(byte,byteref)
- DEFINE_CONSTRUCTORS(short,shortref)
- DEFINE_CONSTRUCTORS(int,intref)
- DEFINE_CONSTRUCTORS(float,floatref)
- DEFINE_CONSTRUCTORS(double,doubleref)
- DEFINE_CONSTRUCTORS(complex,complexref)
- DEFINE_CONSTRUCTORS(dcomplex,dcomplexref)
- DEFINE_CONSTRUCTORS(charptr,charptrref)
- DEFINE_SINGLETON_CONSTRUCTOR(agentptr)
- DEFINE_SINGLETON_CONSTRUCTOR(funcptr)
- DEFINE_ARRAY_CONSTRUCTOR(funcptr)
- Value::Value( recordptr value, Agent* agent )
- {
- InitValue();
- SetValue( value, agent );
- }
- Value::Value( SDS_Index& value )
- {
- InitValue();
- SetValue( value );
- }
- Value::Value( Value* ref_value, value_type val_type )
- {
- InitValue();
- storage = TAKE_OVER_ARRAY;
- if ( val_type == VAL_CONST )
- type = TYPE_CONST;
- else if ( val_type == VAL_REF )
- type = TYPE_REF;
- else
- fatal->Report( "bad value_type in Value::Value" );
- if ( ref_value->IsConst() && val_type == VAL_REF )
- warn->Report(
- "\"ref\" reference created from \"const\" reference" );
- ref_value = ref_value->Deref();
- attributes = ref_value->CopyAttributePtr();
- Ref( ref_value );
- values = (void*) ref_value;
- }
- Value::Value( Value* ref_value, int index[], int num_elements,
- value_type val_type )
- {
- InitValue();
- SetValue( ref_value, index, num_elements, val_type );
- attributes = ref_value->CopyAttributePtr();
- }
- void Value::TakeValue( Value* new_value )
- {
- new_value = new_value->Deref();
- if ( new_value == this )
- {
- error->Report( "reference loop created" );
- return;
- }
- DeleteValue();
- int my_ref_count = ref_count;
- *this = *new_value;
- ref_count = my_ref_count;
- new_value->type = TYPE_ERROR;
- Unref( new_value );
- }
- Value::~Value()
- {
- DeleteValue();
- ++num_Values_deleted;
- }
- #define DEFINE_ARRAY_SET_VALUE(type, glish_type) \
- void Value::SetValue( type array[], int len, array_storage_type arg_storage )\
- { \
- SetType( glish_type ); \
- max_size = length = len; \
- storage = arg_storage; \
- values = storage == COPY_ARRAY ? copy_values( array, type ) : array;\
- }
- #define DEFINE_REF_SET_VALUE(reftype, glish_type) \
- void Value::SetValue( reftype& value_ref ) \
- { \
- SetType( glish_type ); \
- max_size = length = value_ref.Length(); \
- storage = COPY_ARRAY; \
- values = value_ref.DupVec(); \
- }
- #define DEFINE_SET_VALUE(type, reftype, glish_type) \
- DEFINE_ARRAY_SET_VALUE(type, glish_type) \
- DEFINE_REF_SET_VALUE(reftype, glish_type)
- DEFINE_SET_VALUE(glish_bool,glish_boolref,TYPE_BOOL)
- DEFINE_SET_VALUE(byte,byteref,TYPE_BYTE)
- DEFINE_SET_VALUE(short,shortref,TYPE_SHORT)
- DEFINE_SET_VALUE(int,intref,TYPE_INT)
- DEFINE_SET_VALUE(float,floatref,TYPE_FLOAT)
- DEFINE_SET_VALUE(double,doubleref,TYPE_DOUBLE)
- DEFINE_SET_VALUE(complex,complexref,TYPE_COMPLEX)
- DEFINE_SET_VALUE(dcomplex,dcomplexref,TYPE_DCOMPLEX)
- DEFINE_ARRAY_SET_VALUE(agentptr,TYPE_AGENT)
- DEFINE_ARRAY_SET_VALUE(funcptr,TYPE_FUNC)
- DEFINE_REF_SET_VALUE(charptrref,TYPE_STRING)
- void Value::SetValue( const char* array[], int len,
- array_storage_type arg_storage )
- {
- SetType( TYPE_STRING );
- max_size = length = len;
- storage = arg_storage;
- if ( storage == COPY_ARRAY )
- {
- values = (void*) new charptr[len];
- charptr* sptr = StringPtr();
- for ( int i = 0; i < len; ++i )
- sptr[i] = strdup( array[i] );
- }
- else
- values = array;
- }
- void Value::SetValue( recordptr value, Agent* agent )
- {
- SetType( TYPE_RECORD );
- values = (void*) value;
- max_size = length = 1;
- storage = TAKE_OVER_ARRAY;
- if ( agent )
- RecordPtr()->Insert( strdup( AGENT_MEMBER_NAME ),
- new Value( agent ) );
- }
- void Value::SetValue( SDS_Index& value )
- {
- SetType( TYPE_OPAQUE );
- values = (void*) value.Index();
- max_size = length = 1;
- storage = PRESERVE_ARRAY;
- }
- void Value::SetValue( Value* ref_value, int index[], int num_elements,
- value_type val_type )
- {
- if ( val_type == VAL_CONST )
- SetType( TYPE_SUBVEC_CONST );
- else if ( val_type == VAL_REF )
- SetType( TYPE_SUBVEC_REF );
- else
- fatal->Report( "bad value_type in Value::Value" );
- storage = TAKE_OVER_ARRAY;
- if ( ref_value->IsConst() && val_type == VAL_REF )
- warn->Report(
- "\"ref\" reference created from \"const\" reference" );
- ref_value = ref_value->Deref();
- length = num_elements;
- int max_index;
- if ( ! IndexRange( index, num_elements, max_index ) )
- fatal->Report( "bad index in Value::Value" );
- if ( max_index > ref_value->Length() )
- if ( ! ref_value->Grow( max_index ) )
- return;
- switch ( ref_value->Type() )
- {
- case TYPE_BOOL:
- case TYPE_BYTE:
- case TYPE_SHORT:
- case TYPE_INT:
- case TYPE_FLOAT:
- case TYPE_DOUBLE:
- case TYPE_COMPLEX:
- case TYPE_DCOMPLEX:
- case TYPE_STRING:
- case TYPE_SUBVEC_REF:
- case TYPE_SUBVEC_CONST:
- values = (void*) new VecRef( ref_value, index,
- num_elements, max_index );
- break;
- default:
- fatal->Report( "bad Value in Value::Value" );
- }
- }
- void Value::InitValue()
- {
- type = TYPE_ERROR;
- description = 0;
- value_manager = 0;
- attributes = 0;
- ++num_Values_created;
- }
- void Value::SetType( glish_type new_type )
- {
- DeleteValue();
- type = new_type;
- }
- void Value::DeleteValue()
- {
- switch ( type )
- {
- case TYPE_CONST:
- case TYPE_REF:
- Unref( RefPtr() );
- // So we don't also delete "values" ...
- type = TYPE_ERROR;
- break;
- case TYPE_SUBVEC_CONST:
- case TYPE_SUBVEC_REF:
- Unref( VecRefPtr() );
- type = TYPE_ERROR;
- break;
- case TYPE_STRING:
- if ( ! value_manager && storage != PRESERVE_ARRAY )
- {
- charptr* sptr = StringPtr();
- for ( int i = 0; i < length; ++i )
- delete (char*) sptr[i];
- }
- break;
- case TYPE_AGENT:
- // Here we rely on the fact that Agent is derived
- // GlishObject, which has a virtual destructor.
- Unref( (GlishObject*) AgentVal() );
- break;
- case TYPE_RECORD:
- {
- delete_record( RecordPtr() );
- // So we don't delete "values" again ...
- type = TYPE_ERROR;
- break;
- }
- default:
- break;
- }
- if ( type != TYPE_ERROR )
- {
- if ( value_manager )
- {
- Unref( value_manager );
- // It's important to get rid of our value_manager
- // pointer here; a call to DeleteValue does not
- // necessarily mean we're throwing away the entire
- // Value object. (For example, we may be called
- // by SetType, called in turn by Polymorph.) Thus
- // as we're done with this value_manager, mark it
- // as so.
- value_manager = 0;
- }
- else if ( storage != PRESERVE_ARRAY )
- delete values;
- DeleteAttributes();
- }
- }
- void Value::DeleteAttributes()
- {
- Unref( attributes );
- attributes = 0;
- }
- void Value::DeleteAttribute( const Value* index )
- {
- char* index_string = index->StringVal();
- DeleteAttribute( index_string );
- delete index_string;
- }
- void Value::DeleteAttribute( const char field[] )
- {
- attributeptr attr = ModAttributePtr();
- if ( attr )
- delete attr->Remove( field );
- }
- int Value::IsNumeric() const
- {
- switch ( type )
- {
- case TYPE_BOOL:
- case TYPE_BYTE:
- case TYPE_SHORT:
- case TYPE_INT:
- case TYPE_FLOAT:
- case TYPE_DOUBLE:
- case TYPE_COMPLEX:
- case TYPE_DCOMPLEX:
- return 1;
- case TYPE_CONST:
- case TYPE_REF:
- case TYPE_STRING:
- case TYPE_AGENT:
- case TYPE_FUNC:
- case TYPE_RECORD:
- case TYPE_OPAQUE:
- return 0;
- case TYPE_SUBVEC_CONST:
- case TYPE_SUBVEC_REF:
- return VecRefPtr()->Val()->IsNumeric();
- case TYPE_ERROR:
- default:
- fatal->Report( "bad type in Value::IsNumeric()" );
- return 0; // for overly clever compilers
- }
- }
- int Value::IsAgentRecord() const
- {
- if ( VecRefDeref()->Type() == TYPE_RECORD &&
- (*RecordPtr())[AGENT_MEMBER_NAME] )
- return 1;
- else
- return 0;
- }
- #define DEFINE_CONST_ACCESSOR(name,tag,type) \
- type Value::name() const \
- { \
- if ( IsVecRef() ) \
- return ((const Value*) VecRefPtr()->Val())->name(); \
- else if ( Type() != tag ) \
- fatal->Report( "bad use of const accessor" ); \
- return (type) values; \
- }
- DEFINE_CONST_ACCESSOR(BoolPtr,TYPE_BOOL,glish_bool*)
- DEFINE_CONST_ACCESSOR(BytePtr,TYPE_BYTE,byte*)
- DEFINE_CONST_ACCESSOR(ShortPtr,TYPE_SHORT,short*)
- DEFINE_CONST_ACCESSOR(IntPtr,TYPE_INT,int*)
- DEFINE_CONST_ACCESSOR(FloatPtr,TYPE_FLOAT,float*)
- DEFINE_CONST_ACCESSOR(DoublePtr,TYPE_DOUBLE,double*)
- DEFINE_CONST_ACCESSOR(ComplexPtr,TYPE_COMPLEX,complex*)
- DEFINE_CONST_ACCESSOR(DcomplexPtr,TYPE_DCOMPLEX,dcomplex*)
- DEFINE_CONST_ACCESSOR(StringPtr,TYPE_STRING,charptr*)
- DEFINE_CONST_ACCESSOR(FuncPtr,TYPE_FUNC,funcptr*)
- DEFINE_CONST_ACCESSOR(AgentPtr,TYPE_AGENT,agentptr*)
- DEFINE_CONST_ACCESSOR(RecordPtr,TYPE_RECORD,recordptr)
- #define DEFINE_ACCESSOR(name,tag,type) \
- type Value::name() \
- { \
- if ( IsVecRef() ) \
- return VecRefPtr()->Val()->name(); \
- if ( Type() != tag ) \
- Polymorph( tag ); \
- return (type) values; \
- }
- DEFINE_ACCESSOR(BoolPtr,TYPE_BOOL,glish_bool*)
- DEFINE_ACCESSOR(BytePtr,TYPE_BYTE,byte*)
- DEFINE_ACCESSOR(ShortPtr,TYPE_SHORT,short*)
- DEFINE_ACCESSOR(IntPtr,TYPE_INT,int*)
- DEFINE_ACCESSOR(FloatPtr,TYPE_FLOAT,float*)
- DEFINE_ACCESSOR(DoublePtr,TYPE_DOUBLE,double*)
- DEFINE_ACCESSOR(ComplexPtr,TYPE_COMPLEX,complex*)
- DEFINE_ACCESSOR(DcomplexPtr,TYPE_DCOMPLEX,dcomplex*)
- DEFINE_ACCESSOR(StringPtr,TYPE_STRING,charptr*)
- DEFINE_ACCESSOR(FuncPtr,TYPE_FUNC,funcptr*)
- DEFINE_ACCESSOR(AgentPtr,TYPE_AGENT,agentptr*)
- DEFINE_ACCESSOR(RecordPtr,TYPE_RECORD,recordptr)
- #define DEFINE_CONST_REF_ACCESSOR(name,tag,type) \
- type& Value::name() const \
- { \
- if ( ! IsVecRef() ) \
- fatal->Report( "bad use of subarray reference accessor" );\
- if ( VecRefPtr()->Type() != tag ) \
- fatal->Report( "bad use of subarray reference accessor" );\
- return *(VecRefPtr()->name()); \
- }
- DEFINE_CONST_REF_ACCESSOR(BoolRef,TYPE_BOOL,glish_boolref)
- DEFINE_CONST_REF_ACCESSOR(ByteRef,TYPE_BYTE,byteref)
- DEFINE_CONST_REF_ACCESSOR(ShortRef,TYPE_SHORT,shortref)
- DEFINE_CONST_REF_ACCESSOR(IntRef,TYPE_INT,intref)
- DEFINE_CONST_REF_ACCESSOR(FloatRef,TYPE_FLOAT,floatref)
- DEFINE_CONST_REF_ACCESSOR(DoubleRef,TYPE_DOUBLE,doubleref)
- DEFINE_CONST_REF_ACCESSOR(ComplexRef,TYPE_COMPLEX,complexref)
- DEFINE_CONST_REF_ACCESSOR(DcomplexRef,TYPE_DCOMPLEX,dcomplexref)
- DEFINE_CONST_REF_ACCESSOR(StringRef,TYPE_STRING,charptrref)
- #define DEFINE_REF_ACCESSOR(name,tag,type) \
- type& Value::name() \
- { \
- if ( ! IsVecRef() ) \
- fatal->Report( "bad use of subarray reference accessor" );\
- if ( VecRefPtr()->Type() != tag ) \
- Polymorph( tag ); \
- return *(VecRefPtr()->name()); \
- }
- DEFINE_REF_ACCESSOR(BoolRef,TYPE_BOOL,glish_boolref)
- DEFINE_REF_ACCESSOR(ByteRef,TYPE_BYTE,byteref)
- DEFINE_REF_ACCESSOR(ShortRef,TYPE_SHORT,shortref)
- DEFINE_REF_ACCESSOR(IntRef,TYPE_INT,intref)
- DEFINE_REF_ACCESSOR(FloatRef,TYPE_FLOAT,floatref)
- DEFINE_REF_ACCESSOR(DoubleRef,TYPE_DOUBLE,doubleref)
- DEFINE_REF_ACCESSOR(ComplexRef,TYPE_COMPLEX,complexref)
- DEFINE_REF_ACCESSOR(DcomplexRef,TYPE_DCOMPLEX,dcomplexref)
- DEFINE_REF_ACCESSOR(StringRef,TYPE_STRING,charptrref)
- #define XXX_VAL(name, val_type, rhs_elm, text_func, type_name, zero) \
- val_type Value::name( int n ) const \
- { \
- if ( IsRef() ) \
- return Deref()->name( n ); \
- \
- if ( length < 1 ) \
- { \
- error->Report( "empty array converted to ", type_name );\
- return zero; \
- } \
- \
- if ( n < 1 || n > length ) \
- { \
- error->Report( "in conversion to ", type_name, " index (=", n,\
- ") out of bounds, length =", length ); \
- return zero; \
- } \
- \
- switch ( type ) \
- { \
- case TYPE_BOOL: \
- return val_type( BoolPtr()[n - 1] ? 1 : 0 ); \
- \
- case TYPE_BYTE: \
- return val_type( BytePtr()[n - 1] ); \
- \
- case TYPE_SHORT: \
- return val_type( ShortPtr()[n - 1] ); \
- \
- case TYPE_INT: \
- return val_type( IntPtr()[n - 1] ); \
- \
- case TYPE_FLOAT: \
- return val_type( FloatPtr()[n - 1] ); \
- \
- case TYPE_DOUBLE: \
- return val_type( DoublePtr()[n - 1] ); \
- \
- case TYPE_COMPLEX: \
- return val_type( ComplexPtr()[n - 1] rhs_elm ); \
- \
- case TYPE_DCOMPLEX: \
- return val_type( DcomplexPtr()[n - 1] rhs_elm );\
- \
- case TYPE_STRING: \
- { \
- int successful; \
- val_type result = val_type( \
- text_func( StringPtr()[n - 1], successful ) );\
- \
- if ( ! successful ) \
- warn->Report( "string \"", this, \
- "\" converted to ", type_name );\
- return result; \
- } \
- \
- case TYPE_AGENT: \
- case TYPE_FUNC: \
- case TYPE_RECORD: \
- case TYPE_OPAQUE: \
- error->Report( "bad type", type_names[Type()], \
- "converted to ", type_name, ":", this );\
- return zero; \
- \
- case TYPE_SUBVEC_CONST: \
- case TYPE_SUBVEC_REF: \
- { \
- VecRef* ref = VecRefPtr(); \
- int err; \
- int off = ref->TranslateIndex( n-1, &err ); \
- if ( err ) \
- { \
- error->Report( "bad sub-vector subscript" );\
- return zero; \
- } \
- return ref->Val()->name( off ); \
- } \
- \
- default: \
- fatal->Report( "bad type in Value::XXX_VAL()" );\
- return zero; \
- } \
- }
- XXX_VAL(BoolVal, glish_bool, .r, text_to_integer, "bool", glish_false)
- XXX_VAL(ByteVal, byte, .r, text_to_integer, "byte", 0)
- XXX_VAL(ShortVal, short, .r, text_to_integer, "short", 0)
- XXX_VAL(IntVal, int, .r, text_to_integer, "integer", 0)
- XXX_VAL(FloatVal, float, .r, text_to_double, "float", 0.0)
- XXX_VAL(DoubleVal, double, .r, text_to_double, "double", 0.0)
- XXX_VAL(ComplexVal, complex,, text_to_dcomplex, "complex", complex(0.0, 0.0))
- XXX_VAL(DcomplexVal, dcomplex,, text_to_dcomplex, "dcomplex",
- dcomplex(0.0, 0.0))
- static void append_buf( char* &buf, char* &buf_ptr, unsigned int& buf_size,
- const char* a = 0, const char* b = 0, const char* c = 0 )
- {
- a = a ? a : "";
- b = b ? b : "";
- c = c ? c : "";
- int buf_remaining = &buf[buf_size] - buf_ptr;
- int size_of_addition = strlen( a ) + strlen( b ) + strlen( c );
- while ( size_of_addition >= buf_remaining - 5 /* slop */ )
- { // Need to grow the buffer.
- int buf_ptr_offset = buf_ptr - buf;
- buf_size *= 2;
- buf = (char*) realloc_memory( (void*) buf, buf_size );
- if ( ! buf )
- fatal->Report( "out of memory in append_buf()" );
- buf_ptr = buf + buf_ptr_offset;
- buf_remaining = &buf[buf_size] - buf_ptr;
- }
- *buf_ptr = '\0';
- strcat( buf_ptr, a );
- strcat( buf_ptr, b );
- strcat( buf_ptr, c );
- buf_ptr += size_of_addition;
- }
- char* Value::StringVal( char sep, int useAttributes ) const
- {
- if ( IsRef() )
- return Deref()->StringVal( sep, useAttributes );
- if ( type == TYPE_RECORD )
- return RecordStringVal();
- if ( type == TYPE_AGENT )
- return strdup( "<agent>" );
- if ( type == TYPE_FUNC )
- return strdup( "<function>" );
- if ( type == TYPE_OPAQUE )
- return strdup( "<opaque>" );
- if ( length == 0 )
- return strdup( "" );
- unsigned int buf_size;
- // Make a guess as to a probable good size for buf.
- if ( type == TYPE_STRING )
- {
- buf_size = strlen( StringPtr()[0] ) * (length + 1);
- if ( buf_size == 0 )
- buf_size = 8;
- }
- else if ( type == TYPE_COMPLEX || type == TYPE_DCOMPLEX )
- buf_size = length * 16 * 2 + 1;
- else if ( type == TYPE_FLOAT || type == TYPE_DOUBLE )
- buf_size = length * 16;
- else
- buf_size = length * 8;
- char* buf = new char[buf_size];
- if ( ! buf )
- fatal->Report( "out of memory in Value::StringVal()" );
- char* buf_ptr = buf;
- if ( type != TYPE_STRING && length > 1 )
- {
- // Insert []'s around value.
- *buf_ptr++ = '[';
- }
- glish_bool* bool_ptr;
- byte* byte_ptr;
- short* short_ptr;
- int* int_ptr;
- float* float_ptr;
- double* double_ptr;
- complex* complex_ptr;
- dcomplex* dcomplex_ptr;
- charptr* string_ptr;
- switch ( VecRefDeref()->type )
- {
- #define ASSIGN_PTR(tag,ptr_name,source) \
- case tag: \
- ptr_name = source; \
- break;
- ASSIGN_PTR(TYPE_BOOL,bool_ptr,BoolPtr())
- ASSIGN_PTR(TYPE_INT,int_ptr,IntPtr())
- ASSIGN_PTR(TYPE_BYTE,byte_ptr,BytePtr())
- ASSIGN_PTR(TYPE_SHORT,short_ptr,ShortPtr())
- ASSIGN_PTR(TYPE_FLOAT,float_ptr,FloatPtr())
- ASSIGN_PTR(TYPE_DOUBLE,double_ptr,DoublePtr())
- ASSIGN_PTR(TYPE_COMPLEX,complex_ptr,ComplexPtr())
- ASSIGN_PTR(TYPE_DCOMPLEX,dcomplex_ptr,DcomplexPtr())
- ASSIGN_PTR(TYPE_STRING,string_ptr,StringPtr())
- default:
- fatal->Report( "bad type in Value::StringVal()" );
- }
- // Macro to generate the text corresponding to a single element of a given type.
- #define PLACE_ELEMENT_ACTION(buffer,str_buffer,indx) \
- case TYPE_BOOL: \
- strcpy( buffer, bool_ptr[indx] ? "T" : "F" ); \
- break; \
- \
- case TYPE_BYTE: \
- sprintf( buffer, "%d", byte_ptr[indx] ); \
- break; \
- \
- case TYPE_SHORT: \
- sprintf( buffer, "%d", short_ptr[indx] ); \
- break; \
- \
- case TYPE_INT: \
- sprintf( buffer, "%d", int_ptr[indx] ); \
- break; \
- \
- case TYPE_FLOAT: \
- sprintf( buffer, "%g", float_ptr[indx] ); \
- break; \
- \
- case TYPE_DOUBLE: \
- sprintf( buffer, "%g", double_ptr[indx] ); \
- break; \
- \
- case TYPE_COMPLEX: \
- sprintf( buffer, complex_ptr[indx].i >= 0.0 ? \
- "%g+%gi" : "%g%gi", complex_ptr[indx].r,\
- complex_ptr[indx].i ); \
- break; \
- \
- case TYPE_DCOMPLEX: \
- sprintf( buffer, dcomplex_ptr[indx].i >= 0.0 ? \
- "%g+%gi":"%g%gi",dcomplex_ptr[indx].r, \
- dcomplex_ptr[indx].i); \
- break; \
- \
- case TYPE_STRING: \
- str_buffer = string_ptr[ indx ]; \
- break;
- // Generate text for an element, translating subref indices if needed.
- #define PLACE_ELEMENT(buffer,str_buffer,indx,alloced) \
- switch ( type ) \
- { \
- PLACE_ELEMENT_ACTION(buffer,str_buffer,indx) \
- \
- case TYPE_SUBVEC_REF: \
- case TYPE_SUBVEC_CONST: \
- { \
- VecRef* ref = VecRefPtr(); \
- int err; \
- int index = ref->TranslateIndex( indx, &err ); \
- if ( err ) \
- { \
- error->Report( "invalid sub-vector" ); \
- delete alloced; \
- return strdup( "error" ); \
- } \
- switch ( ref->Type() ) \
- { \
- PLACE_ELEMENT_ACTION(buffer,str_buffer,index)\
- \
- default: \
- fatal->Report( \
- "bad type in Value::StringVal()" ); \
- } \
- } \
- break; \
- \
- default: \
- fatal->Report( \
- "bad type in Value::StringVal()" ); \
- }
- char numeric_buf[256];
- const attributeptr attr = AttributePtr();
- const Value* shape_val;
- int shape_len;
- if ( ! useAttributes || ! attr || ! (shape_val = (*attr)["shape"]) ||
- ! shape_val->IsNumeric() ||
- (shape_len = shape_val->Length()) <= 1 )
- { // not an n-D array.
- for ( int i = 0; i < length; ++i )
- {
- const char* addition = numeric_buf;
- PLACE_ELEMENT(numeric_buf, addition, i, buf);
- append_buf( buf, buf_ptr, buf_size, addition );
- if ( i < length - 1 )
- // More to come.
- *buf_ptr++ = sep;
- }
- if ( type != TYPE_STRING && length > 1 )
- {
- // Insert []'s around value.
- *buf_ptr++ = ']';
- *buf_ptr = '\0';
- }
- return buf;
- }
- // Okay, from this point on it's an n-D array.
- static char indent[] = " ";
- // Later the pivots for outputting by planes can be made variable
- int r = 0;
- int c = 1;
- int shape_is_copy = 0;
- int* shape = shape_val->CoerceToIntArray( shape_is_copy, shape_len );
- // Store for setting up a plane in advance to get the proper
- // spacing for the columns. Note that these and the arrays
- // created just below are static, so we don't free them on exit.
- static int column_width_len = 64;
- static int* column_width = new int[column_width_len];
- // Arrays for iterating through the matrix.
- static int indices_len = 32;
- static int* indices = new int[indices_len];
- static int* factor = new int[indices_len];
- // Resize arrays as necessary.
- while ( shape[c] > column_width_len )
- {
- column_width_len *= 2;
- column_width = (int*) realloc_memory( (void*) column_width,
- column_width_len * sizeof(int) );
- if ( ! column_width )
- fatal->Report( "out of memory in Value::StringVal()" );
- }
- while ( shape_len > indices_len )
- {
- indices_len *= 2;
- indices = (int*) realloc_memory( (void*) indices,
- indices_len * sizeof(int) );
- factor = (int*) realloc_memory( (void*) factor,
- indices_len * sizeof(int) );
- if ( ! indices || ! factor )
- fatal->Report( "out of memory in Value::StringVal()" );
- }
- // Calculate the size and the offset for the columns.
- int size = 1;
- int offset = 0;
- for ( int i = 0; i < shape_len; ++i )
- {
- indices[i] = 0;
- factor[i] = size;
- size *= shape[i];
- }
- // Check to see if the vector length and the shape jive.
- if ( size > length )
- {
- warn->Report( "\"::shape\"/length mismatch" );
- delete buf;
- if ( shape_is_copy )
- delete shape;
- return StringVal( sep, 0 );
- }
- int max_free = shape_len-1;
- if ( shape_len > 2 )
- for ( max_free = shape_len-1; max_free > 0; --max_free )
- if ( max_free != r && max_free != c )
- break;
- while ( indices[max_free] < shape[max_free] )
- {
- // Output the plane label
- for ( i = 0; i < shape_len; ++i )
- {
- if ( i == r )
- sprintf( numeric_buf, "1:%d", shape[r] );
- else if ( i != c )
- sprintf( numeric_buf, "%d", indices[i] + 1 );
- else
- numeric_buf[0] = '\0';
- if ( i < shape_len - 1 )
- strcat( numeric_buf, "," );
- else
- strcat( numeric_buf, "]\n" );
- append_buf( buf, buf_ptr, buf_size, i==0 ? "[" : 0,
- numeric_buf );
- }
- // Calculate column widths.
- for ( indices[r] = 0; indices[r] < shape[r]; ++indices[r] )
- for ( indices[c] = 0; indices[c] < shape[c] - 1;
- ++indices[c] )
- {
- for ( i = 0, offset = 0; i < shape_len; ++i )
- offset += factor[i] * indices[i];
- char store[256];
- const char* addition = store;
- PLACE_ELEMENT(store,addition,offset,buf)
- int add_len = strlen( addition );
- if ( add_len > column_width[indices[c]] ||
- indices[r] == 0 )
- column_width[indices[c]] = add_len;
- }
- // Output plane.
- for ( indices[r] = 0; indices[r] < shape[r]; ++indices[r] )
- {
- for ( indices[c] = 0; indices[c] < shape[c];
- ++indices[c] )
- {
- for ( i = 0, offset = 0; i < shape_len; ++i )
- offset += factor[i] * indices[i];
- const char* addition = numeric_buf;
- PLACE_ELEMENT(numeric_buf,addition,offset,buf);
- char affix[256];
- if ( indices[c] < shape[c] - 1 )
- {
- int n = column_width[indices[c]] -
- strlen( addition ) + 1;
- for ( i = 0; i < n; ++i )
- affix[i] = ' ';
- affix[i] = '\0';
- }
- else if ( offset != size - 1 )
- {
- affix[0] = '\n';
- affix[1] = '\0';
- }
- else
- affix[0] = '\0';
- append_buf( buf, buf_ptr, buf_size,
- indices[c] == 0 ? indent : 0,
- addition, affix );
- }
- }
- // Increment counters.
- for ( i = 0; i <= max_free; ++i )
- {
- if ( i == r || i == c )
- continue;
- else if ( ++indices[i] < shape[i] )
- break;
- else if ( i != max_free )
- indices[i] = 0;
- }
- }
- if ( shape_is_copy )
- delete shape;
- append_buf( buf, buf_ptr, buf_size, "]" );
- return buf;
- }
- char* Value::RecordStringVal() const
- {
- if ( VecRefDeref()->Type() != TYPE_RECORD )
- fatal->Report( "non-record type in Value::RecordStringVal()" );
- recordptr rptr = RecordPtr();
- int len = rptr->Length();
- if ( len == 0 )
- return strdup( "[=]" );
- const char** key_strs = new const char*[len];
- char** element_strs = new char*[len];
- int total_len = 0;
- for ( int i = 0; i < len; ++i )
- {
- Value* nth_val = rptr->NthEntry( i, key_strs[i] );
- if ( ! nth_val )
- fatal->Report(
- "bad record in Value::RecordStringVal()" );
- element_strs[i] = nth_val->StringVal();
- total_len += strlen( element_strs[i] ) + strlen( key_strs[i] );
- }
- // We generate a result of the form [key1=val1, key2=val2, ...],
- // so in addition to room for the keys and values we need 3 extra
- // characters per element (for the '=', ',', and ' '), 2 more for
- // the []'s (we could steal these from the last element since it
- // doesn't have a ", " at the end of it, but that seems a bit
- // evil), and 1 more for the end-of-string.
- char* result = new char[total_len + 3 * len + 3];
- strcpy( result, "[" );
- for ( i = 0; i < len; ++i )
- {
- sprintf( &result[strlen( result )], "%s=%s, ",
- key_strs[i], element_strs[i] );
- delete element_strs[i];
- }
- // Now add the final ']', taking care to wipe out the trailing
- // ", ".
- strcpy( &result[strlen( result ) - 2], "]" );
- return result;
- }
- Agent* Value::AgentVal() const
- {
- if ( type == TYPE_AGENT )
- return AgentPtr()[0];
- if ( VecRefDeref()->Type() == TYPE_RECORD )
- {
- Value* member = (*RecordPtr())[AGENT_MEMBER_NAME];
- if ( member )
- return member->AgentVal();
- }
- error->Report( this, " is not an agent value" );
- return 0;
- }
- Func* Value::FuncVal() const
- {
- if ( type != TYPE_FUNC )
- {
- error->Report( this, " is not a function value" );
- return 0;
- }
- if ( length == 0 )
- {
- error->Report( "empty function array" );
- return 0;
- }
- if ( length > 1 )
- warn->Report( "more than one function element in", this,
- ", excess ignored" );
- return FuncPtr()[0];
- }
- int Value::SDS_IndexVal() const
- {
- if ( type != TYPE_OPAQUE )
- {
- error->Report( this, " is not an opaque value" );
- return SDS_NO_SUCH_SDS;
- }
- return int(values);
- }
- Value* Value::Deref()
- {
- if ( IsRef() )
- return RefPtr()->Deref();
- else
- return this;
- }
- const Value* Value::Deref() const
- {
- if ( IsRef() )
- return ((const Value*) RefPtr())->Deref();
- else
- return this;
- }
- Value* Value::VecRefDeref()
- {
- if ( IsVecRef() )
- return VecRefPtr()->Val()->VecRefDeref();
- else if ( IsRef() )
- return RefPtr()->VecRefDeref();
- else
- return this;
- }
- const Value* Value::VecRefDeref() const
- {
- if ( IsVecRef() )
- return ((const Value*) VecRefPtr()->Val())->VecRefDeref();
- else if ( IsRef() )
- return ((const Value*) RefPtr())->VecRefDeref();
- else
- return this;
- }
- #define COERCE_HDR(name, ctype, gtype, type_name, accessor) \
- if ( IsRef() ) \
- return Deref()->name( is_copy, size, result ); \
- \
- if ( ! IsNumeric() ) \
- fatal->Report( "non-numeric type in coercion of", this, \
- "to ", type_name ); \
- \
- if ( ! result && length == size && type == gtype ) \
- { \
- is_copy = 0; \
- return accessor(); \
- } \
- \
- is_copy = 1; \
- if ( ! result ) \
- result = new ctype[size]; \
- \
- int incr = (length == 1 ? 0 : 1); \
- int i, j;
- glish_bool* Value::CoerceToBoolArray( int& is_copy, int size,
- glish_bool* result ) const
- {
- COERCE_HDR(CoerceToBoolArray, glish_bool, TYPE_BOOL, "bool", BoolPtr)
- switch ( type )
- {
- #define BOOL_COERCE_BOOL_ACTION(OFFSET,XLATE) \
- case TYPE_BOOL: \
- { \
- glish_bool* bool_ptr = BoolPtr(); \
- for ( i = 0, j = 0; i < size; ++i, j += incr ) \
- { \
- XLATE \
- result[i] = bool_ptr[ OFFSET ]; \
- } \
- break; \
- }
- #define BOOL_COERCE_ACTION(tag,type,rhs_elm,accessor,OFFSET,XLATE) \
- case tag: \
- { \
- type* ptr = accessor; \
- for ( i = 0, j = 0; i < size; ++i, j += incr ) \
- { \
- XLATE \
- result[i] = (ptr[ OFFSET ] rhs_elm ? glish_true : glish_false);\
- } \
- break; \
- }
- BOOL_COERCE_BOOL_ACTION(j,)
- BOOL_COERCE_ACTION(TYPE_BYTE,byte,,BytePtr(),j,)
- BOOL_COERCE_ACTION(TYPE_SHORT,short,,ShortPtr(),j,)
- BOOL_COERCE_ACTION(TYPE_INT,int,,IntPtr(),j,)
- BOOL_COERCE_ACTION(TYPE_FLOAT,float,,FloatPtr(),j,)
- BOOL_COERCE_ACTION(TYPE_DOUBLE,double,,DoublePtr(),j,)
- BOOL_COERCE_ACTION(TYPE_COMPLEX,complex,.r,ComplexPtr(),j,)
- BOOL_COERCE_ACTION(TYPE_DCOMPLEX,dcomplex,.r,DcomplexPtr(),j,)
- case TYPE_SUBVEC_REF:
- case TYPE_SUBVEC_CONST:
- {
- VecRef *ref = VecRefPtr();
- switch ( ref->Type() )
- {
- #define COERCE_ACTION_XLATE \
- int err; \
- int off = ref->TranslateIndex( j, &err ); \
- if ( err ) \
- { \
- error->Report( "index (=",j, \
- ") is out of range. Sub-vector reference may be invalid" );\
- return 0; \
- }
- BOOL_COERCE_BOOL_ACTION(off,COERCE_ACTION_XLATE)
- BOOL_COERCE_ACTION(TYPE_INT,int,,IntPtr(),off,COERCE_ACTION_XLATE)
- BOOL_COERCE_ACTION(TYPE_FLOAT,float,,FloatPtr(),off,COERCE_ACTION_XLATE)
- BOOL_COERCE_ACTION(TYPE_DOUBLE,double,,DoublePtr(),off,COERCE_ACTION_XLATE)
- BOOL_COERCE_ACTION(TYPE_COMPLEX,complex,.r,ComplexPtr(),off,COERCE_ACTION_XLATE)
- BOOL_COERCE_ACTION(TYPE_DCOMPLEX,dcomplex,.r,DcomplexPtr(),off,COERCE_ACTION_XLATE)
- default:
- error->Report(
- "bad type in Value::CoerceToBoolArray()" );
- return 0;
- }
- }
- break;
- default:
- error->Report(
- "bad type in Value::CoerceToBoolArray()" );
- return 0;
- }
- return result;
- }
- #define COERCE_ACTION(tag,rhs_type,rhs_elm,lhs_type,accessor,OFFSET,XLATE)\
- case tag: \
- { \
- rhs_type* rhs_ptr = accessor; \
- for ( i = 0, j = 0; i < size; ++i, j += incr ) \
- { \
- XLATE \
- result[i] = \
- lhs_type(rhs_ptr[OFFSET] rhs_elm); \
- } \
- break; \
- }
- #define COERCE_ACTIONS(type,error_msg) \
- COERCE_ACTION(TYPE_BOOL,glish_bool,,type,BoolPtr(),j,) \
- COERCE_ACTION(TYPE_BYTE,byte,,type,BytePtr(),j,) \
- COERCE_ACTION(TYPE_SHORT,short,,type,ShortPtr(),j,) \
- COERCE_ACTION(TYPE_INT,int,,type,IntPtr(),j,) \
- COERCE_ACTION(TYPE_FLOAT,float,,type,FloatPtr(),j,) \
- COERCE_ACTION(TYPE_DOUBLE,double,,type,DoublePtr(),j,) \
- COERCE_ACTION(TYPE_COMPLEX,complex,.r,type,ComplexPtr(),j,) \
- COERCE_ACTION(TYPE_DCOMPLEX,dcomplex,.r,type,DcomplexPtr(),j,) \
- \
- case TYPE_SUBVEC_REF: \
- case TYPE_SUBVEC_CONST: \
- { \
- VecRef *ref = VecRefPtr(); \
- switch ( ref->Type() ) \
- { \
- \
- COERCE_ACTION(TYPE_BOOL,glish_bool,,type,BoolPtr(),off,COERCE_ACTION_XLATE)\
- COERCE_ACTION(TYPE_BYTE,byte,,type,BytePtr(),off,COERCE_ACTION_XLATE) \
- COERCE_ACTION(TYPE_SHORT,short,,type,ShortPtr(),off,COERCE_ACTION_XLATE)\
- COERCE_ACTION(TYPE_INT,int,,type,IntPtr(),off,COERCE_ACTION_XLATE) \
- COERCE_ACTION(TYPE_FLOAT,float,,type,FloatPtr(),off,COERCE_ACTION_XLATE)\
- COERCE_ACTION(TYPE_DOUBLE,double,,type,DoublePtr(),off,COERCE_ACTION_XLATE)\
- COERCE_ACTION(TYPE_COMPLEX,complex,.r,type,ComplexPtr(),off,COERCE_ACTION_XLATE)\
- COERCE_ACTION(TYPE_DCOMPLEX,dcomplex,.r,type,DcomplexPtr(),off,COERCE_ACTION_XLATE)\
- \
- default: \
- error->Report( \
- "bad type in Value::",error_msg);\
- return 0; \
- } \
- } \
- break;
- byte* Value::CoerceToByteArray( int& is_copy, int size, byte* result ) const
- {
- COERCE_HDR(CoerceToByteArray, byte, TYPE_BYTE, "byte", BytePtr)
- switch ( type )
- {
- COERCE_ACTIONS(byte,"CoerceToByteArray()")
- default:
- error->Report(
- "bad type in Value::CoerceToByteArray()" );
- return 0;
- }
- return result;
- }
- short* Value::CoerceToShortArray( int& is_copy, int size, short* result ) const
- {
- COERCE_HDR(CoerceToShortArray, short, TYPE_SHORT, "short", ShortPtr)
- switch ( type )
- {
- COERCE_ACTIONS(short,"CoerceToShortArray()")
- default:
- error->Report(
- "bad type in Value::CoerceToShortArray()" );
- return 0;
- }
- return result;
- }
- int* Value::CoerceToIntArray( int& is_copy, int size, int* result ) const
- {
- COERCE_HDR(CoerceToIntArray, int, TYPE_INT, "integer", IntPtr)
- switch ( type )
- {
- COERCE_ACTIONS(int,"CoerceToIntArray()")
- default:
- error->Report(
- "bad type in Value::CoerceToIntArray()" );
- return 0;
- }
- return result;
- }
- float* Value::CoerceToFloatArray( int& is_copy, int size, float* result ) const
- {
- COERCE_HDR(CoerceToFloatArray, float, TYPE_FLOAT, "float", FloatPtr)
- switch ( type )
- {
- COERCE_ACTIONS(float,"CoerceToFloatArray()")
- default:
- error->Report(
- "bad type in Value::CoerceToFloatArray()" );
- return 0;
- }
- return result;
- }
- double* Value::CoerceToDoubleArray( int& is_copy, int size, double* result ) const
- {
- COERCE_HDR(CoerceToDoubleArray, double, TYPE_DOUBLE, "double", DoublePtr)
- switch ( type )
- {
- COERCE_ACTIONS(double,"CoerceToDoubleArray()")
- default:
- error->Report(
- "bad type in Value::CoerceToDoubleArray()" );
- return 0;
- }
- return result;
- }
- // Coercion builtin->complex.
- #define COMPLEX_BIN_COERCE_ACTION(tag,rhs_type,lhs_type,accessor,OFFSET,XLATE)\
- case tag: \
- { \
- rhs_type* rhs_ptr = accessor; \
- for ( i = 0, j = 0; i < size; ++i, j += incr ) \
- { \
- XLATE \
- result[i].r = \
- lhs_type(rhs_ptr[OFFSET]); \
- result[i].i = lhs_type(0); \
- } \
- break; \
- }
- // Coercion complex->complex.
- #define COMPLEX_CPX_COERCE_ACTION(tag,rhs_type,lhs_type,accessor,OFFSET,XLATE)\
- case tag: \
- { \
- rhs_type* rhs_ptr = accessor; \
- for ( i = 0, j = 0; i < size; ++i, j += incr ) \
- { \
- XLATE \
- result[i].r = lhs_type(rhs_ptr[OFFSET].r); \
- result[i].i = lhs_type(rhs_ptr[OFFSET].i); \
- } \
- break; \
- }
- #define COERCE_COMPLEX_ACTIONS(type,error_msg) \
- COMPLEX_BIN_COERCE_ACTION(TYPE_BOOL,glish_bool,type,BoolPtr(),j,) \
- COMPLEX_BIN_COERCE_ACTION(TYPE_BYTE,byte,type,BytePtr(),j,) \
- COMPLEX_BIN_COERCE_ACTION(TYPE_SHORT,short,type,ShortPtr(),j,) \
- COMPLEX_BIN_COERCE_ACTION(TYPE_INT,int,type,IntPtr(),j,) \
- COMPLEX_BIN_COERCE_ACTION(TYPE_FLOAT,float,type,FloatPtr(),j,) \
- COMPLEX_BIN_COERCE_ACTION(TYPE_DOUBLE,double,type,DoublePtr(),j,) \
- COMPLEX_CPX_COERCE_ACTION(TYPE_COMPLEX,complex,type,ComplexPtr(),j,) \
- COMPLEX_CPX_COERCE_ACTION(TYPE_DCOMPLEX,dcomplex,type,DcomplexPtr(),j,) \
- \
- case TYPE_SUBVEC_REF: \
- case TYPE_SUBVEC_CONST: \
- { \
- VecRef *ref = VecRefPtr(); \
- switch ( ref->Type() ) \
- { \
- \
- COMPLEX_BIN_COERCE_ACTION(TYPE_BOOL,glish_bool,type,BoolPtr(),off,COERCE_ACTION_XLATE)\
- COMPLEX_BIN_COERCE_ACTION(TYPE_BYTE,byte,type,BytePtr(),off,COERCE_ACTION_XLATE)\
- COMPLEX_BIN_COERCE_ACTION(TYPE_SHORT,short,type,ShortPtr(),off,COERCE_ACTION_XLATE)\
- COMPLEX_BIN_COERCE_ACTION(TYPE_INT,int,type,IntPtr(),off,COERCE_ACTION_XLATE)\
- COMPLEX_BIN_COERCE_ACTION(TYPE_FLOAT,float,type,FloatPtr(),off,COERCE_ACTION_XLATE)\
- COMPLEX_BIN_COERCE_ACTION(TYPE_DOUBLE,double,type,DoublePtr(),off,COERCE_ACTION_XLATE)\
- COMPLEX_CPX_COERCE_ACTION(TYPE_COMPLEX,complex,type,ComplexPtr(),off,COERCE_ACTION_XLATE)\
- COMPLEX_CPX_COERCE_ACTION(TYPE_DCOMPLEX,dcomplex,type,DcomplexPtr(),off,COERCE_ACTION_XLATE)\
- \
- default: \
- error->Report( \
- "bad type in Value::",error_msg );\
- return 0; \
- } \
- } \
- break;
- complex* Value::CoerceToComplexArray( int& is_copy, int size,
- complex* result ) const
- {
- COERCE_HDR(CoerceToComplexArray, complex, TYPE_COMPLEX,
- "complex", ComplexPtr)
- switch ( type )
- {
- COERCE_COMPLEX_ACTIONS(float,"CoerceToComplexArray()")
- default:
- error->Report(
- "bad type in Value::CoerceToComplexArray()" );
- return 0;
- }
- return result;
- }
- dcomplex* Value::CoerceToDcomplexArray( int& is_copy, int size,
- dcomplex* result ) const
- {
- COERCE_HDR(CoerceToDcomplexArray, dcomplex, TYPE_DCOMPLEX,
- "dcomplex", DcomplexPtr)
- switch ( type )
- {
- COERCE_COMPLEX_ACTIONS(float,"CoerceToDcomplexArray()")
- default:
- error->Report(
- "bad type in Value::CoerceToDcomplexArray()" );
- return 0;
- }
- return result;
- }
- charptr* Value::CoerceToStringArray( int& is_copy, int size, charptr* result ) const
- {
- if ( IsRef() )
- return Deref()->CoerceToStringArray(is_copy,size,result );
- if ( VecRefDeref()->Type() != TYPE_STRING )
- {
- error->Report( "non-string type in coercion of", this,
- "to string" );
- return 0;
- }
- if ( ! result && Length() == size && ! IsVecRef() )
- {
- is_copy = 0;
- return StringPtr();
- }
- is_copy = 1;
- if ( ! result )
- result = new charptr[size];
- int incr = (Length() == 1 ? 0 : 1);
- int i, j;
- charptr* string_ptr = StringPtr();
- if ( IsVecRef() )
- {
- VecRef* ref = VecRefPtr();
- for ( i = 0, j = 0; i < size; ++i, j += incr )
- {
- int err;
- int off = ref->TranslateIndex( j, &err );
- if ( err )
- {
- error->Report( "index (=",j,
- ") is out of range. Sub-vector reference may be invalid" );
- return 0;
- }
- result[i] = string_ptr[off];
- }
- }
- else
- {
- for ( i = 0, j = 0; i < size; ++i, j += incr )
- result[i] = string_ptr[j];
- }
- return result;
- }
- funcptr* Value::CoerceToFuncArray( int& is_copy, int size, funcptr* result ) const
- {
- if ( type != TYPE_FUNC )
- fatal->Report( "non-func type in CoerceToFuncArray()" );
- if ( size != length )
- fatal->Report( "size != length in CoerceToFuncArray()" );
- if ( result )
- fatal->Report( "prespecified result in CoerceToFuncArray()" );
- is_copy = 0;
- return FuncPtr();
- }
- Value* Value::operator []( const Value* index ) const
- {
- if ( index->Type() == TYPE_STRING )
- return RecordRef( index );
- int indices_are_copy;
- int num_indices;
- int* indices = GenerateIndices( index, num_indices, indices_are_copy );
- if ( indices )
- {
- Value* result = ArrayRef( indices, num_indices );
- if ( indices_are_copy )
- delete indices;
- return result;
- }
- else
- return error_value();
- }
- Value* Value::operator []( const_value_list* args_val ) const
- {
- // These are a bunch of macros for cleaning up the dynamic memory used
- // by this routine (and Value::SubRef) prior to exit.
- #define SUBOP_CLEANUP_1 \
- if ( shape_is_copy ) \
- delete shape; \
- delete factor;
- #define SUBOP_CLEANUP_2(length) \
- { \
- SUBOP_CLEANUP_1 \
- for ( int x = 0; x < length; ++x ) \
- if ( index_is_copy[x] ) \
- delete index[x]; \
- \
- delete index; \
- delete index_is_copy; \
- delete cur; \
- }
- #define SUBOP_ABORT(length,retval) \
- SUBOP_CLEANUP_2(length) \
- delete len; \
- return retval;
- if ( ! IsNumeric() && VecRefDeref()->Type() != TYPE_STRING )
- {
- error->Report( "invalid type in n-D array operation:",
- this );
- return error_value();
- }
- // Collect attributes.
- int args_len = args_val->length();
- const attributeptr ptr = AttributePtr();
- const Value* shape_val = ptr ? (*ptr)["shape"] : 0;
- if ( ! shape_val || ! shape_val->IsNumeric() )
- {
- warn->Report( "invalid or non-existant \"shape\" attribute" );
- if ( args_len >= 1 )
- return operator[]( (*args_val)[0] );
- else
- return copy_value( this );
- }
- int shape_len = shape_val->Length();
- if ( shape_len != args_len )
- {
- error->Report( "invalid number of indexes for:", this );
- return error_value();
- }
- int shape_is_copy;
- int* shape = shape_val->CoerceToIntArray( shape_is_copy, shape_len );
- Value* op_val = (*ptr)["op[]"];
- int* factor = new int[shape_len];
- int cur_factor = 1;
- int offset = 0;
- int max_len = 0;
- for ( int i = 0; i < args_len; ++i )
- {
- const Value* arg = (*args_val)[i];
- if ( arg )
- {
- if ( ! arg->IsNumeric() )
- {
- error->Report( "index #", i+1, "into", this,
- "is not numeric");
- SUBOP_CLEANUP_1
- return error_value();
- }
- if ( arg->length > max_len )
- max_len = arg->length;
- if ( max_len == 1 )
- {
- int ind = arg->IntVal();
- if ( ind < 1 || ind > shape[i] )
- {
- error->Report( "index #", i+1, "into",
- this, "is out of range");
- SUBOP_CLEANUP_1
- return error_value();
- }
- offset += cur_factor * (ind - 1);
- }
- }
- else
- { // Missing subscript.
- if ( shape[i] > max_len )
- max_len = shape[i];
- if ( max_len == 1 )
- offset += cur_factor * (shape[i] - 1);
- }
- factor[i] = cur_factor;
- cur_factor *= shape[i];
- }
- // Check to see if we're valid.
- if ( cur_factor > Length() )
- {
- error->Report( "\"::shape\"/length mismatch" );
- SUBOP_CLEANUP_1
- return error_value();
- }
- if ( max_len == 1 )
- {
- SUBOP_CLEANUP_1
- ++offset;
- // Should separate ArrayRef to get a single value??
- return ArrayRef( &offset, 1 );
- }
- int* index_is_copy = new int[shape_len];
- int** index = new int*[shape_len];
- int* cur = new int[shape_len];
- int* len = new int[shape_len];
- int vecsize = 1;
- int is_element = 1;
- int spoof_dimension = 0;
- for ( i = 0; i < args_len; ++i )
- {
- const Value* arg = (*args_val)[i];
- if ( arg )
- {
- index[i] = GenerateIndices( arg, len[i],
- index_is_copy[i], 0 );
- spoof_dimension = 0;
- }
- else
- { // Spoof entire dimension.
- len[i] = shape[i];
- index[i] = new int[len[i]];
- for ( int j = 0; j < len[i]; j++ )
- index[i][j] = j+1;
- index_is_copy[i] = 1;
- spoof_dimension = 1;
- }
- if ( is_element && len[i] > 1 )
- is_element = 0;
- vecsize *= len[i];
- cur[i] = 0;
- if ( ! spoof_dimension )
- {
- for ( int j = 0; j < len[i]; ++j )
- {
- if ( index[i][j] >= 1 &&
- index[i][j] <= shape[i] )
- continue;
- if ( len[i] > 1 )
- error->Report( "index #", i+1, ",",
- j+1, " into ", this,
- "is out of range.");
- else
- error->Report( "index #", i+1, "into",
- this, "is out of range.");
- SUBOP_ABORT(i, error_value())
- }
- }
- }
- // Loop through filling resultant vector.
- Value* result;
- switch ( Type() )
- {
- #define SUBSCRIPT_OP_ACTION(tag,type,accessor,LEN,OFFSET,copy_func,ERROR)\
- case tag: \
- { \
- type* vec = accessor; \
- type* ret = new type[vecsize]; \
- \
- for ( int v = 0; v < vecsize; ++v ) \
- { \
- /**** Calculate offset ****/ \
- for ( i = 0, offset = 0; i < shape_len; ++i ) \
- offset += factor[i] * \
- (index[i][cur[i]]-1); \
- /**** Set Value ****/ \
- ERROR \
- ret[v] = copy_func( vec[OFFSET] ); \
- /**** Advance counters ****/ \
- for ( i = 0; i < shape_len; ++i ) \
- if ( ++cur[i] < len[i] ) \
- break; \
- else \
- cur[i] = 0; \
- } \
- \
- result = new Value( ret, vecsize ); \
- if ( ! is_element ) \
- { \
- for ( int x = 0, z = 0; x < shape_len; ++x ) \
- if ( len[x] > 1 ) \
- len[z++] = len[x]; \
- \
- result->AssignAttribute( "shape", \
- new Value( len, z ) ); \
- if ( op_val ) \
- result->AssignAttribute( "op[]", op_val );\
- } \
- else \
- delete len; \
- } \
- break;
- SUBSCRIPT_OP_ACTION(TYPE_BOOL,glish_bool,BoolPtr(),length,offset,,)
- SUBSCRIPT_OP_ACTION(TYPE_BYTE,byte,BytePtr(),length,offset,,)
- SUBSCRIPT_OP_ACTION(TYPE_SHORT,short,ShortPtr(),length,offset,,)
- SUBSCRIPT_OP_ACTION(TYPE_INT,int,IntPtr(),length,offset,,)
- SUBSCRIPT_OP_ACTION(TYPE_FLOAT,float,FloatPtr(),length,offset,,)
- SUBSCRIPT_OP_ACTION(TYPE_DOUBLE,double,DoublePtr(),length,offset,,)
- SUBSCRIPT_OP_ACTION(TYPE_COMPLEX,complex,ComplexPtr(),length,offset,,)
- SUBSCRIPT_OP_ACTION(TYPE_DCOMPLEX,dcomplex,DcomplexPtr(),length,offset,,)
- SUBSCRIPT_OP_ACTION(TYPE_STRING,charptr,StringPtr(),length,offset,strdup,)
- case TYPE_SUBVEC_REF:
- case TYPE_SUBVEC_CONST:
- {
- VecRef* ref = VecRefPtr();
- Value* theVal = ref->Val();
- int theLen = theVal->Length();
- switch ( theVal->Type() )
- {
- #define SUBSCRIPT_OP_ACTION_XLATE(EXTRA_ERROR) \
- int err; \
- int off = ref->TranslateIndex( offset, &err ); \
- if ( err ) \
- { \
- EXTRA_ERROR \
- delete ret; \
- SUBOP_CLEANUP_2(shape_len) \
- return error_value(); \
- }
- SUBSCRIPT_OP_ACTION(TYPE_BOOL, glish_bool, theVal->BoolPtr(),
- theLen, off,,SUBSCRIPT_OP_ACTION_XLATE(;))
- SUBSCRIPT_OP_ACTION(TYPE_BYTE, byte, theVal->BytePtr(),
- theLen, off,,SUBSCRIPT_OP_ACTION_XLATE(;))
- SUBSCRIPT_OP_ACTION(TYPE_SHORT, short, theVal->ShortPtr(),
- theLen, off,,SUBSCRIPT_OP_ACTION_XLATE(;))
- SUBSCRIPT_OP_ACTION(TYPE_INT, int, theVal->IntPtr(),
- theLen, off,,SUBSCRIPT_OP_ACTION_XLATE(;))
- SUBSCRIPT_OP_ACTION(TYPE_FLOAT, float, theVal->FloatPtr(),
- theLen, off,,SUBSCRIPT_OP_ACTION_XLATE(;))
- SUBSCRIPT_OP_ACTION(TYPE_DOUBLE, double, theVal->DoublePtr(),
- theLen, off,,SUBSCRIPT_OP_ACTION_XLATE(;))
- SUBSCRIPT_OP_ACTION(TYPE_COMPLEX, complex, theVal->ComplexPtr(),
- theLen, off,,SUBSCRIPT_OP_ACTION_XLATE(;))
- SUBSCRIPT_OP_ACTION(TYPE_DCOMPLEX, dcomplex, theVal->DcomplexPtr(),
- theLen, off,,SUBSCRIPT_OP_ACTION_XLATE(;))
- SUBSCRIPT_OP_ACTION(TYPE_STRING, charptr, theVal->StringPtr(),
- theLen, off,strdup,SUBSCRIPT_OP_ACTION_XLATE(for(int X=0;X<v;X++) delete (char *) ret[X];))
- default:
- fatal->Report(
- "bad subref type in Value::operator[]" );
- }
- }
- break;
- default:
- fatal->Report( "bad type in Value::operator[]" );
- }
- SUBOP_CLEANUP_2(shape_len)
- return result;
- }
- Value* Value::Pick( const Value *index ) const
- {
- #define PICK_CLEANUP \
- if ( shape_is_copy ) \
- delete shape; \
- if ( ishape_is_copy ) \
- delete ishape; \
- if ( indx_is_copy ) \
- delete indx; \
- delete factor;
- #define PICK_INITIALIZE(error_return,SHORT) \
- const attributeptr attr = AttributePtr(); \
- const attributeptr iattr = index->AttributePtr(); \
- const Value* shape_val = 0; \
- const Value* ishape_val = 0; \
- int shape_len = 0; \
- int ishape_len = 0; \
- \
- if ( attr && (shape_val = (*attr)["shape"]) && \
- shape_val->IsNumeric() ) \
- shape_len = shape_val->Length(); \
- if ( iattr && (ishape_val = (*iattr)["shape"]) && \
- ishape_val->IsNumeric() ) \
- ishape_len = ishape_val->Length(); \
- \
- /* Neither has a shape so pick from the vector. */ \
- if ( ishape_len <= 1 && shape_len <= 1 ) \
- { \
- SHORT \
- } \
- \
- if ( ! ishape_len ) \
- { \
- if ( ishape_val ) \
- error->Report("error in the array \"::shape\": ",\
- ishape_val ); \
- else \
- error->Report( "no \"::shape\" for ", index, \
- " but the array has \"::shape\"" ); \
- return error_return; \
- } \
- if ( ! shape_len ) \
- { \
- if ( shape_val ) \
- error->Report("error in the array \"::shape\": ",\
- shape_val ); \
- else \
- error->Report( "no \"::shape\" for ", this, \
- " but the index has \"::shape\"" ); \
- return error_return; \
- } \
- \
- if ( ishape_len > 2 ) \
- { \
- error->Report("invalid index of dimension (=", ishape_len, \
- ") greater than 2"); \
- return error_return; \
- } \
- \
- int shape_is_copy = 0; \
- int ishape_is_copy = 0; \
- int indx_is_copy = 0; \
- int* shape = shape_val->CoerceToIntArray( shape_is_copy, shape_len );\
- int* ishape = \
- ishape_val->CoerceToIntArray( ishape_is_copy, ishape_len );\
- int ilen = index->Length(); \
- int len = Length(); \
- int* factor = new int[shape_len]; \
- int offset = 1; \
- int* indx = index->CoerceToIntArray( indx_is_copy, ilen ); \
- Value* result = 0; \
- \
- if ( ishape[1] != shape_len ) \
- { \
- PICK_CLEANUP \
- error->Report( "wrong number of columns in index (=", \
- ishape[1], ") expected ", shape_len ); \
- return error_return; \
- } \
- if ( ilen < ishape[0] * ishape[1] ) \
- { \
- PICK_CLEANUP \
- error->Report( "Index \"::shape\"/length mismatch" );\
- return error_return; \
- } \
- for ( int i = 0; i < shape_len; ++i ) \
- { \
- factor[i] = offset; \
- offset *= shape[i]; \
- } \
- \
- if ( len < offset ) \
- { \
- PICK_CLEANUP \
- error->Report("Array \"::shape\"/length mismatch"); \
- return error_return; \
- }
- PICK_INITIALIZE(error_value(),return this->operator[]( index );)
- switch ( Type() )
- {
- #define PICK_ACTION_CLEANUP for(int X=0;X<i;X++) delete (char *) ret[X];
- #define PICK_ACTION(tag,type,accessor,OFFSET,COPY_FUNC,XLATE,CLEANUP) \
- case tag: \
- { \
- type* ptr = accessor(); \
- type* ret = new type[ishape[0]]; \
- int cur = 0; \
- for ( i = 0; i < ishape[0]; ++i ) \
- { \
- for ( int j = 0, offset = 0; j < ishape[1]; ++j )\
- { \
- cur = indx[i + j * ishape[0]]; \
- if ( cur < 1 || cur > shape[j] ) \
- { \
- PICK_CLEANUP \
- CLEANUP \
- delete ret; \
- error->Report( "index number ", j,\
- " (=", cur, ") is out of range" );\
- return error_value(); \
- } \
- offset += factor[j] * (cur-1); \
- } \
- XLATE \
- ret[i] = COPY_FUNC( ptr[ OFFSET ] ); \
- } \
- result = new Value( ret, ishape[0] ); \
- } \
- b