/*************************************************************************** NAME : GetQueryFactSlot DESCRIPTION : Internal function for referring to slots of fact in fact array on fact-queries INPUTS : The caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's result buffer set appropriately NOTES : H/L Syntax : ((query-fact-slot) <index> <slot-name>) **************************************************************************/ globle void GetQueryFactSlot( void *theEnv, DATA_OBJECT *result) { struct fact *theFact; DATA_OBJECT temp; QUERY_CORE *core; short position; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument()))); theFact = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))]; EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,"get",1,"symbol"); SetEvaluationError(theEnv,TRUE); return; } /*==================================================*/ /* Make sure the slot exists (the symbol implied is */ /* used for the implied slot of an ordered fact). */ /*==================================================*/ if (theFact->whichDeftemplate->implied) { if (strcmp(ValueToString(temp.value),"implied") != 0) { SlotExistError(theEnv,ValueToString(temp.value),"fact-set query"); return; } position = 1; } else if (FindSlot((struct deftemplate *) theFact->whichDeftemplate, (struct symbolHashNode *) temp.value,&position) == NULL) { SlotExistError(theEnv,ValueToString(temp.value),"fact-set query"); return; } result->type = theFact->theProposition.theFields[position-1].type; result->value = theFact->theProposition.theFields[position-1].value; if (result->type == MULTIFIELD) { SetpDOBegin(result,1); SetpDOEnd(result,((struct multifield *) result->value)->multifieldLength); } }
/*************************************************************************** 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( DATA_OBJECT *result) { INSTANCE_TYPE *ins; INSTANCE_SLOT *sp; DATA_OBJECT temp; QUERY_CORE *core; result->type = SYMBOL; result->value = FalseSymbol; core = FindQueryCore(DOPToInteger(GetFirstArgument())); ins = core->solns[DOPToInteger(GetFirstArgument()->nextArg)]; EvaluateExpression(GetFirstArgument()->nextArg->nextArg,&temp); if (temp.type != SYMBOL) { ExpectedTypeError1("get",1,"symbol"); SetEvaluationError(TRUE); return; } sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(ValueToString(temp.value),"instance-set query"); return; } result->type = sp->type; result->value = sp->value; if (sp->type == MULTIFIELD) { result->begin = 0; result->end = GetInstanceSlotLength(sp) - 1; } }
/********************************************************* NAME : SlotInfoSlot DESCRIPTION : Runtime support routine for slot-sources, slot-facets, et. al. which looks up a slot INPUTS : 1) Data object buffer 2) Class pointer 3) Name-string of slot to find 4) The name of the calling function RETURNS : Nothing useful SIDE EFFECTS : Support function called and data object buffer initialized NOTES : None *********************************************************/ static SLOT_DESC *SlotInfoSlot( void *theEnv, DATA_OBJECT *result, DEFCLASS *cls, const char *sname, const char *fnxname) { SYMBOL_HN *ssym; int i; if ((ssym = FindSymbolHN(theEnv,sname)) == NULL) { SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,result); return(NULL); } i = FindInstanceTemplateSlot(theEnv,cls,ssym); if (i == -1) { SlotExistError(theEnv,sname,fnxname); SetEvaluationError(theEnv,TRUE); EnvSetMultifieldErrorValue(theEnv,result); return(NULL); } result->type = MULTIFIELD; result->begin = 0; return(cls->instanceTemplate[i]); }
/*************************************************************************** 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)); } }
/*********************************************************** NAME : DynamicHandlerPutSlot DESCRIPTION : Directly puts a slot's value (uses dynamic binding to lookup slot) INPUTS : Data obejct buffer for holding slot value RETURNS : Nothing useful SIDE EFFECTS : Slot modified - and caller's buffer set to value (or symbol FALSE on errors) NOTES : H/L Syntax: (put <slot> <value>*) ***********************************************************/ globle void DynamicHandlerPutSlot( DATA_OBJECT *theResult) { INSTANCE_SLOT *sp; INSTANCE_TYPE *ins; DATA_OBJECT temp; theResult->type = SYMBOL; theResult->value = FalseSymbol; if (CheckCurrentMessage("dynamic-put",TRUE) == FALSE) return; EvaluateExpression(GetFirstArgument(),&temp); if (temp.type != SYMBOL) { ExpectedTypeError1("dynamic-put",1,"symbol"); SetEvaluationError(TRUE); return; } ins = GetActiveInstance(); sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(ValueToString(temp.value),"dynamic-put"); return; } if ((sp->desc->noWrite == 0) ? FALSE : ((sp->desc->initializeOnly == 0) || (!ins->initializeInProgress))) { SlotAccessViolationError(ValueToString(sp->desc->slotName->name), TRUE,(void *) ins); SetEvaluationError(TRUE); return; } if ((sp->desc->publicVisibility == 0) && (CurrentCore->hnd->cls != sp->desc->cls)) { SlotVisibilityViolationError(sp->desc,CurrentCore->hnd->cls); SetEvaluationError(TRUE); return; } if (GetFirstArgument()->nextArg) { if (EvaluateAndStoreInDataObject((int) sp->desc->multiple, GetFirstArgument()->nextArg,&temp) == FALSE) return; } else { SetpDOBegin(&temp,1); SetpDOEnd(&temp,0); SetpType(&temp,MULTIFIELD); SetpValue(&temp,NoParamValue); } PutSlotValue(ins,sp,&temp,theResult,NULL); }
/*************************************************** 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 SlotDescriptor *CheckSlotExists( UDFContext *context, const char *func, Defclass **classBuffer, bool existsErrorFlag, bool inheritFlag) { CLIPSLexeme *ssym; int slotIndex; SlotDescriptor *sd; Environment *theEnv = context->environment; ssym = CheckClassAndSlot(context,func,classBuffer); if (ssym == NULL) return NULL; slotIndex = FindInstanceTemplateSlot(theEnv,*classBuffer,ssym); if (slotIndex == -1) { if (existsErrorFlag) { SlotExistError(theEnv,ssym->contents,func); SetEvaluationError(theEnv,true); } return NULL; } sd = (*classBuffer)->instanceTemplate[slotIndex]; if ((sd->cls == *classBuffer) || inheritFlag) { return sd; } PrintErrorID(theEnv,"CLASSEXM",1,false); WriteString(theEnv,STDERR,"Inherited slot '"); WriteString(theEnv,STDERR,ssym->contents); WriteString(theEnv,STDERR,"' from class "); PrintClassName(theEnv,STDERR,sd->cls,true,false); WriteString(theEnv,STDERR," is not valid for function '"); WriteString(theEnv,STDERR,func); WriteString(theEnv,STDERR,"'.\n"); SetEvaluationError(theEnv,true); return NULL; }
/***************************************************** NAME : DynamicHandlerGetSlot DESCRIPTION : Directly references a slot's value (uses dynamic binding to lookup slot) INPUTS : The caller's result buffer RETURNS : Nothing useful SIDE EFFECTS : Caller's result buffer set NOTES : H/L Syntax: (get <slot>) *****************************************************/ globle void DynamicHandlerGetSlot( DATA_OBJECT *result) { INSTANCE_SLOT *sp; INSTANCE_TYPE *ins; DATA_OBJECT temp; result->type = SYMBOL; result->value = FalseSymbol; if (CheckCurrentMessage("dynamic-get",TRUE) == FALSE) return; EvaluateExpression(GetFirstArgument(),&temp); if (temp.type != SYMBOL) { ExpectedTypeError1("dynamic-get",1,"symbol"); SetEvaluationError(TRUE); return; } ins = GetActiveInstance(); sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(ValueToString(temp.value),"dynamic-get"); return; } if ((sp->desc->publicVisibility == 0) && (CurrentCore->hnd->cls != sp->desc->cls)) { SlotVisibilityViolationError(sp->desc,CurrentCore->hnd->cls); SetEvaluationError(TRUE); return; } result->type = sp->type; result->value = sp->value; if (sp->type == MULTIFIELD) { result->begin = 0; result->end = GetInstanceSlotLength(sp) - 1; } }
/*************************************************** 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, 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); SetEvaluationError(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"); SetEvaluationError(theEnv,TRUE); return(NULL); }
/********************************************************************* NAME : CheckMultifieldSlotModify DESCRIPTION : For the functions slot-replace$, insert, & delete as well as direct-slot-replace$, insert, & delete this function gets the slot, index, and optional field-value for these functions INPUTS : 1) A code indicating the type of operation INSERT (0) : Requires one index REPLACE (1) : Requires two indices DELETE_OP (2) : Requires two indices 2) Function name-string 3) Instance address 4) Argument expression chain 5) Caller's buffer for index (or beginning of range) 6) Caller's buffer for end of range (can be NULL for INSERT) 7) Caller's new-field value buffer (can be NULL for DELETE_OP) RETURNS : The address of the instance-slot, NULL on errors SIDE EFFECTS : Caller's index buffer set Caller's new-field value buffer set (if not NULL) Will allocate an ephemeral segment to store more than 1 new field value EvaluationError set on errors NOTES : Assume the argument chain is at least 2 expressions deep - slot, index, and optional values *********************************************************************/ static INSTANCE_SLOT *CheckMultifieldSlotModify( void *theEnv, int code, char *func, INSTANCE_TYPE *ins, EXPRESSION *args, int *rb, int *re, DATA_OBJECT *newval) { DATA_OBJECT temp; INSTANCE_SLOT *sp; int start; start = (args == GetFirstArgument()) ? 1 : 2; EvaluationData(theEnv)->EvaluationError = FALSE; EvaluateExpression(theEnv,args,&temp); if (temp.type != SYMBOL) { ExpectedTypeError1(theEnv,func,start,"symbol"); SetEvaluationError(theEnv,TRUE); return(NULL); } sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value); if (sp == NULL) { SlotExistError(theEnv,ValueToString(temp.value),func); return(NULL); } if (sp->desc->multiple == 0) { PrintErrorID(theEnv,"INSMULT",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,func); EnvPrintRouter(theEnv,WERROR," cannot be used on single-field slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name)); EnvPrintRouter(theEnv,WERROR," in instance "); EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name)); EnvPrintRouter(theEnv,WERROR,".\n"); SetEvaluationError(theEnv,TRUE); return(NULL); } EvaluateExpression(theEnv,args->nextArg,&temp); if (temp.type != INTEGER) { ExpectedTypeError1(theEnv,func,start+1,"integer"); SetEvaluationError(theEnv,TRUE); return(NULL); } args = args->nextArg->nextArg; *rb = ValueToInteger(temp.value); if ((code == REPLACE) || (code == DELETE_OP)) { EvaluateExpression(theEnv,args,&temp); if (temp.type != INTEGER) { ExpectedTypeError1(theEnv,func,start+2,"integer"); SetEvaluationError(theEnv,TRUE); return(NULL); } *re = ValueToInteger(temp.value); args = args->nextArg; } if ((code == INSERT) || (code == REPLACE)) { if (EvaluateAndStoreInDataObject(theEnv,1,args,newval) == FALSE) return(NULL); } return(sp); }