globle void PrintFactPNConstant2(
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factConstantPN2Call *hack;
hack = (struct factConstantPN2Call *) ValueToBitMap(theValue);
PrintRouter(logicalName,"(fact-pn-constant2 ");
PrintLongInteger(logicalName,(long) hack->whichSlot);
PrintRouter(logicalName," ");
PrintLongInteger(logicalName,(long) hack->offset);
if (hack->testForEquality) PrintRouter(logicalName," = ");
else PrintRouter(logicalName," != ");
PrintAtom(logicalName,GetFirstArgument()->type,GetFirstArgument()->value);
PrintRouter(logicalName,")");
#else
#if MAC_MPW || MAC_MCW
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
globle void PrintFactPNConstant2(
void *theEnv,
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factConstantPN2Call *hack;
hack = (struct factConstantPN2Call *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,(char*)"(fact-pn-constant2 ");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot);
EnvPrintRouter(theEnv,logicalName,(char*)" ");
PrintLongInteger(theEnv,logicalName,(long long) hack->offset);
if (hack->testForEquality) EnvPrintRouter(theEnv,logicalName,(char*)" = ");
else EnvPrintRouter(theEnv,logicalName,(char*)" != ");
PrintAtom(theEnv,logicalName,GetFirstArgument()->type,GetFirstArgument()->value);
EnvPrintRouter(theEnv,logicalName,(char*)")");
#else
#endif
}
globle void PrintFactPNConstant1(
void *theEnv,
const char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factConstantPN1Call *hack;
hack = (struct factConstantPN1Call *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(fact-pn-constant1 ");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot);
if (hack->testForEquality) EnvPrintRouter(theEnv,logicalName," = ");
else EnvPrintRouter(theEnv,logicalName," != ");
PrintAtom(theEnv,logicalName,GetFirstArgument()->type,GetFirstArgument()->value);
EnvPrintRouter(theEnv,logicalName,")");
#else
#if MAC_XCD
#pragma unused(theEnv)
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
globle void PrintDataObject(
char *fileid,
DATA_OBJECT_PTR argPtr)
{
switch(argPtr->type)
{
case RVOID:
case SYMBOL:
case STRING:
case INTEGER:
case FLOAT:
case EXTERNAL_ADDRESS:
case FACT_ADDRESS:
#if OBJECT_SYSTEM
case INSTANCE_NAME:
case INSTANCE_ADDRESS:
#endif
#if FUZZY_DEFTEMPLATES
case FUZZY_VALUE:
#endif
PrintAtom(fileid,argPtr->type,argPtr->value);
break;
case MULTIFIELD:
PrintMultifield(fileid,(struct multifield *) argPtr->value,
argPtr->begin,argPtr->end,TRUE);
break;
default:
if (PrimitivesArray[argPtr->type] != NULL)
{
if (PrimitivesArray[argPtr->type]->longPrintFunction)
{
(*PrimitivesArray[argPtr->type]->longPrintFunction)(fileid,argPtr->value);
break;
}
else if (PrimitivesArray[argPtr->type]->shortPrintFunction)
{
(*PrimitivesArray[argPtr->type]->shortPrintFunction)(fileid,argPtr->value);
break;
}
}
PrintRouter(fileid,"<UnknownPrintType");
PrintLongInteger(fileid,(long int) argPtr->type);
PrintRouter(fileid,">");
SetHaltExecution(TRUE);
SetEvaluationError(TRUE);
break;
}
}
globle void PrintDataObject(
void *theEnv,
const char *fileid,
DATA_OBJECT_PTR argPtr)
{
switch(argPtr->type)
{
case RVOID:
case SYMBOL:
case STRING:
case INTEGER:
case FLOAT:
case EXTERNAL_ADDRESS:
case DATA_OBJECT_ARRAY: // TBD Remove with AddPrimitive
case FACT_ADDRESS:
#if OBJECT_SYSTEM
case INSTANCE_NAME:
case INSTANCE_ADDRESS:
#endif
PrintAtom(theEnv,fileid,argPtr->type,argPtr->value);
break;
case MULTIFIELD:
PrintMultifield(theEnv,fileid,(struct multifield *) argPtr->value,
argPtr->begin,argPtr->end,TRUE);
break;
default:
if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type] != NULL)
{
if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->longPrintFunction)
{
(*EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->longPrintFunction)(theEnv,fileid,argPtr->value);
break;
}
else if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->shortPrintFunction)
{
(*EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->shortPrintFunction)(theEnv,fileid,argPtr->value);
break;
}
}
EnvPrintRouter(theEnv,fileid,"<UnknownPrintType");
PrintLongInteger(theEnv,fileid,(long int) argPtr->type);
EnvPrintRouter(theEnv,fileid,">");
SetHaltExecution(theEnv,TRUE);
SetEvaluationError(theEnv,TRUE);
break;
}
}
globle void PrintExpression(
char *fileid,
struct expr *theExpression)
{
struct expr *oldExpression;
if (theExpression == NULL)
{ return; }
while (theExpression != NULL)
{
switch (theExpression->type)
{
case SF_VARIABLE:
case GBL_VARIABLE:
PrintRouter(fileid,"?");
PrintRouter(fileid,ValueToString(theExpression->value));
break;
case MF_VARIABLE:
case MF_GBL_VARIABLE:
PrintRouter(fileid,"$?");
PrintRouter(fileid,ValueToString(theExpression->value));
break;
case FCALL:
PrintRouter(fileid,"(");
PrintRouter(fileid,ValueToString(ExpressionFunctionCallName(theExpression)));
if (theExpression->argList != NULL) { PrintRouter(fileid," "); }
PrintExpression(fileid,theExpression->argList);
PrintRouter(fileid,")");
break;
default:
oldExpression = CurrentExpression;
CurrentExpression = theExpression;
PrintAtom(fileid,theExpression->type,theExpression->value);
CurrentExpression = oldExpression;
break;
}
theExpression = theExpression->nextArg;
if (theExpression != NULL) PrintRouter(fileid," ");
}
return;
}
static void PrintTemplateSlot(
void *theEnv,
const char *logicalName,
struct templateSlot *slotPtr,
struct field *slotValue)
{
EnvPrintRouter(theEnv,logicalName,"(");
EnvPrintRouter(theEnv,logicalName,slotPtr->slotName->contents);
/*======================================================*/
/* Print the value of the slot for a single field slot. */
/*======================================================*/
if (slotPtr->multislot == false)
{
EnvPrintRouter(theEnv,logicalName," ");
PrintAtom(theEnv,logicalName,slotValue->type,slotValue->value);
}
/*==========================================================*/
/* Else print the value of the slot for a multi field slot. */
/*==========================================================*/
else
{
struct multifield *theSegment;
theSegment = (struct multifield *) slotValue->value;
if (theSegment->multifieldLength > 0)
{
EnvPrintRouter(theEnv,logicalName," ");
PrintMultifield(theEnv,logicalName,theSegment,
0,(long) theSegment->multifieldLength-1,false);
}
}
/*============================================*/
/* Print the closing parenthesis of the slot. */
/*============================================*/
EnvPrintRouter(theEnv,logicalName,")");
}
static void PrintTemplateSlot(
Environment *theEnv,
const char *logicalName,
struct templateSlot *slotPtr,
CLIPSValue *slotValue)
{
WriteString(theEnv,logicalName,"(");
WriteString(theEnv,logicalName,slotPtr->slotName->contents);
/*======================================================*/
/* Print the value of the slot for a single field slot. */
/*======================================================*/
if (slotPtr->multislot == false)
{
WriteString(theEnv,logicalName," ");
PrintAtom(theEnv,logicalName,((TypeHeader *) slotValue->value)->type,slotValue->value);
}
/*==========================================================*/
/* Else print the value of the slot for a multi field slot. */
/*==========================================================*/
else
{
struct multifield *theSegment;
theSegment = (Multifield *) slotValue->value;
if (theSegment->length > 0)
{
WriteString(theEnv,logicalName," ");
PrintMultifieldDriver(theEnv,logicalName,theSegment,0,theSegment->length,false);
}
}
/*============================================*/
/* Print the closing parenthesis of the slot. */
/*============================================*/
WriteString(theEnv,logicalName,")");
}
globle void PrintMultifield(
char *fileid,
struct multifield *segment,
long begin,
long end,
int printParens)
{
struct field *theMultifield;
int i;
theMultifield = segment->theFields;
if (printParens)
PrintRouter(fileid,"(");
i = begin;
while (i <= end)
{
PrintAtom(fileid,theMultifield[i].type,theMultifield[i].value);
i++;
if (i <= end) PrintRouter(fileid," ");
}
if (printParens)
PrintRouter(fileid,")");
}
bool RouteCommand(
void *theEnv,
const char *command,
bool printResult)
{
DATA_OBJECT result;
struct expr *top;
const char *commandName;
struct token theToken;
int danglingConstructs;
if (command == NULL)
{ return(0); }
/*========================================*/
/* Open a string input source and get the */
/* first token from that source. */
/*========================================*/
OpenStringSource(theEnv,"command",command,0);
GetToken(theEnv,"command",&theToken);
/*=====================*/
/* Evaluate constants. */
/*=====================*/
if ((theToken.type == SYMBOL) || (theToken.type == STRING) ||
(theToken.type == FLOAT) || (theToken.type == INTEGER) ||
(theToken.type == INSTANCE_NAME))
{
CloseStringSource(theEnv,"command");
if (printResult)
{
PrintAtom(theEnv,STDOUT,theToken.type,theToken.value);
EnvPrintRouter(theEnv,STDOUT,"\n");
}
return(1);
}
/*=====================*/
/* Evaluate variables. */
/*=====================*/
if ((theToken.type == GBL_VARIABLE) ||
(theToken.type == SF_VARIABLE) ||
(theToken.type == MF_VARIABLE))
{
CloseStringSource(theEnv,"command");
top = GenConstant(theEnv,theToken.type,theToken.value);
EvaluateExpression(theEnv,top,&result);
rtn_struct(theEnv,expr,top);
if (printResult)
{
PrintDataObject(theEnv,STDOUT,&result);
EnvPrintRouter(theEnv,STDOUT,"\n");
}
return(1);
}
/*========================================================*/
/* If the next token isn't the beginning left parenthesis */
/* of a command or construct, then whatever was entered */
/* cannot be evaluated at the command prompt. */
/*========================================================*/
if (theToken.type != LPAREN)
{
PrintErrorID(theEnv,"COMMLINE",1,false);
EnvPrintRouter(theEnv,WERROR,"Expected a '(', constant, or variable\n");
CloseStringSource(theEnv,"command");
return(0);
}
/*===========================================================*/
/* The next token must be a function name or construct type. */
/*===========================================================*/
GetToken(theEnv,"command",&theToken);
if (theToken.type != SYMBOL)
{
PrintErrorID(theEnv,"COMMLINE",2,false);
EnvPrintRouter(theEnv,WERROR,"Expected a command.\n");
CloseStringSource(theEnv,"command");
return(0);
}
commandName = ValueToString(theToken.value);
/*======================*/
/* Evaluate constructs. */
/*======================*/
#if (! RUN_TIME) && (! BLOAD_ONLY)
{
int errorFlag;
errorFlag = ParseConstruct(theEnv,commandName,"command");
if (errorFlag != -1)
{
CloseStringSource(theEnv,"command");
if (errorFlag == 1)
{
EnvPrintRouter(theEnv,WERROR,"\nERROR:\n");
PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv));
EnvPrintRouter(theEnv,WERROR,"\n");
}
DestroyPPBuffer(theEnv);
if (errorFlag) return 0;
else return 1;
}
}
#endif
/*========================*/
/* Parse a function call. */
/*========================*/
danglingConstructs = ConstructData(theEnv)->DanglingConstructs;
CommandLineData(theEnv)->ParsingTopLevelCommand = true;
top = Function2Parse(theEnv,"command",commandName);
CommandLineData(theEnv)->ParsingTopLevelCommand = false;
ClearParsedBindNames(theEnv);
/*================================*/
/* Close the string input source. */
/*================================*/
CloseStringSource(theEnv,"command");
/*=========================*/
/* Evaluate function call. */
/*=========================*/
if (top == NULL)
{
ConstructData(theEnv)->DanglingConstructs = danglingConstructs;
return false;
}
ExpressionInstall(theEnv,top);
CommandLineData(theEnv)->EvaluatingTopLevelCommand = true;
CommandLineData(theEnv)->CurrentCommand = top;
EvaluateExpression(theEnv,top,&result);
CommandLineData(theEnv)->CurrentCommand = NULL;
CommandLineData(theEnv)->EvaluatingTopLevelCommand = false;
ExpressionDeinstall(theEnv,top);
ReturnExpression(theEnv,top);
ConstructData(theEnv)->DanglingConstructs = danglingConstructs;
/*=================================================*/
/* Print the return value of the function/command. */
/*=================================================*/
if ((result.type != RVOID) && printResult)
{
PrintDataObject(theEnv,STDOUT,&result);
EnvPrintRouter(theEnv,STDOUT,"\n");
}
return true;
}
globle void PrintTemplateFact(
char *logicalName,
struct fact *theFact)
{
struct field *sublist;
int i;
struct deftemplate *theDeftemplate;
struct templateSlot *slotPtr;
/*==============================*/
/* Initialize some information. */
/*==============================*/
theDeftemplate = theFact->whichDeftemplate;
sublist = theFact->theProposition.theFields;
/*=============================================*/
/* Print the relation name of the deftemplate. */
/*=============================================*/
PrintRouter(logicalName,"(");
PrintRouter(logicalName,theDeftemplate->header.name->contents);
#if FUZZY_DEFTEMPLATES
if (theDeftemplate->fuzzyTemplate != NULL) /* fuzzy template */
{
PrintFuzzyTemplateFact(logicalName,
(struct fuzzy_value *)ValueToFuzzyValue((sublist[0].value))
#if CERTAINTY_FACTORS
,theFact->factCF
#endif
);
return;
}
#endif
if (theDeftemplate->slotList != NULL) PrintRouter(logicalName," ");
/*===================================================*/
/* Print each of the field slots of the deftemplate. */
/*===================================================*/
slotPtr = theDeftemplate->slotList;
i = 0;
while (slotPtr != NULL)
{
/*===========================================*/
/* Print the closing parenthesis of the slot */
/* and the slot name. */
/*===========================================*/
PrintRouter(logicalName,"(");
PrintRouter(logicalName,slotPtr->slotName->contents);
/*======================================================*/
/* Print the value of the slot for a single field slot. */
/*======================================================*/
if (slotPtr->multislot == FALSE)
{
PrintRouter(logicalName," ");
#if FUZZY_DEFTEMPLATES
/* for a fuzzy value printed during a fact save
we need to look for the 'xxx' linguistic value --
if it is xxx then print the set as singletons
*/
if (saveFactsInProgress &&
sublist[i].type == FUZZY_VALUE
)
{ struct fuzzy_value *fv;
fv = ValueToFuzzyValue(sublist[i].value);
if (strcmp("???", fv->name) == 0)
PrintFuzzySet(logicalName, fv);
else
PrintRouter(logicalName, fv->name);
}
else
#endif
PrintAtom(logicalName,sublist[i].type,sublist[i].value);
}
/*==========================================================*/
/* Else print the value of the slot for a multi field slot. */
/*==========================================================*/
else
{
struct multifield *theSegment;
theSegment = (struct multifield *) sublist[i].value;
if (theSegment->multifieldLength > 0)
{
PrintRouter(logicalName," ");
PrintMultifield(logicalName,(struct multifield *) sublist[i].value,
0,theSegment->multifieldLength-1,FALSE);
}
}
/*============================================*/
/* Print the closing parenthesis of the slot. */
/*============================================*/
i++;
PrintRouter(logicalName,")");
slotPtr = slotPtr->next;
if (slotPtr != NULL) PrintRouter(logicalName," ");
}
PrintRouter(logicalName,")");
#if CERTAINTY_FACTORS
printCF(logicalName,theFact->factCF);
#endif
#if FUZZY_DEFTEMPLATES
/* There may be some fuzzy value slots in the fact -- if so just
print out the fuzzy sets for them on next lines
... UNLESS we are doing a fact save operation!
*/
if (!saveFactsInProgress)
for (i=0; i<(unsigned int)theDeftemplate->numberOfSlots; i++)
{
if (sublist[i].type == FUZZY_VALUE)
{
PrintRouter(logicalName,"\n\t( ");
PrintFuzzySet(logicalName, ValueToFuzzyValue(sublist[i].value));
PrintRouter(logicalName," )");
}
}
#endif
}
