/tags/SN-NG4.1/snavigator/demo/c++/glish/Value.cc

// $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