/*********************************************************** NAME : EvaluateAndStoreInDataObject DESCRIPTION : Evaluates slot-value expressions and stores the result in a Kernel data object INPUTS : 1) Flag indicating if multifields are OK 2) The value-expression 3) The data object structure 4) Flag indicating if a multifield value should be placed on the garbage list. RETURNS : FALSE on errors, TRUE otherwise SIDE EFFECTS : Segment allocated for storing multifield values NOTES : None ***********************************************************/ globle int EvaluateAndStoreInDataObject( void *theEnv, int mfp, EXPRESSION *theExp, DATA_OBJECT *val, int garbageSegment) { val->type = MULTIFIELD; val->begin = 0; val->end = -1; if (theExp == NULL) { if (garbageSegment) val->value = EnvCreateMultifield(theEnv,0L); else val->value = CreateMultifield2(theEnv,0L); return(TRUE); } if ((mfp == 0) && (theExp->nextArg == NULL)) EvaluateExpression(theEnv,theExp,val); else StoreInMultifield(theEnv,val,theExp,garbageSegment); return(EvaluationData(theEnv)->EvaluationError ? FALSE : TRUE); }
globle int FactStoreMultifield( void *theEnv, void *theValue, DATA_OBJECT *theResult) { StoreInMultifield(theEnv,theResult,GetFirstArgument(),FALSE); return(TRUE); }
globle int FactStoreMultifield( void *theEnv, void *theValue, DATA_OBJECT *theResult) { #if MAC_MCW || WIN_MCW || MAC_XCD #pragma unused(theValue) #endif StoreInMultifield(theEnv,theResult,GetFirstArgument(),FALSE); return(TRUE); }
bool FactStoreMultifield( Environment *theEnv, void *theValue, UDFValue *theResult) { #if MAC_XCD #pragma unused(theValue) #endif StoreInMultifield(theEnv,theResult,GetFirstArgument(),false); return true; }
globle BOOLEAN AssignFactSlotDefaults( void *vTheFact) { struct fact *theFact = (struct fact *) vTheFact; struct deftemplate *theDeftemplate; struct templateSlot *slotPtr; int i; DATA_OBJECT theResult; /*===============================================*/ /* Get the deftemplate associated with the fact. */ /*===============================================*/ theDeftemplate = theFact->whichDeftemplate; /*================================================*/ /* The value for the implied multifield slot of */ /* an implied deftemplate is set to a multifield */ /* of length zero when the fact is created. */ /*================================================*/ if (theDeftemplate->implied) return(TRUE); /*============================================*/ /* Loop through each slot of the deftemplate. */ /*============================================*/ for (i = 0, slotPtr = theDeftemplate->slotList; i < (int) theDeftemplate->numberOfSlots; i++, slotPtr = slotPtr->next) { /*===================================*/ /* If the slot's value has been set, */ /* then move on to the next slot. */ /*===================================*/ if (theFact->theProposition.theFields[i].type != RVOID) continue; /*===============================================*/ /* If the (default ?NONE) attribute was declared */ /* for the slot, then return FALSE to indicate */ /* the default values for the fact couldn't be */ /* supplied since this attribute requires that a */ /* default value can't be used for the slot. */ /*===============================================*/ if (slotPtr->noDefault) return(FALSE); /*==============================================*/ /* Otherwise if a static default was specified, */ /* use this as the default value. */ /*==============================================*/ else if (slotPtr->defaultPresent) { if (slotPtr->multislot) { StoreInMultifield(&theResult,slotPtr->defaultList,TRUE); theFact->theProposition.theFields[i].value = DOToMultifield(&theResult); } else { theFact->theProposition.theFields[i].type = slotPtr->defaultList->type; theFact->theProposition.theFields[i].value = slotPtr->defaultList->value; } } /*================================================*/ /* Otherwise if a dynamic-default was specified, */ /* evaluate it and use this as the default value. */ /*================================================*/ else if (slotPtr->defaultDynamic) { EvaluateExpression(slotPtr->defaultList,&theResult); if (EvaluationError) return(FALSE); theFact->theProposition.theFields[i].type = (short) theResult.type; if (theResult.type == MULTIFIELD) { theFact->theProposition.theFields[i].value = DOToMultifield(&theResult); } else { theFact->theProposition.theFields[i].value = theResult.value; } } /*====================================*/ /* Otherwise derive the default value */ /* from the slot's constraints. */ /*====================================*/ else { DeriveDefaultFromConstraints(slotPtr->constraints,&theResult, (int) slotPtr->multislot); theFact->theProposition.theFields[i].type = (short) theResult.type; if (theResult.type == MULTIFIELD) { theFact->theProposition.theFields[i].value = DOToMultifield(&theResult); } else { theFact->theProposition.theFields[i].value = theResult.value; } } } /*==========================================*/ /* Return TRUE to indicate that the default */ /* values have been successfully set. */ /*==========================================*/ return(TRUE); }
static void DuplicateModifyCommand( void *theEnv, int retractIt, DATA_OBJECT_PTR returnValue) { long int factNum; struct fact *oldFact, *newFact, *theFact; struct expr *testPtr; DATA_OBJECT computeResult; struct deftemplate *templatePtr; struct templateSlot *slotPtr; int i, position, found; /*===================================================*/ /* Set the default return value to the symbol FALSE. */ /*===================================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,SymbolData(theEnv)->FalseSymbol); /*==================================================*/ /* Evaluate the first argument which is used to get */ /* a pointer to the fact to be modified/duplicated. */ /*==================================================*/ testPtr = GetFirstArgument(); EvaluateExpression(theEnv,testPtr,&computeResult); /*==============================================================*/ /* If an integer is supplied, then treat it as a fact-index and */ /* search the fact-list for the fact with that fact-index. */ /*==============================================================*/ if (computeResult.type == INTEGER) { factNum = ValueToLong(computeResult.value); if (factNum < 0) { if (retractIt) ExpectedTypeError2(theEnv,"modify",1); else ExpectedTypeError2(theEnv,"duplicate",1); SetEvaluationError(theEnv,TRUE); return; } oldFact = (struct fact *) EnvGetNextFact(theEnv,NULL); while (oldFact != NULL) { if (oldFact->factIndex == factNum) { break; } else { oldFact = oldFact->nextFact; } } if (oldFact == NULL) { char tempBuffer[20]; sprintf(tempBuffer,"f-%ld",factNum); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); return; } } /*==========================================*/ /* Otherwise, if a pointer is supplied then */ /* no lookup is required. */ /*==========================================*/ else if (computeResult.type == FACT_ADDRESS) { oldFact = (struct fact *) computeResult.value; } /*===========================================*/ /* Otherwise, the first argument is invalid. */ /*===========================================*/ else { if (retractIt) ExpectedTypeError2(theEnv,"modify",1); else ExpectedTypeError2(theEnv,"duplicate",1); SetEvaluationError(theEnv,TRUE); return; } /*==================================*/ /* See if it is a deftemplate fact. */ /*==================================*/ templatePtr = oldFact->whichDeftemplate; if (templatePtr->implied) return; /*================================================================*/ /* Duplicate the values from the old fact (skipping multifields). */ /*================================================================*/ newFact = (struct fact *) CreateFactBySize(theEnv,oldFact->theProposition.multifieldLength); newFact->whichDeftemplate = templatePtr; for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++) { newFact->theProposition.theFields[i].type = oldFact->theProposition.theFields[i].type; if (newFact->theProposition.theFields[i].type != MULTIFIELD) { newFact->theProposition.theFields[i].value = oldFact->theProposition.theFields[i].value; } else { newFact->theProposition.theFields[i].value = NULL; } } /*========================*/ /* Start replacing slots. */ /*========================*/ testPtr = testPtr->nextArg; while (testPtr != NULL) { /*============================================================*/ /* If the slot identifier is an integer, then the slot was */ /* previously identified and its position within the template */ /* was stored. Otherwise, the position of the slot within the */ /* deftemplate has to be determined by comparing the name of */ /* the slot against the list of slots for the deftemplate. */ /*============================================================*/ if (testPtr->type == INTEGER) { position = (int) ValueToLong(testPtr->value); } else { found = FALSE; position = 0; slotPtr = templatePtr->slotList; while (slotPtr != NULL) { if (slotPtr->slotName == (SYMBOL_HN *) testPtr->value) { found = TRUE; slotPtr = NULL; } else { slotPtr = slotPtr->next; position++; } } if (! found) { InvalidDeftemplateSlotMessage(theEnv,ValueToString(testPtr->value), ValueToString(templatePtr->header.name)); SetEvaluationError(theEnv,TRUE); ReturnFact(theEnv,newFact); return; } } /*===================================================*/ /* If a single field slot is being replaced, then... */ /*===================================================*/ if (newFact->theProposition.theFields[position].type != MULTIFIELD) { /*======================================================*/ /* If the list of values to store in the slot is empty */ /* or contains more than one member than an error has */ /* occured because a single field slot can only contain */ /* a single value. */ /*======================================================*/ if ((testPtr->argList == NULL) ? TRUE : (testPtr->argList->nextArg != NULL)) { MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr); ReturnFact(theEnv,newFact); return; } /*===================================================*/ /* Evaluate the expression to be stored in the slot. */ /*===================================================*/ EvaluateExpression(theEnv,testPtr->argList,&computeResult); SetEvaluationError(theEnv,FALSE); /*====================================================*/ /* If the expression evaluated to a multifield value, */ /* then an error occured since a multifield value can */ /* not be stored in a single field slot. */ /*====================================================*/ if (computeResult.type == MULTIFIELD) { ReturnFact(theEnv,newFact); MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr); return; } /*=============================*/ /* Store the value in the slot */ /*=============================*/ newFact->theProposition.theFields[position].type = computeResult.type; newFact->theProposition.theFields[position].value = computeResult.value; } /*=================================*/ /* Else replace a multifield slot. */ /*=================================*/ else { /*======================================*/ /* Determine the new value of the slot. */ /*======================================*/ StoreInMultifield(theEnv,&computeResult,testPtr->argList,FALSE); SetEvaluationError(theEnv,FALSE); /*=============================*/ /* Store the value in the slot */ /*=============================*/ newFact->theProposition.theFields[position].type = computeResult.type; newFact->theProposition.theFields[position].value = computeResult.value; } testPtr = testPtr->nextArg; } /*=====================================*/ /* Copy the multifield values from the */ /* old fact that were not replaced. */ /*=====================================*/ for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++) { if ((newFact->theProposition.theFields[i].type == MULTIFIELD) && (newFact->theProposition.theFields[i].value == NULL)) { newFact->theProposition.theFields[i].value = CopyMultifield(theEnv,(struct multifield *) oldFact->theProposition.theFields[i].value); } } /*======================================*/ /* Perform the duplicate/modify action. */ /*======================================*/ if (retractIt) EnvRetract(theEnv,oldFact); theFact = (struct fact *) EnvAssert(theEnv,newFact); /*========================================*/ /* The asserted fact is the return value. */ /*========================================*/ if (theFact != NULL) { SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,theFact->theProposition.multifieldLength); SetpType(returnValue,FACT_ADDRESS); SetpValue(returnValue,(void *) theFact); } return; }
globle void BindFunction( DATA_OBJECT_PTR returnValue) { DATA_OBJECT *theBind, *lastBind; int found = FALSE, unbindVar = FALSE; SYMBOL_HN *variableName = NULL; #if DEFGLOBAL_CONSTRUCT struct defglobal *theGlobal = NULL; #endif /*===============================================*/ /* Determine the name of the variable to be set. */ /*===============================================*/ #if DEFGLOBAL_CONSTRUCT if (GetFirstArgument()->type == DEFGLOBAL_PTR) { theGlobal = (struct defglobal *) GetFirstArgument()->value; } else #endif { EvaluateExpression(GetFirstArgument(),returnValue); variableName = (SYMBOL_HN *) DOPToPointer(returnValue); } /*===========================================*/ /* Determine the new value for the variable. */ /*===========================================*/ if (GetFirstArgument()->nextArg == NULL) { unbindVar = TRUE; } else if (GetFirstArgument()->nextArg->nextArg == NULL) { EvaluateExpression(GetFirstArgument()->nextArg,returnValue); } else { StoreInMultifield(returnValue,GetFirstArgument()->nextArg,TRUE); } /*==================================*/ /* Bind a defglobal if appropriate. */ /*==================================*/ #if DEFGLOBAL_CONSTRUCT if (theGlobal != NULL) { QSetDefglobalValue(theGlobal,returnValue,unbindVar); return; } #endif /*===============================================*/ /* Search for the variable in the list of binds. */ /*===============================================*/ theBind = BindList; lastBind = NULL; while ((theBind != NULL) && (found == FALSE)) { if (theBind->supplementalInfo == (void *) variableName) { found = TRUE; } else { lastBind = theBind; theBind = theBind->next; } } /*========================================================*/ /* If variable was not in the list of binds, then add it. */ /* Make sure that this operation preserves the bind list */ /* as a stack. */ /*========================================================*/ if (found == FALSE) { if (unbindVar == FALSE) { theBind = get_struct(dataObject); theBind->supplementalInfo = (void *) variableName; theBind->next = NULL; if (lastBind == NULL) { BindList = theBind; } else { lastBind->next = theBind; } } else { returnValue->type = SYMBOL; returnValue->value = FalseSymbol; return; } } else { ValueDeinstall(theBind); } /*================================*/ /* Set the value of the variable. */ /*================================*/ if (unbindVar == FALSE) { theBind->type = returnValue->type; theBind->value = returnValue->value; theBind->begin = returnValue->begin; theBind->end = returnValue->end; ValueInstall(returnValue); } else { if (lastBind == NULL) BindList = theBind->next; else lastBind->next = theBind->next; rtn_struct(dataObject,theBind); returnValue->type = SYMBOL; returnValue->value = FalseSymbol; } }
globle void CreateFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { StoreInMultifield(theEnv,returnValue,GetFirstArgument(),TRUE); }