/*********************************************************
NAME : DisplaySlotConstraintInfo
DESCRIPTION : Displays a table summary of type-checking
facets for the slots of a class
including:
type
allowed-symbols
allowed-integers
allowed-floats
allowed-values
allowed-instance-names
range
min-number-of-elements
max-number-of-elements
The function also displays the source
class(es) for the facets
INPUTS : 1) A format string for use in sprintf
2) A buffer to store the display in
3) Maximum buffer size
4) A pointer to the class
RETURNS : Nothing useful
SIDE EFFECTS : Buffer written to and displayed
NOTES : None
*********************************************************/
static void DisplaySlotConstraintInfo(
Environment *theEnv,
const char *logicalName,
const char *slotNamePrintFormat,
char *buf,
unsigned maxlen,
Defclass *cls)
{
long i;
CONSTRAINT_RECORD *cr;
const char *strdest = "***describe-class***";
gensprintf(buf,slotNamePrintFormat,"SLOTS");
genstrcat(buf,"SYM STR INN INA EXA FTA INT FLT\n");
WriteString(theEnv,logicalName,buf);
for (i = 0 ; i < cls->instanceSlotCount ; i++)
{
cr = cls->instanceTemplate[i]->constraint;
gensprintf(buf,slotNamePrintFormat,cls->instanceTemplate[i]->slotName->name->contents);
if (cr != NULL)
{
genstrcat(buf,ConstraintCode(cr,cr->symbolsAllowed,cr->symbolRestriction));
genstrcat(buf,ConstraintCode(cr,cr->stringsAllowed,cr->stringRestriction));
genstrcat(buf,ConstraintCode(cr,cr->instanceNamesAllowed,
(cr->instanceNameRestriction || cr->classRestriction)));
genstrcat(buf,ConstraintCode(cr,cr->instanceAddressesAllowed,cr->classRestriction));
genstrcat(buf,ConstraintCode(cr,cr->externalAddressesAllowed,0));
genstrcat(buf,ConstraintCode(cr,cr->factAddressesAllowed,0));
genstrcat(buf,ConstraintCode(cr,cr->integersAllowed,cr->integerRestriction));
genstrcat(buf,ConstraintCode(cr,cr->floatsAllowed,cr->floatRestriction));
OpenStringDestination(theEnv,strdest,buf + strlen(buf),(maxlen - strlen(buf) - 1));
if (cr->integersAllowed || cr->floatsAllowed || cr->anyAllowed)
{
WriteString(theEnv,strdest,"RNG:[");
PrintExpression(theEnv,strdest,cr->minValue);
WriteString(theEnv,strdest,"..");
PrintExpression(theEnv,strdest,cr->maxValue);
WriteString(theEnv,strdest,"] ");
}
if (cls->instanceTemplate[i]->multiple)
{
WriteString(theEnv,strdest,"CRD:[");
PrintExpression(theEnv,strdest,cr->minFields);
WriteString(theEnv,strdest,"..");
PrintExpression(theEnv,strdest,cr->maxFields);
WriteString(theEnv,strdest,"]");
}
}
else
{
OpenStringDestination(theEnv,strdest,buf,maxlen);
WriteString(theEnv,strdest," + + + + + + + + RNG:[-oo..+oo]");
if (cls->instanceTemplate[i]->multiple)
WriteString(theEnv,strdest," CRD:[0..+oo]");
}
WriteString(theEnv,strdest,"\n");
CloseStringDestination(theEnv,strdest);
WriteString(theEnv,logicalName,buf);
}
}
/*************************************************************
NAME : DisplaySlotBasicInfo
DESCRIPTION : Displays a table summary of basic
facets for the slots of a class
including:
single/multiple
default/no-default/default-dynamic
inherit/no-inherit
read-write/initialize-only/read-only
local/shared
composite/exclusive
reactive/non-reactive
public/private
create-accessor read/write
override-message
The function also displays the source
class(es) for the facets
INPUTS : 1) The logical name of the output
2) A format string for use in sprintf
(for printing slot names)
3) A format string for use in sprintf
(for printing slot override message names)
4) A buffer to store the display in
5) A pointer to the class
RETURNS : Nothing useful
SIDE EFFECTS : Buffer written to and displayed
NOTES : None
*************************************************************/
static void DisplaySlotBasicInfo(
void *theEnv,
char *logicalName,
char *slotNamePrintFormat,
char *overrideMessagePrintFormat,
char *buf,
DEFCLASS *cls)
{
long i;
SLOT_DESC *sp;
char *createString;
gensprintf(buf,slotNamePrintFormat,"SLOTS");
#if DEFRULE_CONSTRUCT
genstrcat(buf,"FLD DEF PRP ACC STO MCH SRC VIS CRT ");
#else
genstrcat(buf,"FLD DEF PRP ACC STO SRC VIS CRT ");
#endif
EnvPrintRouter(theEnv,logicalName,buf);
gensprintf(buf,overrideMessagePrintFormat,"OVRD-MSG");
EnvPrintRouter(theEnv,logicalName,buf);
EnvPrintRouter(theEnv,logicalName,"SOURCE(S)\n");
for (i = 0 ; i < cls->instanceSlotCount ; i++)
{
sp = cls->instanceTemplate[i];
gensprintf(buf,slotNamePrintFormat,ValueToString(sp->slotName->name));
genstrcat(buf,sp->multiple ? "MLT " : "SGL ");
if (sp->noDefault)
genstrcat(buf,"NIL ");
else
genstrcat(buf,sp->dynamicDefault ? "DYN " : "STC ");
genstrcat(buf,sp->noInherit ? "NIL " : "INH ");
if (sp->initializeOnly)
genstrcat(buf,"INT ");
else if (sp->noWrite)
genstrcat(buf," R ");
else
genstrcat(buf,"RW ");
genstrcat(buf,sp->shared ? "SHR " : "LCL ");
#if DEFRULE_CONSTRUCT
genstrcat(buf,sp->reactive ? "RCT " : "NIL ");
#endif
genstrcat(buf,sp->composite ? "CMP " : "EXC ");
genstrcat(buf,sp->publicVisibility ? "PUB " : "PRV ");
createString = GetCreateAccessorString(sp);
if (createString[1] == '\0')
genstrcat(buf," ");
genstrcat(buf,createString);
if ((createString[1] == '\0') ? TRUE : (createString[2] == '\0'))
genstrcat(buf," ");
genstrcat(buf," ");
EnvPrintRouter(theEnv,logicalName,buf);
gensprintf(buf,overrideMessagePrintFormat,
sp->noWrite ? "NIL" : ValueToString(sp->overrideMessage));
EnvPrintRouter(theEnv,logicalName,buf);
PrintSlotSources(theEnv,logicalName,sp->slotName->name,&sp->cls->allSuperclasses,0,TRUE);
EnvPrintRouter(theEnv,logicalName,"\n");
}
}
globle const char *FloatToString(
void *theEnv,
double number)
{
char floatString[40];
int i;
char x;
void *thePtr;
gensprintf(floatString,"%.15g",number);
for (i = 0; (x = floatString[i]) != '\0'; i++)
{
if ((x == '.') || (x == 'e'))
{
thePtr = EnvAddSymbol(theEnv,floatString);
return(ValueToString(thePtr));
}
}
genstrcat(floatString,".0");
thePtr = EnvAddSymbol(theEnv,floatString);
return(ValueToString(thePtr));
}
const char *FloatToString(
Environment *theEnv,
double number)
{
char floatString[40];
int i;
char x;
CLIPSLexeme *thePtr;
gensprintf(floatString,"%.15g",number);
for (i = 0; (x = floatString[i]) != '\0'; i++)
{
if ((x == '.') || (x == 'e'))
{
thePtr = CreateString(theEnv,floatString);
return thePtr->contents;
}
}
genstrcat(floatString,".0");
thePtr = CreateString(theEnv,floatString);
return thePtr->contents;
}
static void PatternNetErrorMessage(
void *theEnv,
struct factPatternNode *patternPtr)
{
char buffer[60];
struct templateSlot *theSlots;
int i;
/*=======================================*/
/* Print the fact being pattern matched. */
/*=======================================*/
PrintErrorID(theEnv,"FACTMCH",1,TRUE);
EnvPrintRouter(theEnv,WERROR,"This error occurred in the fact pattern network\n");
EnvPrintRouter(theEnv,WERROR," Currently active fact: ");
PrintFact(theEnv,WERROR,FactData(theEnv)->CurrentPatternFact,FALSE,FALSE);
EnvPrintRouter(theEnv,WERROR,"\n");
/*==============================================*/
/* Print the field position or slot name of the */
/* pattern from which the error originated. */
/*==============================================*/
if (FactData(theEnv)->CurrentPatternFact->whichDeftemplate->implied)
{
gensprintf(buffer," Problem resides in field #%d\n",patternPtr->whichField);
}
else
{
theSlots = FactData(theEnv)->CurrentPatternFact->whichDeftemplate->slotList;
for (i = 0; i < (int) patternPtr->whichSlot; i++) theSlots = theSlots->next;
gensprintf(buffer," Problem resides in slot %s\n",ValueToString(theSlots->slotName));
}
EnvPrintRouter(theEnv,WERROR,buffer);
/*==========================================================*/
/* Trace the pattern to its entry point to the join network */
/* (which then traces to the defrule data structure so that */
/* the name(s) of the rule(s) utilizing the patterns can be */
/* printed). */
/*==========================================================*/
TraceErrorToJoin(theEnv,patternPtr,FALSE);
EnvPrintRouter(theEnv,WERROR,"\n");
}
globle void ShowAlphaHashTable(
void *theEnv)
{
int i, count;
long totalCount = 0;
struct alphaMemoryHash *theEntry;
struct partialMatch *theMatch;
char buffer[40];
for (i = 0; i < ALPHA_MEMORY_HASH_SIZE; i++)
{
for (theEntry = DefruleData(theEnv)->AlphaMemoryTable[i], count = 0;
theEntry != NULL;
theEntry = theEntry->next)
{ count++; }
if (count != 0)
{
totalCount += count;
gensprintf(buffer,"%4d: %4d ->",i,count);
EnvPrintRouter(theEnv,WDISPLAY,buffer);
for (theEntry = DefruleData(theEnv)->AlphaMemoryTable[i], count = 0;
theEntry != NULL;
theEntry = theEntry->next)
{
for (theMatch = theEntry->alphaMemory;
theMatch != NULL;
theMatch = theMatch->nextInMemory)
{ count++; }
gensprintf(buffer," %4d",count);
EnvPrintRouter(theEnv,WDISPLAY,buffer);
if (theEntry->owner->rightHash == NULL)
{ EnvPrintRouter(theEnv,WDISPLAY,"*"); }
}
EnvPrintRouter(theEnv,WDISPLAY,"\n");
}
}
gensprintf(buffer,"Total Count: %ld\n",totalCount);
EnvPrintRouter(theEnv,WDISPLAY,buffer);
}
void PrintUnsignedInteger(
Environment *theEnv,
const char *logicalName,
unsigned long long number)
{
char printBuffer[32];
gensprintf(printBuffer,"%llu",number);
WriteString(theEnv,logicalName,printBuffer);
}
void WriteInteger(
Environment *theEnv,
const char *logicalName,
long long number)
{
char printBuffer[32];
gensprintf(printBuffer,"%lld",number);
WriteString(theEnv,logicalName,printBuffer);
}
globle void PrintLongInteger(
void *theEnv,
const char *logicalName,
long long number)
{
char printBuffer[32];
gensprintf(printBuffer,"%lld",number);
EnvPrintRouter(theEnv,logicalName,printBuffer);
}
globle void PrintMethod(
void *theEnv,
EXEC_STATUS,
char *buf,
int buflen,
DEFMETHOD *meth)
{
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(theEnv,execStatus)
#endif
long j,k;
register RESTRICTION *rptr;
char numbuf[15];
buf[0] = '\0';
if (meth->system)
genstrncpy(buf,"SYS",(STD_SIZE) buflen);
gensprintf(numbuf,"%-2d ",meth->index);
genstrncat(buf,numbuf,(STD_SIZE) buflen-3);
for (j = 0 ; j < meth->restrictionCount ; j++)
{
rptr = &meth->restrictions[j];
if ((((int) j) == meth->restrictionCount-1) && (meth->maxRestrictions == -1))
{
if ((rptr->tcnt == 0) && (rptr->query == NULL))
{
genstrncat(buf,"$?",buflen-strlen(buf));
break;
}
genstrncat(buf,"($? ",buflen-strlen(buf));
}
else
genstrncat(buf,"(",buflen-strlen(buf));
for (k = 0 ; k < rptr->tcnt ; k++)
{
#if OBJECT_SYSTEM
genstrncat(buf,EnvGetDefclassName(theEnv,execStatus,rptr->types[k]),buflen-strlen(buf));
#else
genstrncat(buf,TypeName(theEnv,execStatus,ValueToInteger(rptr->types[k])),buflen-strlen(buf));
#endif
if (((int) k) < (((int) rptr->tcnt) - 1))
genstrncat(buf," ",buflen-strlen(buf));
}
if (rptr->query != NULL)
{
if (rptr->tcnt != 0)
genstrncat(buf," ",buflen-strlen(buf));
genstrncat(buf,"<qry>",buflen-strlen(buf));
}
genstrncat(buf,")",buflen-strlen(buf));
if (((int) j) != (((int) meth->restrictionCount)-1))
genstrncat(buf," ",buflen-strlen(buf));
}
}
void FactRetractedErrorMessage(
Environment *theEnv,
Fact *theFact)
{
char tempBuffer[20];
PrintErrorID(theEnv,"PRNTUTIL",11,false);
WriteString(theEnv,STDERR,"The fact ");
gensprintf(tempBuffer,"f-%lld",theFact->factIndex);
WriteString(theEnv,STDERR,tempBuffer);
WriteString(theEnv,STDERR," has been retracted.\n");
}
const char *LongIntegerToString(
Environment *theEnv,
long long number)
{
char buffer[50];
CLIPSLexeme *thePtr;
gensprintf(buffer,"%lld",number);
thePtr = CreateString(theEnv,buffer);
return thePtr->contents;
}
globle const char *LongIntegerToString(
void *theEnv,
long long number)
{
char buffer[50];
void *thePtr;
gensprintf(buffer,"%lld",number);
thePtr = EnvAddSymbol(theEnv,buffer);
return(ValueToString(thePtr));
}
static void PrintCAddress(
void *theEnv,
const char *logicalName,
void *theValue)
{
char buffer[20];
EnvPrintRouter(theEnv,logicalName,"<Pointer-C-");
gensprintf(buffer,"%p",ValueToExternalAddress(theValue));
EnvPrintRouter(theEnv,logicalName,buffer);
EnvPrintRouter(theEnv,logicalName,">");
}
void FactRetractedErrorMessage(
void *theEnv,
void *theVFact)
{
char tempBuffer[20];
struct fact *theFact = (struct fact *) theVFact;
PrintErrorID(theEnv,"PRNTUTIL",11,FALSE);
EnvPrintRouter(theEnv,WERROR,"The fact ");
gensprintf(tempBuffer,"f-%lld",theFact->factIndex);
EnvPrintRouter(theEnv,WERROR,tempBuffer);
EnvPrintRouter(theEnv,WERROR," has been retracted.\n");
}
static void PrintActivation(
void *theEnv,
char *logicalName,
void *vTheActivation)
{
struct activation *theActivation = (struct activation *) vTheActivation;
char printSpace[20];
gensprintf(printSpace,"%-6d ",theActivation->salience);
EnvPrintRouter(theEnv,logicalName,printSpace);
EnvPrintRouter(theEnv,logicalName,ValueToString(theActivation->theRule->header.name));
EnvPrintRouter(theEnv,logicalName,(char*)": ");
PrintPartialMatch(theEnv,logicalName,theActivation->basis);
}
void FactVarSlotErrorMessage1(
Environment *theEnv,
Fact *theFact,
const char *varSlot)
{
char tempBuffer[20];
PrintErrorID(theEnv,"PRNTUTIL",12,false);
WriteString(theEnv,STDERR,"The variable/slot reference ?");
WriteString(theEnv,STDERR,varSlot);
WriteString(theEnv,STDERR," cannot be resolved because the referenced fact ");
gensprintf(tempBuffer,"f-%lld",theFact->factIndex);
WriteString(theEnv,STDERR,tempBuffer);
WriteString(theEnv,STDERR," has been retracted.\n");
}
void FactVarSlotErrorMessage2(
Environment *theEnv,
Fact *theFact,
const char *varSlot)
{
char tempBuffer[20];
PrintErrorID(theEnv,"PRNTUTIL",13,false);
WriteString(theEnv,STDERR,"The variable/slot reference ?");
WriteString(theEnv,STDERR,varSlot);
WriteString(theEnv,STDERR," is invalid because the referenced fact ");
gensprintf(tempBuffer,"f-%lld",theFact->factIndex);
WriteString(theEnv,STDERR,tempBuffer);
WriteString(theEnv,STDERR," does not contain the specified slot.\n");
}
void FactVarSlotErrorMessage2(
void *theEnv,
void *theVFact,
const char *varSlot)
{
char tempBuffer[20];
struct fact *theFact = (struct fact *) theVFact;
PrintErrorID(theEnv,"PRNTUTIL",13,FALSE);
EnvPrintRouter(theEnv,WERROR,"The variable/slot reference ?");
EnvPrintRouter(theEnv,WERROR,varSlot);
EnvPrintRouter(theEnv,WERROR," is invalid because the referenced fact ");
gensprintf(tempBuffer,"f-%lld",theFact->factIndex);
EnvPrintRouter(theEnv,WERROR,tempBuffer);
EnvPrintRouter(theEnv,WERROR," does not contain the specified slot.\n");
}
void FactVarSlotErrorMessage1(
void *theEnv,
void *theVFact,
const char *varSlot)
{
char tempBuffer[20];
struct fact *theFact = (struct fact *) theVFact;
PrintErrorID(theEnv,"PRNTUTIL",12,FALSE);
EnvPrintRouter(theEnv,WERROR,"The variable/slot reference ?");
EnvPrintRouter(theEnv,WERROR,varSlot);
EnvPrintRouter(theEnv,WERROR," cannot be resolved because the referenced fact ");
gensprintf(tempBuffer,"f-%lld",theFact->factIndex);
EnvPrintRouter(theEnv,WERROR,tempBuffer);
EnvPrintRouter(theEnv,WERROR," has been retracted.\n");
}
void ProfileInfoCommand(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
char buffer[512];
/*==================================*/
/* If code is still being profiled, */
/* update the profile end time. */
/*==================================*/
if (ProfileFunctionData(theEnv)->ProfileUserFunctions || ProfileFunctionData(theEnv)->ProfileConstructs)
{
ProfileFunctionData(theEnv)->ProfileEndTime = gentime();
ProfileFunctionData(theEnv)->ProfileTotalTime += (ProfileFunctionData(theEnv)->ProfileEndTime - ProfileFunctionData(theEnv)->ProfileStartTime);
}
/*==================================*/
/* Print the profiling information. */
/*==================================*/
if (ProfileFunctionData(theEnv)->LastProfileInfo != NO_PROFILE)
{
gensprintf(buffer,"Profile elapsed time = %g seconds\n",
ProfileFunctionData(theEnv)->ProfileTotalTime);
WriteString(theEnv,STDOUT,buffer);
if (ProfileFunctionData(theEnv)->LastProfileInfo == USER_FUNCTIONS)
{ WriteString(theEnv,STDOUT,"Function Name "); }
else if (ProfileFunctionData(theEnv)->LastProfileInfo == CONSTRUCTS_CODE)
{ WriteString(theEnv,STDOUT,"Construct Name "); }
WriteString(theEnv,STDOUT,"Entries Time % Time+Kids %+Kids\n");
if (ProfileFunctionData(theEnv)->LastProfileInfo == USER_FUNCTIONS)
{ WriteString(theEnv,STDOUT,"------------- "); }
else if (ProfileFunctionData(theEnv)->LastProfileInfo == CONSTRUCTS_CODE)
{ WriteString(theEnv,STDOUT,"-------------- "); }
WriteString(theEnv,STDOUT,"------- ------ ----- --------- ------\n");
}
if (ProfileFunctionData(theEnv)->LastProfileInfo == USER_FUNCTIONS) OutputUserFunctionsInfo(theEnv);
if (ProfileFunctionData(theEnv)->LastProfileInfo == CONSTRUCTS_CODE) OutputConstructsCodeInfo(theEnv);
}
globle struct fact *GetFactAddressOrIndexArgument(
void *theEnv,
const char *theFunction,
int position,
int noFactError)
{
DATA_OBJECT item;
long long factIndex;
struct fact *theFact;
char tempBuffer[20];
EnvRtnUnknown(theEnv,position,&item);
if (GetType(item) == FACT_ADDRESS)
{
if (((struct fact *) GetValue(item))->garbage) return(NULL);
else return (((struct fact *) GetValue(item)));
}
else if (GetType(item) == INTEGER)
{
factIndex = ValueToLong(item.value);
if (factIndex < 0)
{
ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index");
return(NULL);
}
theFact = FindIndexedFact(theEnv,factIndex);
if ((theFact == NULL) && noFactError)
{
gensprintf(tempBuffer,"f-%lld",factIndex);
CantFindItemErrorMessage(theEnv,"fact",tempBuffer);
return(NULL);
}
return(theFact);
}
ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index");
return(NULL);
}
globle void ShowFactHashTable(
void *theEnv)
{
int i, count;
struct factHashEntry *theEntry;
char buffer[20];
for (i = 0; i < FactData(theEnv)->FactHashTableSize; i++)
{
for (theEntry = FactData(theEnv)->FactHashTable[i], count = 0;
theEntry != NULL;
theEntry = theEntry->next)
{ count++; }
if (count != 0)
{
gensprintf(buffer,"%4d: %4d\n",i,count);
EnvPrintRouter(theEnv,WDISPLAY,buffer);
}
}
}
static void ShowJoins(
void *theEnv,
void *theRule)
{
struct defrule *rulePtr;
struct joinNode *theJoin;
struct joinNode *joinList[MAXIMUM_NUMBER_OF_PATTERNS];
int numberOfJoins;
char rhsType;
rulePtr = (struct defrule *) theRule;
/*=================================================*/
/* Loop through each of the disjuncts for the rule */
/*=================================================*/
while (rulePtr != NULL)
{
/*=====================================*/
/* Determine the number of join nodes. */
/*=====================================*/
numberOfJoins = -1;
theJoin = rulePtr->lastJoin;
while (theJoin != NULL)
{
if (theJoin->joinFromTheRight)
{
numberOfJoins++;
joinList[numberOfJoins] = theJoin;
theJoin = (struct joinNode *) theJoin->rightSideEntryStructure;
}
else
{
numberOfJoins++;
joinList[numberOfJoins] = theJoin;
theJoin = theJoin->lastLevel;
}
}
/*====================*/
/* Display the joins. */
/*====================*/
while (numberOfJoins >= 0)
{
char buffer[20];
if (joinList[numberOfJoins]->patternIsNegated)
{ rhsType = 'n'; }
else if (joinList[numberOfJoins]->patternIsExists)
{ rhsType = 'x'; }
else
{ rhsType = ' '; }
gensprintf(buffer,"%2d%c%c%c%c: ",(int) joinList[numberOfJoins]->depth,
(joinList[numberOfJoins]->firstJoin) ? 'f' : ' ',
rhsType,
(joinList[numberOfJoins]->joinFromTheRight) ? 'j' : ' ',
(joinList[numberOfJoins]->logicalJoin) ? 'l' : ' ');
EnvPrintRouter(theEnv,WDISPLAY,buffer);
PrintExpression(theEnv,WDISPLAY,joinList[numberOfJoins]->networkTest);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
if (joinList[numberOfJoins]->secondaryNetworkTest != NULL)
{
EnvPrintRouter(theEnv,WDISPLAY," SNT : ");
PrintExpression(theEnv,WDISPLAY,joinList[numberOfJoins]->secondaryNetworkTest);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
}
if (joinList[numberOfJoins]->leftHash != NULL)
{
EnvPrintRouter(theEnv,WDISPLAY," LH : ");
PrintExpression(theEnv,WDISPLAY,joinList[numberOfJoins]->leftHash);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
}
numberOfJoins--;
};
/*===============================*/
/* Proceed to the next disjunct. */
/*===============================*/
rulePtr = rulePtr->disjunct;
if (rulePtr != NULL) EnvPrintRouter(theEnv,WDISPLAY,"\n");
}
}
/******************************************************
NAME : EnvDescribeClass
DESCRIPTION : Displays direct superclasses and
subclasses and the entire precedence
list for a class
INPUTS : 1) The logical name of the output
2) Class pointer
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : None
******************************************************/
globle void EnvDescribeClass(
void *theEnv,
char *logicalName,
void *clsptr)
{
DEFCLASS *cls;
char buf[83],
slotNamePrintFormat[12],
overrideMessagePrintFormat[12];
int messageBanner;
long i;
size_t slotNameLength, maxSlotNameLength;
size_t overrideMessageLength, maxOverrideMessageLength;
cls = (DEFCLASS *) clsptr;
DisplaySeparator(theEnv,logicalName,buf,82,'=');
DisplaySeparator(theEnv,logicalName,buf,82,'*');
if (cls->abstract)
EnvPrintRouter(theEnv,logicalName,"Abstract: direct instances of this class cannot be created.\n\n");
else
{
EnvPrintRouter(theEnv,logicalName,"Concrete: direct instances of this class can be created.\n");
#if DEFRULE_CONSTRUCT
if (cls->reactive)
EnvPrintRouter(theEnv,logicalName,"Reactive: direct instances of this class can match defrule patterns.\n\n");
else
EnvPrintRouter(theEnv,logicalName,"Non-reactive: direct instances of this class cannot match defrule patterns.\n\n");
#else
EnvPrintRouter(theEnv,logicalName,"\n");
#endif
}
PrintPackedClassLinks(theEnv,logicalName,"Direct Superclasses:",&cls->directSuperclasses);
PrintPackedClassLinks(theEnv,logicalName,"Inheritance Precedence:",&cls->allSuperclasses);
PrintPackedClassLinks(theEnv,logicalName,"Direct Subclasses:",&cls->directSubclasses);
if (cls->instanceTemplate != NULL)
{
DisplaySeparator(theEnv,logicalName,buf,82,'-');
maxSlotNameLength = 5;
maxOverrideMessageLength = 8;
for (i = 0 ; i < cls->instanceSlotCount ; i++)
{
slotNameLength = strlen(ValueToString(cls->instanceTemplate[i]->slotName->name));
if (slotNameLength > maxSlotNameLength)
maxSlotNameLength = slotNameLength;
if (cls->instanceTemplate[i]->noWrite == 0)
{
overrideMessageLength =
strlen(ValueToString(cls->instanceTemplate[i]->overrideMessage));
if (overrideMessageLength > maxOverrideMessageLength)
maxOverrideMessageLength = overrideMessageLength;
}
}
if (maxSlotNameLength > 16)
maxSlotNameLength = 16;
if (maxOverrideMessageLength > 12)
maxOverrideMessageLength = 12;
#if WIN_MVC
gensprintf(slotNamePrintFormat,"%%-%Id.%Ids : ",maxSlotNameLength,maxSlotNameLength);
gensprintf(overrideMessagePrintFormat,"%%-%Id.%Ids ",maxOverrideMessageLength,
maxOverrideMessageLength);
#elif WIN_GCC
gensprintf(slotNamePrintFormat,"%%-%ld.%lds : ",(long) maxSlotNameLength,(long) maxSlotNameLength);
gensprintf(overrideMessagePrintFormat,"%%-%ld.%lds ",(long) maxOverrideMessageLength,
(long) maxOverrideMessageLength);
#else
gensprintf(slotNamePrintFormat,"%%-%zd.%zds : ",maxSlotNameLength,maxSlotNameLength);
gensprintf(overrideMessagePrintFormat,"%%-%zd.%zds ",maxOverrideMessageLength,
maxOverrideMessageLength);
#endif
DisplaySlotBasicInfo(theEnv,logicalName,slotNamePrintFormat,overrideMessagePrintFormat,buf,cls);
EnvPrintRouter(theEnv,logicalName,"\nConstraint information for slots:\n\n");
DisplaySlotConstraintInfo(theEnv,logicalName,slotNamePrintFormat,buf,82,cls);
}
if (cls->handlerCount > 0)
messageBanner = TRUE;
else
{
messageBanner = FALSE;
for (i = 1 ; i < cls->allSuperclasses.classCount ; i++)
if (cls->allSuperclasses.classArray[i]->handlerCount > 0)
{
messageBanner = TRUE;
break;
}
}
if (messageBanner)
{
DisplaySeparator(theEnv,logicalName,buf,82,'-');
EnvPrintRouter(theEnv,logicalName,"Recognized message-handlers:\n");
DisplayHandlersInLinks(theEnv,logicalName,&cls->allSuperclasses,0);
}
DisplaySeparator(theEnv,logicalName,buf,82,'*');
DisplaySeparator(theEnv,logicalName,buf,82,'=');
}
globle void RetractCommand(
void *theEnv)
{
long long factIndex;
struct fact *ptr;
struct expr *theArgument;
DATA_OBJECT theResult;
int argNumber;
/*================================*/
/* Iterate through each argument. */
/*================================*/
for (theArgument = GetFirstArgument(), argNumber = 1;
theArgument != NULL;
theArgument = GetNextArgument(theArgument), argNumber++)
{
/*========================*/
/* Evaluate the argument. */
/*========================*/
EvaluateExpression(theEnv,theArgument,&theResult);
/*===============================================*/
/* If the argument evaluates to an integer, then */
/* it's assumed to be the fact index of the fact */
/* to be retracted. */
/*===============================================*/
if (theResult.type == INTEGER)
{
/*==========================================*/
/* A fact index must be a positive integer. */
/*==========================================*/
factIndex = ValueToLong(theResult.value);
if (factIndex < 0)
{
ExpectedTypeError1(theEnv,(char*)"retract",argNumber,(char*)"fact-address, fact-index, or the symbol *");
return;
}
/*================================================*/
/* See if a fact with the specified index exists. */
/*================================================*/
ptr = FindIndexedFact(theEnv,factIndex);
/*=====================================*/
/* If the fact exists then retract it, */
/* otherwise print an error message. */
/*=====================================*/
if (ptr != NULL)
{ EnvRetract(theEnv,(void *) ptr); }
else
{
char tempBuffer[20];
gensprintf(tempBuffer,"f-%lld",factIndex);
CantFindItemErrorMessage(theEnv,(char*)"fact",tempBuffer);
}
}
/*===============================================*/
/* Otherwise if the argument evaluates to a fact */
/* address, we can directly retract it. */
/*===============================================*/
else if (theResult.type == FACT_ADDRESS)
{ EnvRetract(theEnv,theResult.value); }
/*============================================*/
/* Otherwise if the argument evaluates to the */
/* symbol *, then all facts are retracted. */
/*============================================*/
else if ((theResult.type == SYMBOL) ?
(strcmp(ValueToString(theResult.value),"*") == 0) : FALSE)
{
RemoveAllFacts(theEnv);
return;
}
/*============================================*/
/* Otherwise the argument has evaluated to an */
/* illegal value for the retract command. */
/*============================================*/
else
{
ExpectedTypeError1(theEnv,(char*)"retract",argNumber,(char*)"fact-address, fact-index, or the symbol *");
SetEvaluationError(theEnv,TRUE);
}
}
}
static intBool ParseAllowedValuesAttribute(
void *theEnv,
char *readSource,
char *constraintName,
CONSTRAINT_RECORD *constraints,
CONSTRAINT_PARSE_RECORD *parsedConstraints)
{
struct token inputToken;
int expectedType, restrictionType, error = FALSE;
struct expr *newValue, *lastValue;
int constantParsed = FALSE, variableParsed = FALSE;
char *tempPtr = NULL;
/*======================================================*/
/* The allowed-values attribute is not allowed if other */
/* allowed-... attributes have already been parsed. */
/*======================================================*/
if ((strcmp(constraintName,"allowed-values") == 0) &&
((parsedConstraints->allowedSymbols) ||
(parsedConstraints->allowedStrings) ||
(parsedConstraints->allowedLexemes) ||
(parsedConstraints->allowedIntegers) ||
(parsedConstraints->allowedFloats) ||
(parsedConstraints->allowedNumbers) ||
(parsedConstraints->allowedInstanceNames)))
{
if (parsedConstraints->allowedSymbols) tempPtr = "allowed-symbols";
else if (parsedConstraints->allowedStrings) tempPtr = "allowed-strings";
else if (parsedConstraints->allowedLexemes) tempPtr = "allowed-lexemes";
else if (parsedConstraints->allowedIntegers) tempPtr = "allowed-integers";
else if (parsedConstraints->allowedFloats) tempPtr = "allowed-floats";
else if (parsedConstraints->allowedNumbers) tempPtr = "allowed-numbers";
else if (parsedConstraints->allowedInstanceNames) tempPtr = "allowed-instance-names";
NoConjunctiveUseError(theEnv,"allowed-values",tempPtr);
return(FALSE);
}
/*=======================================================*/
/* The allowed-values/numbers/integers/floats attributes */
/* are not allowed with the range attribute. */
/*=======================================================*/
if (((strcmp(constraintName,"allowed-values") == 0) ||
(strcmp(constraintName,"allowed-numbers") == 0) ||
(strcmp(constraintName,"allowed-integers") == 0) ||
(strcmp(constraintName,"allowed-floats") == 0)) &&
(parsedConstraints->range))
{
NoConjunctiveUseError(theEnv,constraintName,"range");
return(FALSE);
}
/*===================================================*/
/* The allowed-... attributes are not allowed if the */
/* allowed-values attribute has already been parsed. */
/*===================================================*/
if ((strcmp(constraintName,"allowed-values") != 0) &&
(parsedConstraints->allowedValues))
{
NoConjunctiveUseError(theEnv,constraintName,"allowed-values");
return(FALSE);
}
/*==================================================*/
/* The allowed-numbers attribute is not allowed if */
/* the allowed-integers or allowed-floats attribute */
/* has already been parsed. */
/*==================================================*/
if ((strcmp(constraintName,"allowed-numbers") == 0) &&
((parsedConstraints->allowedFloats) || (parsedConstraints->allowedIntegers)))
{
if (parsedConstraints->allowedFloats) tempPtr = "allowed-floats";
else tempPtr = "allowed-integers";
NoConjunctiveUseError(theEnv,"allowed-numbers",tempPtr);
return(FALSE);
}
/*============================================================*/
/* The allowed-integers/floats attributes are not allowed if */
/* the allowed-numbers attribute has already been parsed. */
/*============================================================*/
if (((strcmp(constraintName,"allowed-integers") == 0) ||
(strcmp(constraintName,"allowed-floats") == 0)) &&
(parsedConstraints->allowedNumbers))
{
NoConjunctiveUseError(theEnv,constraintName,"allowed-number");
return(FALSE);
}
/*==================================================*/
/* The allowed-lexemes attribute is not allowed if */
/* the allowed-symbols or allowed-strings attribute */
/* has already been parsed. */
/*==================================================*/
if ((strcmp(constraintName,"allowed-lexemes") == 0) &&
((parsedConstraints->allowedSymbols) || (parsedConstraints->allowedStrings)))
{
if (parsedConstraints->allowedSymbols) tempPtr = "allowed-symbols";
else tempPtr = "allowed-strings";
NoConjunctiveUseError(theEnv,"allowed-lexemes",tempPtr);
return(FALSE);
}
/*===========================================================*/
/* The allowed-symbols/strings attributes are not allowed if */
/* the allowed-lexemes attribute has already been parsed. */
/*===========================================================*/
if (((strcmp(constraintName,"allowed-symbols") == 0) ||
(strcmp(constraintName,"allowed-strings") == 0)) &&
(parsedConstraints->allowedLexemes))
{
NoConjunctiveUseError(theEnv,constraintName,"allowed-lexemes");
return(FALSE);
}
/*========================*/
/* Get the expected type. */
/*========================*/
restrictionType = GetConstraintTypeFromAllowedName(constraintName);
SetRestrictionFlag(restrictionType,constraints,TRUE);
if (strcmp(constraintName,"allowed-classes") == 0)
{ expectedType = SYMBOL; }
else
{ expectedType = restrictionType; }
/*=================================================*/
/* Get the last value in the restriction list (the */
/* allowed values will be appended there). */
/*=================================================*/
if (strcmp(constraintName,"allowed-classes") == 0)
{ lastValue = constraints->classList; }
else
{ lastValue = constraints->restrictionList; }
if (lastValue != NULL)
{ while (lastValue->nextArg != NULL) lastValue = lastValue->nextArg; }
/*==================================================*/
/* Read the allowed values and add them to the list */
/* until a right parenthesis is encountered. */
/*==================================================*/
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,&inputToken);
while (inputToken.type != RPAREN)
{
SavePPBuffer(theEnv," ");
/*=============================================*/
/* Determine the type of the token just parsed */
/* and if it is an appropriate value. */
/*=============================================*/
switch(inputToken.type)
{
case INTEGER:
if ((expectedType != UNKNOWN_VALUE) &&
(expectedType != INTEGER) &&
(expectedType != INTEGER_OR_FLOAT)) error = TRUE;
constantParsed = TRUE;
break;
case FLOAT:
if ((expectedType != UNKNOWN_VALUE) &&
(expectedType != FLOAT) &&
(expectedType != INTEGER_OR_FLOAT)) error = TRUE;
constantParsed = TRUE;
break;
case STRING:
if ((expectedType != UNKNOWN_VALUE) &&
(expectedType != STRING) &&
(expectedType != SYMBOL_OR_STRING)) error = TRUE;
constantParsed = TRUE;
break;
case SYMBOL:
if ((expectedType != UNKNOWN_VALUE) &&
(expectedType != SYMBOL) &&
(expectedType != SYMBOL_OR_STRING)) error = TRUE;
constantParsed = TRUE;
break;
#if OBJECT_SYSTEM
case INSTANCE_NAME:
if ((expectedType != UNKNOWN_VALUE) &&
(expectedType != INSTANCE_NAME)) error = TRUE;
constantParsed = TRUE;
break;
#endif
case SF_VARIABLE:
if (strcmp(inputToken.printForm,"?VARIABLE") == 0)
{ variableParsed = TRUE; }
else
{
char tempBuffer[120];
gensprintf(tempBuffer,"%s attribute",constraintName);
SyntaxErrorMessage(theEnv,tempBuffer);
return(FALSE);
}
break;
default:
{
char tempBuffer[120];
gensprintf(tempBuffer,"%s attribute",constraintName);
SyntaxErrorMessage(theEnv,tempBuffer);
}
return(FALSE);
}
/*=====================================*/
/* Signal an error if an inappropriate */
/* value was found. */
/*=====================================*/
if (error)
{
PrintErrorID(theEnv,"CSTRNPSR",4,TRUE);
EnvPrintRouter(theEnv,WERROR,"Value does not match the expected type for the ");
EnvPrintRouter(theEnv,WERROR,constraintName);
EnvPrintRouter(theEnv,WERROR," attribute\n");
return(FALSE);
}
/*======================================*/
/* The ?VARIABLE argument can't be used */
/* in conjunction with constants. */
/*======================================*/
if (constantParsed && variableParsed)
{
char tempBuffer[120];
gensprintf(tempBuffer,"%s attribute",constraintName);
SyntaxErrorMessage(theEnv,tempBuffer);
return(FALSE);
}
/*===========================================*/
/* Add the constant to the restriction list. */
/*===========================================*/
newValue = GenConstant(theEnv,inputToken.type,inputToken.value);
if (lastValue == NULL)
{
if (strcmp(constraintName,"allowed-classes") == 0)
{ constraints->classList = newValue; }
else
{ constraints->restrictionList = newValue; }
}
else
{ lastValue->nextArg = newValue; }
lastValue = newValue;
/*=======================================*/
/* Begin parsing the next allowed value. */
/*=======================================*/
GetToken(theEnv,readSource,&inputToken);
}
/*======================================================*/
/* There must be at least one value for this attribute. */
/*======================================================*/
if ((! constantParsed) && (! variableParsed))
{
char tempBuffer[120];
gensprintf(tempBuffer,"%s attribute",constraintName);
SyntaxErrorMessage(theEnv,tempBuffer);
return(FALSE);
}
/*======================================*/
/* If ?VARIABLE was parsed, then remove */
/* the restrictions for the type being */
/* restricted. */
/*======================================*/
if (variableParsed)
{
switch(restrictionType)
{
case UNKNOWN_VALUE:
constraints->anyRestriction = FALSE;
break;
case SYMBOL:
constraints->symbolRestriction = FALSE;
break;
case STRING:
constraints->stringRestriction = FALSE;
break;
case INTEGER:
constraints->integerRestriction = FALSE;
break;
case FLOAT:
constraints->floatRestriction = FALSE;
break;
case INTEGER_OR_FLOAT:
constraints->floatRestriction = FALSE;
constraints->integerRestriction = FALSE;
break;
case SYMBOL_OR_STRING:
constraints->symbolRestriction = FALSE;
constraints->stringRestriction = FALSE;
break;
case INSTANCE_NAME:
constraints->instanceNameRestriction = FALSE;
break;
case INSTANCE_OR_INSTANCE_NAME:
constraints->classRestriction = FALSE;
break;
}
}
/*=====================================*/
/* Fix up pretty print representation. */
/*=====================================*/
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
/*=======================================*/
/* Return TRUE to indicate the attribute */
/* was successfully parsed. */
/*=======================================*/
return(TRUE);
}
static intBool ParseRangeCardinalityAttribute(
void *theEnv,
char *readSource,
CONSTRAINT_RECORD *constraints,
CONSTRAINT_PARSE_RECORD *parsedConstraints,
char *constraintName,
int multipleValuesAllowed)
{
struct token inputToken;
int range;
char *tempPtr = NULL;
/*=================================*/
/* Determine if we're parsing the */
/* range or cardinality attribute. */
/*=================================*/
if (strcmp(constraintName,"range") == 0)
{
parsedConstraints->range = TRUE;
range = TRUE;
}
else
{
parsedConstraints->cardinality = TRUE;
range = FALSE;
}
/*===================================================================*/
/* The cardinality attribute can only be used with multifield slots. */
/*===================================================================*/
if ((range == FALSE) &&
(multipleValuesAllowed == FALSE))
{
PrintErrorID(theEnv,"CSTRNPSR",5,TRUE);
EnvPrintRouter(theEnv,WERROR,"The cardinality attribute ");
EnvPrintRouter(theEnv,WERROR,"can only be used with multifield slots.\n");
return(FALSE);
}
/*====================================================*/
/* The range attribute is not allowed with the */
/* allowed-values/numbers/integers/floats attributes. */
/*====================================================*/
if ((range == TRUE) &&
(parsedConstraints->allowedValues ||
parsedConstraints->allowedNumbers ||
parsedConstraints->allowedIntegers ||
parsedConstraints->allowedFloats))
{
if (parsedConstraints->allowedValues) tempPtr = "allowed-values";
else if (parsedConstraints->allowedIntegers) tempPtr = "allowed-integers";
else if (parsedConstraints->allowedFloats) tempPtr = "allowed-floats";
else if (parsedConstraints->allowedNumbers) tempPtr = "allowed-numbers";
NoConjunctiveUseError(theEnv,"range",tempPtr);
return(FALSE);
}
/*==========================*/
/* Parse the minimum value. */
/*==========================*/
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,&inputToken);
if ((inputToken.type == INTEGER) || ((inputToken.type == FLOAT) && range))
{
if (range)
{
ReturnExpression(theEnv,constraints->minValue);
constraints->minValue = GenConstant(theEnv,inputToken.type,inputToken.value);
}
else
{
ReturnExpression(theEnv,constraints->minFields);
constraints->minFields = GenConstant(theEnv,inputToken.type,inputToken.value);
}
}
else if ((inputToken.type == SF_VARIABLE) && (strcmp(inputToken.printForm,"?VARIABLE") == 0))
{ /* Do nothing. */ }
else
{
char tempBuffer[120];
gensprintf(tempBuffer,"%s attribute",constraintName);
SyntaxErrorMessage(theEnv,tempBuffer);
return(FALSE);
}
/*==========================*/
/* Parse the maximum value. */
/*==========================*/
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,&inputToken);
if ((inputToken.type == INTEGER) || ((inputToken.type == FLOAT) && range))
{
if (range)
{
ReturnExpression(theEnv,constraints->maxValue);
constraints->maxValue = GenConstant(theEnv,inputToken.type,inputToken.value);
}
else
{
ReturnExpression(theEnv,constraints->maxFields);
constraints->maxFields = GenConstant(theEnv,inputToken.type,inputToken.value);
}
}
else if ((inputToken.type == SF_VARIABLE) && (strcmp(inputToken.printForm,"?VARIABLE") == 0))
{ /* Do nothing. */ }
else
{
char tempBuffer[120];
gensprintf(tempBuffer,"%s attribute",constraintName);
SyntaxErrorMessage(theEnv,tempBuffer);
return(FALSE);
}
/*================================*/
/* Parse the closing parenthesis. */
/*================================*/
GetToken(theEnv,readSource,&inputToken);
if (inputToken.type != RPAREN)
{
SyntaxErrorMessage(theEnv,"range attribute");
return(FALSE);
}
/*====================================================*/
/* Minimum value must be less than the maximum value. */
/*====================================================*/
if (range)
{
if (CompareNumbers(theEnv,constraints->minValue->type,
constraints->minValue->value,
constraints->maxValue->type,
constraints->maxValue->value) == GREATER_THAN)
{
PrintErrorID(theEnv,"CSTRNPSR",2,TRUE);
EnvPrintRouter(theEnv,WERROR,"Minimum range value must be less than\n");
EnvPrintRouter(theEnv,WERROR,"or equal to the maximum range value\n");
return(FALSE);
}
}
else
{
if (CompareNumbers(theEnv,constraints->minFields->type,
constraints->minFields->value,
constraints->maxFields->type,
constraints->maxFields->value) == GREATER_THAN)
{
PrintErrorID(theEnv,"CSTRNPSR",2,TRUE);
EnvPrintRouter(theEnv,WERROR,"Minimum cardinality value must be less than\n");
EnvPrintRouter(theEnv,WERROR,"or equal to the maximum cardinality value\n");
return(FALSE);
}
}
/*====================================*/
/* Return TRUE to indicate that the */
/* attribute was successfully parsed. */
/*====================================*/
return(TRUE);
}
globle const char *DataObjectToString(
void *theEnv,
DATA_OBJECT *theDO)
{
void *thePtr;
const char *theString;
char *newString;
const char *prefix, *postfix;
size_t length;
struct externalAddressHashNode *theAddress;
char buffer[30];
switch (GetpType(theDO))
{
case MULTIFIELD:
prefix = "(";
theString = ValueToString(ImplodeMultifield(theEnv,theDO));
postfix = ")";
break;
case STRING:
prefix = "\"";
theString = DOPToString(theDO);
postfix = "\"";
break;
case INSTANCE_NAME:
prefix = "[";
theString = DOPToString(theDO);
postfix = "]";
break;
case SYMBOL:
return(DOPToString(theDO));
case FLOAT:
return(FloatToString(theEnv,DOPToDouble(theDO)));
case INTEGER:
return(LongIntegerToString(theEnv,DOPToLong(theDO)));
case RVOID:
return("");
#if OBJECT_SYSTEM
case INSTANCE_ADDRESS:
thePtr = DOPToPointer(theDO);
if (thePtr == (void *) &InstanceData(theEnv)->DummyInstance)
{ return("<Dummy Instance>"); }
if (((struct instance *) thePtr)->garbage)
{
prefix = "<Stale Instance-";
theString = ValueToString(((struct instance *) thePtr)->name);
postfix = ">";
}
else
{
prefix = "<Instance-";
theString = ValueToString(GetFullInstanceName(theEnv,(INSTANCE_TYPE *) thePtr));
postfix = ">";
}
break;
#endif
case EXTERNAL_ADDRESS:
theAddress = (struct externalAddressHashNode *) DOPToPointer(theDO);
/* TBD Need specific routine for creating name string. */
gensprintf(buffer,"<Pointer-%d-%p>",(int) theAddress->type,DOPToExternalAddress(theDO));
thePtr = EnvAddSymbol(theEnv,buffer);
return(ValueToString(thePtr));
#if DEFTEMPLATE_CONSTRUCT
case FACT_ADDRESS:
if (DOPToPointer(theDO) == (void *) &FactData(theEnv)->DummyFact)
{ return("<Dummy Fact>"); }
thePtr = DOPToPointer(theDO);
gensprintf(buffer,"<Fact-%lld>",((struct fact *) thePtr)->factIndex);
thePtr = EnvAddSymbol(theEnv,buffer);
return(ValueToString(thePtr));
#endif
default:
return("UNK");
}
length = strlen(prefix) + strlen(theString) + strlen(postfix) + 1;
newString = (char *) genalloc(theEnv,length);
newString[0] = '\0';
genstrcat(newString,prefix);
genstrcat(newString,theString);
genstrcat(newString,postfix);
thePtr = EnvAddSymbol(theEnv,newString);
genfree(theEnv,newString,length);
return(ValueToString(thePtr));
}
globle void PrintAtom(
void *theEnv,
const char *logicalName,
int type,
void *value)
{
struct externalAddressHashNode *theAddress;
char buffer[20];
switch (type)
{
case FLOAT:
PrintFloat(theEnv,logicalName,ValueToDouble(value));
break;
case INTEGER:
PrintLongInteger(theEnv,logicalName,ValueToLong(value));
break;
case SYMBOL:
EnvPrintRouter(theEnv,logicalName,ValueToString(value));
break;
case STRING:
if (PrintUtilityData(theEnv)->PreserveEscapedCharacters)
{ EnvPrintRouter(theEnv,logicalName,StringPrintForm(theEnv,ValueToString(value))); }
else
{
EnvPrintRouter(theEnv,logicalName,"\"");
EnvPrintRouter(theEnv,logicalName,ValueToString(value));
EnvPrintRouter(theEnv,logicalName,"\"");
}
break;
case DATA_OBJECT_ARRAY:
if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\"");
EnvPrintRouter(theEnv,logicalName,"<Pointer-");
gensprintf(buffer,"%p",value);
EnvPrintRouter(theEnv,logicalName,buffer);
EnvPrintRouter(theEnv,logicalName,">");
if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\"");
break;
case EXTERNAL_ADDRESS:
theAddress = (struct externalAddressHashNode *) value;
if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\"");
if ((EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type] != NULL) &&
(EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type]->longPrintFunction != NULL))
{ (*EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type]->longPrintFunction)(theEnv,logicalName,value); }
else
{
EnvPrintRouter(theEnv,logicalName,"<Pointer-");
gensprintf(buffer,"%d-",theAddress->type);
EnvPrintRouter(theEnv,logicalName,buffer);
gensprintf(buffer,"%p",ValueToExternalAddress(value));
EnvPrintRouter(theEnv,logicalName,buffer);
EnvPrintRouter(theEnv,logicalName,">");
}
if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\"");
break;
#if OBJECT_SYSTEM
case INSTANCE_NAME:
EnvPrintRouter(theEnv,logicalName,"[");
EnvPrintRouter(theEnv,logicalName,ValueToString(value));
EnvPrintRouter(theEnv,logicalName,"]");
break;
#endif
case RVOID:
break;
default:
if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break;
if (EvaluationData(theEnv)->PrimitivesArray[type]->longPrintFunction == NULL)
{
EnvPrintRouter(theEnv,logicalName,"<unknown atom type>");
break;
}
(*EvaluationData(theEnv)->PrimitivesArray[type]->longPrintFunction)(theEnv,logicalName,value);
break;
}
}
