dataObject * value_to_data_object( const Environment& env, const Value & value )
{
void *p;
dataObject* clipsdo = new dataObject;
SetpType(clipsdo, value.type() );
switch ( value.type() ) {
case TYPE_SYMBOL:
case TYPE_STRING:
case TYPE_INSTANCE_NAME:
p = EnvAddSymbol( env.cobj(),
const_cast<char*>( value.as_string().c_str())
);
SetpValue(clipsdo, p);
return clipsdo;
case TYPE_INTEGER:
p = EnvAddLong( env.cobj(), value.as_integer() );
SetpValue(clipsdo, p);
return clipsdo;
case TYPE_FLOAT:
p = EnvAddDouble( env.cobj(), value.as_float() );
SetpValue(clipsdo, p);
return clipsdo;
case TYPE_EXTERNAL_ADDRESS:
p = EnvAddExternalAddress( env.cobj(), value.as_address(), EXTERNAL_ADDRESS );
SetpValue(clipsdo, p);
return clipsdo;
default:
throw std::logic_error( "clipsmm::value_to_data_object: Unhandled data object type" );
}
return NULL;
}
dataObject * value_to_data_object( const Environment& env, const Values & values )
{
void *p, *p2;
if (values.size() == 0 )
return NULL;
if ( values.size() == 1 )
return value_to_data_object( env, values[0] );
dataObject* clipsdo = new dataObject;
p = EnvCreateMultifield( env.cobj(), values.size() );
for (unsigned int iter = 0; iter < values.size(); iter++) {
unsigned int mfi = iter + 1; // mfptr indices start at 1
SetMFType(p, mfi, values[iter].type());
switch ( values[iter].type() ) {
case TYPE_SYMBOL:
case TYPE_STRING:
case TYPE_INSTANCE_NAME:
p2 = EnvAddSymbol( env.cobj(),
const_cast<char*>(values[iter].as_string().c_str())
);
SetMFValue(p, mfi, p2);
break;
case TYPE_INTEGER:
p2 = EnvAddLong( env.cobj(), values[iter].as_integer() );
SetMFValue(p, mfi, p2);
break;
case TYPE_FLOAT:
p2 = EnvAddDouble( env.cobj(), values[iter].as_float() );
SetMFValue(p, mfi, p2);
break;
case TYPE_EXTERNAL_ADDRESS:
p2 = EnvAddExternalAddress( env.cobj(), values[iter].as_address(), EXTERNAL_ADDRESS );
SetMFValue(p, mfi, p2);
break;
default:
throw std::logic_error( "clipsmm::value_to_data_object: Unhandled data object type" );
}
}
SetpType(clipsdo, MULTIFIELD);
SetpValue(clipsdo, p);
SetpDOBegin(clipsdo, 1);
SetpDOEnd(clipsdo, values.size());
return clipsdo;
}
static void NewCAddress(
void *theEnv,
DATA_OBJECT *rv)
{
int numberOfArguments;
numberOfArguments = EnvRtnArgCount(theEnv);
if (numberOfArguments != 1)
{
PrintErrorID(theEnv,"NEW",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"Function new expected no additional arguments for the C external language type.\n");
SetEvaluationError(theEnv,TRUE);
return;
}
SetpType(rv,EXTERNAL_ADDRESS);
SetpValue(rv,EnvAddExternalAddress(theEnv,NULL,0));
}
globle void DeriveDefaultFromConstraints(
void *theEnv,
CONSTRAINT_RECORD *constraints,
DATA_OBJECT *theDefault,
int multifield,
int garbageMultifield)
{
unsigned short theType;
unsigned long minFields;
void *theValue;
/*=============================================================*/
/* If no constraints are specified, then use the symbol nil as */
/* a default for single field slots and a multifield of length */
/* 0 as a default for multifield slots. */
/*=============================================================*/
if (constraints == NULL)
{
if (multifield)
{
SetpType(theDefault,MULTIFIELD);
SetpDOBegin(theDefault,1);
SetpDOEnd(theDefault,0);
if (garbageMultifield) SetpValue(theDefault,(void *) EnvCreateMultifield(theEnv,0L));
else SetpValue(theDefault,(void *) CreateMultifield2(theEnv,0L));
}
else
{
theDefault->type = SYMBOL;
theDefault->value = EnvAddSymbol(theEnv,(char*)"nil");
}
return;
}
/*=========================================*/
/* Determine the default's type and value. */
/*=========================================*/
if (constraints->anyAllowed || constraints->symbolsAllowed)
{
theType = SYMBOL;
theValue = FindDefaultValue(theEnv,SYMBOL,constraints,EnvAddSymbol(theEnv,(char*)"nil"));
}
else if (constraints->stringsAllowed)
{
theType = STRING;
theValue = FindDefaultValue(theEnv,STRING,constraints,EnvAddSymbol(theEnv,(char*)""));
}
else if (constraints->integersAllowed)
{
theType = INTEGER;
theValue = FindDefaultValue(theEnv,INTEGER,constraints,EnvAddLong(theEnv,0LL));
}
else if (constraints->floatsAllowed)
{
theType = FLOAT;
theValue = FindDefaultValue(theEnv,FLOAT,constraints,EnvAddDouble(theEnv,0.0));
}
#if OBJECT_SYSTEM
else if (constraints->instanceNamesAllowed)
{
theType = INSTANCE_NAME;
theValue = FindDefaultValue(theEnv,INSTANCE_NAME,constraints,EnvAddSymbol(theEnv,(char*)"nil"));
}
else if (constraints->instanceAddressesAllowed)
{
theType = INSTANCE_ADDRESS;
theValue = (void *) &InstanceData(theEnv)->DummyInstance;
}
#endif
#if DEFTEMPLATE_CONSTRUCT
else if (constraints->factAddressesAllowed)
{
theType = FACT_ADDRESS;
theValue = (void *) &FactData(theEnv)->DummyFact;
}
#endif
else if (constraints->externalAddressesAllowed)
{
theType = EXTERNAL_ADDRESS;
theValue = EnvAddExternalAddress(theEnv,NULL,0);
}
else
{
theType = SYMBOL;
theValue = EnvAddSymbol(theEnv,(char*)"nil");
}
/*=========================================================*/
/* If the default is for a multifield slot, then create a */
/* multifield default value that satisfies the cardinality */
/* constraints for the slot. The default value for a */
/* multifield slot is a multifield of length 0. */
/*=========================================================*/
if (multifield)
{
if (constraints->minFields == NULL) minFields = 0;
else if (constraints->minFields->value == SymbolData(theEnv)->NegativeInfinity) minFields = 0;
else minFields = (unsigned long) ValueToLong(constraints->minFields->value);
SetpType(theDefault,MULTIFIELD);
SetpDOBegin(theDefault,1);
SetpDOEnd(theDefault,(long) minFields);
if (garbageMultifield) SetpValue(theDefault,(void *) EnvCreateMultifield(theEnv,minFields));
else SetpValue(theDefault,(void *) CreateMultifield2(theEnv,minFields));
for (; minFields > 0; minFields--)
{
SetMFType(GetpValue(theDefault),minFields,theType);
SetMFValue(GetpValue(theDefault),minFields,theValue);
}
}
else
{
theDefault->type = theType;
theDefault->value = theValue;
}
}
