void CommandLoop( void *theEnv) { int inchar; EnvPrintRouter(theEnv,WPROMPT,CommandLineData(theEnv)->BannerString); EnvSetHaltExecution(theEnv,false); EnvSetEvaluationError(theEnv,false); CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); PrintPrompt(theEnv); RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = true; while (true) { /*===================================================*/ /* If a batch file is active, grab the command input */ /* directly from the batch file, otherwise call the */ /* event function. */ /*===================================================*/ if (BatchActive(theEnv) == true) { inchar = LLGetcBatch(theEnv,STDIN,true); if (inchar == EOF) { (*CommandLineData(theEnv)->EventFunction)(theEnv); } else { ExpandCommandString(theEnv,(char) inchar); } } else { (*CommandLineData(theEnv)->EventFunction)(theEnv); } /*=================================================*/ /* If execution was halted, then remove everything */ /* from the command buffer. */ /*=================================================*/ if (EnvGetHaltExecution(theEnv) == true) { EnvSetHaltExecution(theEnv,false); EnvSetEvaluationError(theEnv,false); FlushCommandString(theEnv); #if ! WINDOW_INTERFACE fflush(stdin); #endif EnvPrintRouter(theEnv,WPROMPT,"\n"); PrintPrompt(theEnv); } /*=========================================*/ /* If a complete command is in the command */ /* buffer, then execute it. */ /*=========================================*/ ExecuteIfCommandComplete(theEnv); } }
/******************************************************************************* NAME : PPDefmessageHandlerCommand DESCRIPTION : Displays the pretty-print form (if any) for a handler INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : None NOTES : H/L Syntax: (ppdefmessage-handler <class> <message> [<type>]) *******************************************************************************/ globle void PPDefmessageHandlerCommand( void *theEnv) { DATA_OBJECT temp; SYMBOL_HN *csym,*msym; const char *tname; DEFCLASS *cls = NULL; unsigned mtype; HANDLER *hnd; if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",1,SYMBOL,&temp) == FALSE) return; csym = FindSymbolHN(theEnv,DOToString(temp)); if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",2,SYMBOL,&temp) == FALSE) return; msym = FindSymbolHN(theEnv,DOToString(temp)); if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",3,SYMBOL,&temp) == FALSE) return; tname = DOToString(temp); } else tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY]; mtype = HandlerType(theEnv,"ppdefmessage-handler",tname); if (mtype == MERROR) { EnvSetEvaluationError(theEnv,TRUE); return; } if (csym != NULL) cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(csym)); if (((cls == NULL) || (msym == NULL)) ? TRUE : ((hnd = FindHandlerByAddress(cls,msym,(unsigned) mtype)) == NULL)) { PrintErrorID(theEnv,"MSGCOM",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Unable to find message-handler "); EnvPrintRouter(theEnv,WERROR,ValueToString(msym)); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,tname); EnvPrintRouter(theEnv,WERROR," for class "); EnvPrintRouter(theEnv,WERROR,ValueToString(csym)); EnvPrintRouter(theEnv,WERROR," in function ppdefmessage-handler.\n"); EnvSetEvaluationError(theEnv,TRUE); return; } if (hnd->ppForm != NULL) PrintInChunks(theEnv,WDISPLAY,hnd->ppForm); }
static struct expr *StandardLoadFact( void *theEnv, const char *logicalName, struct token *theToken) { int error = FALSE; struct expr *temp; GetToken(theEnv,logicalName,theToken); if (theToken->type != LPAREN) return(NULL); temp = GenConstant(theEnv,FCALL,FindFunction(theEnv,"assert")); temp->argList = GetRHSPattern(theEnv,logicalName,theToken,&error, TRUE,FALSE,TRUE,RPAREN); if (error == TRUE) { EnvPrintRouter(theEnv,WERROR,"Function load-facts encountered an error\n"); EnvSetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,temp); return(NULL); } if (ExpressionContainsVariables(temp,TRUE)) { ReturnExpression(theEnv,temp); return(NULL); } return(temp); }
/************************************************************************************ NAME : MessageHandlerExistPCommand DESCRIPTION : Determines if a message-handler is present in a class INPUTS : None RETURNS : TRUE if the message header is present, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (message-handler-existp <class> <hnd> [<type>]) ************************************************************************************/ globle int MessageHandlerExistPCommand( void *theEnv) { DEFCLASS *cls; SYMBOL_HN *mname; DATA_OBJECT temp; unsigned mtype = MPRIMARY; if (EnvArgTypeCheck(theEnv,"message-handler-existp",1,SYMBOL,&temp) == FALSE) return(FALSE); cls = LookupDefclassByMdlOrScope(theEnv,DOToString(temp)); if (cls == NULL) { ClassExistError(theEnv,"message-handler-existp",DOToString(temp)); return(FALSE); } if (EnvArgTypeCheck(theEnv,"message-handler-existp",2,SYMBOL,&temp) == FALSE) return(FALSE); mname = (SYMBOL_HN *) GetValue(temp); if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"message-handler-existp",3,SYMBOL,&temp) == FALSE) return(FALSE); mtype = HandlerType(theEnv,"message-handler-existp",DOToString(temp)); if (mtype == MERROR) { EnvSetEvaluationError(theEnv,TRUE); return(FALSE); } } if (FindHandlerByAddress(cls,mname,mtype) != NULL) return(TRUE); return(FALSE); }
/********************************************************************* NAME : SlotExistPCommand DESCRIPTION : Determines if a slot is present in a class INPUTS : None RETURNS : TRUE if the slot exists, FALSE otherwise SIDE EFFECTS : None NOTES : H/L Syntax : (slot-existp <class> <slot> [inherit]) *********************************************************************/ globle int SlotExistPCommand( void *theEnv) { DEFCLASS *cls; SLOT_DESC *sd; int inheritFlag = FALSE; DATA_OBJECT dobj; sd = CheckSlotExists(theEnv,"slot-existp",&cls,FALSE,TRUE); if (sd == NULL) return(FALSE); if (EnvRtnArgCount(theEnv) == 3) { if (EnvArgTypeCheck(theEnv,"slot-existp",3,SYMBOL,&dobj) == FALSE) return(FALSE); if (strcmp(DOToString(dobj),"inherit") != 0) { ExpectedTypeError1(theEnv,"slot-existp",3,"keyword \"inherit\""); EnvSetEvaluationError(theEnv,TRUE); return(FALSE); } inheritFlag = TRUE; } return((sd->cls == cls) ? TRUE : inheritFlag); }
bool ExecuteIfCommandComplete( void *theEnv) { if ((CompleteCommand(CommandLineData(theEnv)->CommandString) == 0) || (RouterData(theEnv)->CommandBufferInputCount == 0) || (RouterData(theEnv)->AwaitingInput == false)) { return false; } if (CommandLineData(theEnv)->BeforeCommandExecutionFunction != NULL) { if (! (*CommandLineData(theEnv)->BeforeCommandExecutionFunction)(theEnv)) { return false; } } FlushPPBuffer(theEnv); SetPPBufferStatus(theEnv,false); RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = false; RouteCommand(theEnv,CommandLineData(theEnv)->CommandString,true); FlushPPBuffer(theEnv); FlushParsingMessages(theEnv); EnvSetHaltExecution(theEnv,false); EnvSetEvaluationError(theEnv,false); FlushCommandString(theEnv); CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); PrintPrompt(theEnv); return true; }
/*************************************************** NAME : DetermineRestrictionClass DESCRIPTION : Finds the class of an argument in the ProcParamArray INPUTS : The argument data object RETURNS : The class address, NULL if error SIDE EFFECTS : EvaluationError set on errors NOTES : None ***************************************************/ static DEFCLASS *DetermineRestrictionClass( void *theEnv, DATA_OBJECT *dobj) { INSTANCE_TYPE *ins; DEFCLASS *cls; if (dobj->type == INSTANCE_NAME) { ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) dobj->value); cls = (ins != NULL) ? ins->cls : NULL; } else if (dobj->type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) dobj->value; cls = (ins->garbage == 0) ? ins->cls : NULL; } else return(DefclassData(theEnv)->PrimitiveClassMap[dobj->type]); if (cls == NULL) { EnvSetEvaluationError(theEnv,true); PrintErrorID(theEnv,"GENRCEXE",3,false); EnvPrintRouter(theEnv,WERROR,"Unable to determine class of "); PrintDataObject(theEnv,WERROR,dobj); EnvPrintRouter(theEnv,WERROR," in generic function "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric)); EnvPrintRouter(theEnv,WERROR,".\n"); } return(cls); }
/*************************************************************************** NAME : GetQueryInstanceSlot DESCRIPTION : Internal function for referring to slots of instances in instance array on instance-queries INPUTS : The caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's result buffer set appropriately NOTES : H/L Syntax : ((query-instance-slot) <index> <slot-name>) **************************************************************************/ globle void GetQueryInstanceSlot( void *theEnv, DATA_OBJECT *result) { INSTANCE_TYPE *ins; INSTANCE_SLOT *sp; DATA_OBJECT temp; QUERY_CORE *core; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument()))); ins = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))]; EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,"get",1,"symbol"); EnvSetEvaluationError(theEnv,TRUE); return; } sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(theEnv,ValueToString(temp.value),"instance-set query"); return; } result->type = (unsigned short) sp->type; result->value = sp->value; if (sp->type == MULTIFIELD) { result->begin = 0; SetpDOEnd(result,GetInstanceSlotLength(sp)); } }
void UDFThrowError( UDFContext *context) { Environment *theEnv = UDFContextEnvironment(context); EnvSetHaltExecution(theEnv,true); EnvSetEvaluationError(theEnv,true); }
globle int SetIncrementalResetCommand( void *theEnv) { int oldValue; DATA_OBJECT argPtr; struct defmodule *theModule; oldValue = EnvGetIncrementalReset(theEnv); /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (EnvArgCountCheck(theEnv,"set-incremental-reset",EXACTLY,1) == -1) { return(oldValue); } /*=========================================*/ /* The incremental reset behavior can't be */ /* changed when rules are loaded. */ /*=========================================*/ SaveCurrentModule(theEnv); for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); if (EnvGetNextDefrule(theEnv,NULL) != NULL) { RestoreCurrentModule(theEnv); PrintErrorID(theEnv,"INCRRSET",1,FALSE); EnvPrintRouter(theEnv,WERROR,"The incremental reset behavior cannot be changed with rules loaded.\n"); EnvSetEvaluationError(theEnv,TRUE); return(oldValue); } } RestoreCurrentModule(theEnv); /*==================================================*/ /* The symbol FALSE disables incremental reset. Any */ /* other value enables incremental reset. */ /*==================================================*/ EnvRtnUnknown(theEnv,1,&argPtr); if ((argPtr.value == EnvFalseSymbol(theEnv)) && (argPtr.type == SYMBOL)) { EnvSetIncrementalReset(theEnv,FALSE); } else { EnvSetIncrementalReset(theEnv,TRUE); } /*=======================*/ /* Return the old value. */ /*=======================*/ return(oldValue); }
void DivisionFunction( UDFContext *context, CLIPSValue *returnValue) { CLIPSFloat ftotal = 1.0; CLIPSFloat theNumber; CLIPSValue theArg; Environment *theEnv = UDFContextEnvironment(context); /*===================================================*/ /* Get the first argument. This number which will be */ /* the starting product from which all subsequent */ /* arguments will divide. If the auto float dividend */ /* feature is enable, then this number is converted */ /* to a float if it is an integer. */ /*===================================================*/ if (! UDFFirstArgument(context,NUMBER_TYPES,&theArg)) { return; } ftotal = mCVToFloat(&theArg); /*====================================================*/ /* Loop through each of the arguments dividing it */ /* into a running product. If a floating point number */ /* is encountered, then do all subsequent operations */ /* using floating point values. Each argument is */ /* checked to prevent a divide by zero error. */ /*====================================================*/ while (UDFHasNextArgument(context)) { if (! UDFNextArgument(context,NUMBER_TYPES,&theArg)) { return; } theNumber = mCVToFloat(&theArg); if (theNumber == 0.0) { DivideByZeroErrorMessage(theEnv,"/"); EnvSetEvaluationError(theEnv,true); mCVSetFloat(returnValue,1.0); return; } ftotal /= theNumber; } /*======================================================*/ /* If a floating point number was in the argument list, */ /* then return a float, otherwise return an integer. */ /*======================================================*/ mCVSetFloat(returnValue,ftotal); }
void CommandLoopBatchDriver( void *theEnv) { int inchar; while (true) { if (GetHaltCommandLoopBatch(theEnv) == true) { CloseAllBatchSources(theEnv); SetHaltCommandLoopBatch(theEnv,false); } /*===================================================*/ /* If a batch file is active, grab the command input */ /* directly from the batch file, otherwise call the */ /* event function. */ /*===================================================*/ if (BatchActive(theEnv) == true) { inchar = LLGetcBatch(theEnv,STDIN,true); if (inchar == EOF) { return; } else { ExpandCommandString(theEnv,(char) inchar); } } else { return; } /*=================================================*/ /* If execution was halted, then remove everything */ /* from the command buffer. */ /*=================================================*/ if (EnvGetHaltExecution(theEnv) == true) { EnvSetHaltExecution(theEnv,false); EnvSetEvaluationError(theEnv,false); FlushCommandString(theEnv); #if ! WINDOW_INTERFACE fflush(stdin); #endif EnvPrintRouter(theEnv,WPROMPT,"\n"); PrintPrompt(theEnv); } /*=========================================*/ /* If a complete command is in the command */ /* buffer, then execute it. */ /*=========================================*/ ExecuteIfCommandComplete(theEnv); } }
globle void FactSlotValue( void *theEnv, void *vTheFact, const char *theSlotName, DATA_OBJECT *returnValue) { struct fact *theFact = (struct fact *) vTheFact; short position; /*==================================================*/ /* Make sure the slot exists (the symbol implied is */ /* used for the implied slot of an ordered fact). */ /*==================================================*/ if (theFact->whichDeftemplate->implied) { if (strcmp(theSlotName,"implied") != 0) { EnvSetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,theSlotName, ValueToString(theFact->whichDeftemplate->header.name),FALSE); return; } } else if (FindSlot(theFact->whichDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,theSlotName),&position) == NULL) { EnvSetEvaluationError(theEnv,TRUE); InvalidDeftemplateSlotMessage(theEnv,theSlotName, ValueToString(theFact->whichDeftemplate->header.name),FALSE); return; } /*==========================*/ /* Return the slot's value. */ /*==========================*/ if (theFact->whichDeftemplate->implied) { EnvGetFactSlot(theEnv,theFact,NULL,returnValue); } else { EnvGetFactSlot(theEnv,theFact,theSlotName,returnValue); } }
static void SingularityErrorMessage( void *theEnv, const char *functionName) { PrintErrorID(theEnv,"EMATHFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Singularity at asymptote in "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); EnvSetHaltExecution(theEnv,TRUE); EnvSetEvaluationError(theEnv,TRUE); }
static void ArgumentOverflowErrorMessage( void *theEnv, const char *functionName) { PrintErrorID(theEnv,"EMATHFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Argument overflow for "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); EnvSetHaltExecution(theEnv,TRUE); EnvSetEvaluationError(theEnv,TRUE); }
static void DomainErrorMessage( void *theEnv, const char *functionName) { PrintErrorID(theEnv,"EMATHFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Domain error for "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); EnvSetHaltExecution(theEnv,TRUE); EnvSetEvaluationError(theEnv,TRUE); }
globle void ModFunction( void *theEnv, DATA_OBJECT_PTR result) { DATA_OBJECT item1, item2; double fnum1, fnum2; long long lnum1, lnum2; if (EnvArgCountCheck(theEnv,"mod",EXACTLY,2) == -1) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return; } if (EnvArgTypeCheck(theEnv,"mod",1,INTEGER_OR_FLOAT,&item1) == FALSE) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return; } if (EnvArgTypeCheck(theEnv,"mod",2,INTEGER_OR_FLOAT,&item2) == FALSE) { result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return; } if (((item2.type == INTEGER) ? (ValueToLong(item2.value) == 0L) : FALSE) || ((item2.type == FLOAT) ? ValueToDouble(item2.value) == 0.0 : FALSE)) { DivideByZeroErrorMessage(theEnv,"mod"); EnvSetEvaluationError(theEnv,TRUE); result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return; } if ((item1.type == FLOAT) || (item2.type == FLOAT)) { fnum1 = CoerceToDouble(item1.type,item1.value); fnum2 = CoerceToDouble(item2.type,item2.value); result->type = FLOAT; result->value = (void *) EnvAddDouble(theEnv,fnum1 - (dtrunc(fnum1 / fnum2) * fnum2)); } else { lnum1 = DOToLong(item1); lnum2 = DOToLong(item2); result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,lnum1 - (lnum1 / lnum2) * lnum2); } }
/*************************************************************** NAME : ClassExistError DESCRIPTION : Prints out error message for non-existent class INPUTS : 1) Name of function having the error 2) The name of the non-existent class RETURNS : Nothing useful SIDE EFFECTS : None NOTES : None ***************************************************************/ void ClassExistError( void *theEnv, const char *func, const char *cname) { PrintErrorID(theEnv,"CLASSFUN",1,false); EnvPrintRouter(theEnv,WERROR,"Unable to find class "); EnvPrintRouter(theEnv,WERROR,cname); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); EnvSetEvaluationError(theEnv,true); }
globle void SlotExistError( void *theEnv, const char *sname, const char *func) { PrintErrorID(theEnv,"INSFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"No such slot "); EnvPrintRouter(theEnv,WERROR,sname); EnvPrintRouter(theEnv,WERROR," in function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,".\n"); EnvSetEvaluationError(theEnv,TRUE); }
/*************************************************** NAME : CheckSlotExists DESCRIPTION : Checks first two arguments of a function for a valid class and (inherited) slot INPUTS : 1) The name of the function 2) A buffer to hold the found class 3) A flag indicating whether the non-existence of the slot should be an error 4) A flag indicating if the slot can be inherited or not RETURNS : NULL if slot not found, slot descriptor otherwise SIDE EFFECTS : Class buffer set if no errors, NULL on errors NOTES : None ***************************************************/ static SLOT_DESC *CheckSlotExists( void *theEnv, const char *func, DEFCLASS **classBuffer, intBool existsErrorFlag, intBool inheritFlag) { SYMBOL_HN *ssym; int slotIndex; SLOT_DESC *sd; ssym = CheckClassAndSlot(theEnv,func,classBuffer); if (ssym == NULL) return(NULL); slotIndex = FindInstanceTemplateSlot(theEnv,*classBuffer,ssym); if (slotIndex == -1) { if (existsErrorFlag) { SlotExistError(theEnv,ValueToString(ssym),func); EnvSetEvaluationError(theEnv,TRUE); } return(NULL); } sd = (*classBuffer)->instanceTemplate[slotIndex]; if ((sd->cls == *classBuffer) || inheritFlag) return(sd); PrintErrorID(theEnv,"CLASSEXM",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Inherited slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(ssym)); EnvPrintRouter(theEnv,WERROR," from class "); PrintClassName(theEnv,WERROR,sd->cls,FALSE); EnvPrintRouter(theEnv,WERROR," is not valid for function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR,"\n"); EnvSetEvaluationError(theEnv,TRUE); return(NULL); }
void DivFunction( UDFContext *context, CLIPSValue *returnValue) { CLIPSInteger total = 1LL; DATA_OBJECT theArg; CLIPSInteger theNumber; void *theEnv = UDFContextEnvironment(context); /*===================================================*/ /* Get the first argument. This number which will be */ /* the starting product from which all subsequent */ /* arguments will divide. */ /*===================================================*/ if (! UDFFirstArgument(context,NUMBER_TYPES,&theArg)) { return; } total = mCVToInteger(&theArg); /*=====================================================*/ /* Loop through each of the arguments dividing it into */ /* a running product. Floats are converted to integers */ /* and each argument is checked to prevent a divide by */ /* zero error. */ /*=====================================================*/ while (UDFHasNextArgument(context)) { if (! UDFNextArgument(context,NUMBER_TYPES,&theArg)) { return; } theNumber = mCVToInteger(&theArg); if (theNumber == 0LL) { DivideByZeroErrorMessage(theEnv,"div"); EnvSetEvaluationError(theEnv,true); mCVSetInteger(returnValue,1L); return; } total /= theNumber; } /*======================================================*/ /* The result of the div function is always an integer. */ /*======================================================*/ mCVSetInteger(returnValue,total); }
/********************************************************** NAME : DetermineQueryClasses DESCRIPTION : Builds a list of classes to be used in instance queries - uses parse form. INPUTS : 1) The parse class expression chain 2) The name of the function being executed 3) Caller's buffer for restriction count (# of separate lists) RETURNS : The query list, or NULL on errors SIDE EFFECTS : Memory allocated for list Busy count incremented for all classes NOTES : Each restriction is linked by nxt pointer, multiple classes in a restriction are linked by the chain pointer. Rcnt caller's buffer is set to reflect the total number of chains Assumes classExp is not NULL and that each restriction chain is terminated with the QUERY_DELIMITER_SYMBOL "(QDS)" **********************************************************/ static QUERY_CLASS *DetermineQueryClasses( void *theEnv, EXPRESSION *classExp, const char *func, unsigned *rcnt) { QUERY_CLASS *clist = NULL,*cnxt = NULL,*cchain = NULL,*tmp; int new_list = FALSE; DATA_OBJECT temp; *rcnt = 0; while (classExp != NULL) { if (EvaluateExpression(theEnv,classExp,&temp)) { DeleteQueryClasses(theEnv,clist); return(NULL); } if ((temp.type == SYMBOL) && (temp.value == (void *) InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL)) { new_list = TRUE; (*rcnt)++; } else if ((tmp = FormChain(theEnv,func,&temp)) != NULL) { if (clist == NULL) clist = cnxt = cchain = tmp; else if (new_list == TRUE) { new_list = FALSE; cnxt->nxt = tmp; cnxt = cchain = tmp; } else cchain->chain = tmp; while (cchain->chain != NULL) cchain = cchain->chain; } else { SyntaxErrorMessage(theEnv,"instance-set query class restrictions"); DeleteQueryClasses(theEnv,clist); EnvSetEvaluationError(theEnv,TRUE); return(NULL); } classExp = classExp->nextArg; } return(clist); }
globle void SyntaxErrorMessage( void *theEnv, const char *location) { PrintErrorID(theEnv,"PRNTUTIL",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Syntax Error"); if (location != NULL) { EnvPrintRouter(theEnv,WERROR,": Check appropriate syntax for "); EnvPrintRouter(theEnv,WERROR,location); } EnvPrintRouter(theEnv,WERROR,".\n"); EnvSetEvaluationError(theEnv,TRUE); }
void CommandLoopBatch( void *theEnv) { EnvSetHaltExecution(theEnv,false); EnvSetEvaluationError(theEnv,false); CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); PrintPrompt(theEnv); RouterData(theEnv)->CommandBufferInputCount = 0; RouterData(theEnv)->AwaitingInput = true; CommandLoopBatchDriver(theEnv); }
void MultiIntoSingleFieldSlotError( void *theEnv, struct templateSlot *theSlot, struct deftemplate *theDeftemplate) { PrintErrorID(theEnv,"TMPLTFUN",2,true); EnvPrintRouter(theEnv,WERROR,"Attempted to assert a multifield value \n"); EnvPrintRouter(theEnv,WERROR,"into the single field slot "); if (theSlot != NULL) EnvPrintRouter(theEnv,WERROR,theSlot->slotName->contents); else EnvPrintRouter(theEnv,WERROR,"<<unknown>>"); EnvPrintRouter(theEnv,WERROR," of deftemplate "); if (theDeftemplate != NULL) EnvPrintRouter(theEnv,WERROR,theDeftemplate->header.name->contents); else EnvPrintRouter(theEnv,WERROR,"<<unknown>>"); EnvPrintRouter(theEnv,WERROR,".\n"); EnvSetEvaluationError(theEnv,true); }
/*********************************************************************** NAME : OverrideNextMethod DESCRIPTION : Changes the arguments to shadowed methods, thus the set of applicable methods to this call may change INPUTS : A buffer to hold the result of the call RETURNS : Nothing useful SIDE EFFECTS : Any of evaluating method restrictions and bodies NOTES : H/L Syntax: (override-next-method <args>) ***********************************************************************/ void OverrideNextMethod( UDFContext *context, CLIPSValue *returnValue) { Environment *theEnv = UDFContextEnvironment(context); mCVSetBoolean(returnValue,false); if (EvaluationData(theEnv)->HaltExecution) return; if (DefgenericData(theEnv)->CurrentMethod == NULL) { PrintErrorID(theEnv,"GENRCEXE",2,false); EnvPrintRouter(theEnv,WERROR,"Shadowed methods not applicable in current context.\n"); EnvSetEvaluationError(theEnv,true); return; } GenericDispatch(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod,NULL, GetFirstArgument(),returnValue); }
globle double PowFunction( void *theEnv) { DATA_OBJECT value1, value2; if (EnvArgCountCheck(theEnv,"**",EXACTLY,2) == -1) return(0.0); if (EnvArgTypeCheck(theEnv,"**",1,FLOAT,&value1) == FALSE) return(0.0); if (EnvArgTypeCheck(theEnv,"**",2,FLOAT,&value2) == FALSE) return(0.0); if (((DOToDouble(value1) == 0.0) && (DOToDouble(value2) <= 0.0)) || ((DOToDouble(value1) < 0.0) && (dtrunc((double) DOToDouble(value2)) != DOToDouble(value2)))) { DomainErrorMessage(theEnv,"**"); EnvSetHaltExecution(theEnv,TRUE); EnvSetEvaluationError(theEnv,TRUE); return(0.0); } return (pow(DOToDouble(value1),DOToDouble(value2))); }
static long long GetFactsArgument( void *theEnv, int whichOne, int argumentCount) { long long factIndex; DATA_OBJECT theValue; if (whichOne > argumentCount) return(UNSPECIFIED); if (EnvArgTypeCheck(theEnv,"facts",whichOne,INTEGER,&theValue) == FALSE) return(INVALID); factIndex = DOToLong(theValue); if (factIndex < 0) { ExpectedTypeError1(theEnv,"facts",whichOne,"positive number"); EnvSetHaltExecution(theEnv,TRUE); EnvSetEvaluationError(theEnv,TRUE); return(INVALID); } return(factIndex); }
globle void PPFactFunction( void *theEnv) { struct fact *theFact; int numberOfArguments; const char *logicalName = NULL; /* Avoids warning */ int ignoreDefaults = FALSE; DATA_OBJECT theArg; if ((numberOfArguments = EnvArgRangeCheck(theEnv,"ppfact",1,3)) == -1) return; theFact = GetFactAddressOrIndexArgument(theEnv,"ppfact",1,TRUE); if (theFact == NULL) return; /*===============================================================*/ /* Determine the logical name to which the fact will be printed. */ /*===============================================================*/ if (numberOfArguments == 1) { logicalName = STDOUT; } else { logicalName = GetLogicalName(theEnv,2,STDOUT); if (logicalName == NULL) { IllegalLogicalNameMessage(theEnv,"ppfact"); EnvSetHaltExecution(theEnv,TRUE); EnvSetEvaluationError(theEnv,TRUE); return; } } /*=========================================*/ /* Should slot values be printed if they */ /* are the same as the default slot value. */ /*=========================================*/ if (numberOfArguments == 3) { EnvRtnUnknown(theEnv,3,&theArg); if ((theArg.value == EnvFalseSymbol(theEnv)) && (theArg.type == SYMBOL)) { ignoreDefaults = FALSE; } else { ignoreDefaults = TRUE; } } /*============================================================*/ /* Determine if any router recognizes the output destination. */ /*============================================================*/ if (strcmp(logicalName,"nil") == 0) { return; } else if (QueryRouters(theEnv,logicalName) == FALSE) { UnrecognizedRouterMessage(theEnv,logicalName); return; } EnvPPFact(theEnv,theFact,logicalName,ignoreDefaults); }
globle void FactsCommand( void *theEnv) { int argumentCount; long long start = UNSPECIFIED, end = UNSPECIFIED, max = UNSPECIFIED; struct defmodule *theModule; DATA_OBJECT theValue; int argOffset; /*=========================================================*/ /* Determine the number of arguments to the facts command. */ /*=========================================================*/ if ((argumentCount = EnvArgCountCheck(theEnv,"facts",NO_MORE_THAN,4)) == -1) return; /*==================================*/ /* The default module for the facts */ /* command is the current module. */ /*==================================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); /*==========================================*/ /* If no arguments were specified, then use */ /* the default values to list the facts. */ /*==========================================*/ if (argumentCount == 0) { EnvFacts(theEnv,WDISPLAY,theModule,start,end,max); return; } /*========================================================*/ /* Since there are one or more arguments, see if a module */ /* or start index was specified as the first argument. */ /*========================================================*/ EnvRtnUnknown(theEnv,1,&theValue); /*===============================================*/ /* If the first argument is a symbol, then check */ /* to see that a valid module was specified. */ /*===============================================*/ if (theValue.type == SYMBOL) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theValue.value)); if ((theModule == NULL) && (strcmp(ValueToString(theValue.value),"*") != 0)) { EnvSetEvaluationError(theEnv,TRUE); CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theValue.value)); return; } if ((start = GetFactsArgument(theEnv,2,argumentCount)) == INVALID) return; argOffset = 1; } /*================================================*/ /* Otherwise if the first argument is an integer, */ /* check to see that a valid index was specified. */ /*================================================*/ else if (theValue.type == INTEGER) { start = DOToLong(theValue); if (start < 0) { ExpectedTypeError1(theEnv,"facts",1,"symbol or positive number"); EnvSetHaltExecution(theEnv,TRUE); EnvSetEvaluationError(theEnv,TRUE); return; } argOffset = 0; } /*==========================================*/ /* Otherwise the first argument is invalid. */ /*==========================================*/ else { ExpectedTypeError1(theEnv,"facts",1,"symbol or positive number"); EnvSetHaltExecution(theEnv,TRUE); EnvSetEvaluationError(theEnv,TRUE); return; } /*==========================*/ /* Get the other arguments. */ /*==========================*/ if ((end = GetFactsArgument(theEnv,2 + argOffset,argumentCount)) == INVALID) return; if ((max = GetFactsArgument(theEnv,3 + argOffset,argumentCount)) == INVALID) return; /*=================*/ /* List the facts. */ /*=================*/ EnvFacts(theEnv,WDISPLAY,theModule,start,end,max); }