static intBool GetVariableDefinition( void *theEnv, char *readSource, int *defglobalError, int tokenRead, struct token *theToken) { SYMBOL_HN *variableName; struct expr *assignPtr; DATA_OBJECT assignValue; /*========================================*/ /* Get next token, which should either be */ /* a closing parenthesis or a variable. */ /*========================================*/ if (! tokenRead) GetToken(theEnv,readSource,theToken); if (theToken->type == RPAREN) return(FALSE); if (theToken->type == SF_VARIABLE) { SyntaxErrorMessage(theEnv,(char*)"defglobal"); *defglobalError = TRUE; return(FALSE); } else if (theToken->type != GBL_VARIABLE) { SyntaxErrorMessage(theEnv,(char*)"defglobal"); *defglobalError = TRUE; return(FALSE); } variableName = (SYMBOL_HN *) theToken->value; SavePPBuffer(theEnv,(char*)" "); /*================================*/ /* Print out compilation message. */ /*================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,(char*)"compilations") == ON) && GetPrintWhileLoading(theEnv)) { if (QFindDefglobal(theEnv,variableName) != NULL) { PrintWarningID(theEnv,(char*)"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,WDIALOG,(char*)"Redefining defglobal: "); } else EnvPrintRouter(theEnv,WDIALOG,(char*)"Defining defglobal: "); EnvPrintRouter(theEnv,WDIALOG,ValueToString(variableName)); EnvPrintRouter(theEnv,WDIALOG,(char*)"\n"); } else #endif { if (GetPrintWhileLoading(theEnv)) EnvPrintRouter(theEnv,WDIALOG,(char*)":"); } /*==================================================================*/ /* Check for import/export conflicts from the construct definition. */ /*==================================================================*/ #if DEFMODULE_CONSTRUCT if (FindImportExportConflict(theEnv,(char*)"defglobal",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(variableName))) { ImportExportConflictMessage(theEnv,(char*)"defglobal",ValueToString(variableName),NULL,NULL); *defglobalError = TRUE; return(FALSE); } #endif /*==============================*/ /* The next token must be an =. */ /*==============================*/ GetToken(theEnv,readSource,theToken); if (strcmp(theToken->printForm,"=") != 0) { SyntaxErrorMessage(theEnv,(char*)"defglobal"); *defglobalError = TRUE; return(FALSE); } SavePPBuffer(theEnv,(char*)" "); /*======================================================*/ /* Parse the expression to be assigned to the variable. */ /*======================================================*/ assignPtr = ParseAtomOrExpression(theEnv,readSource,NULL); if (assignPtr == NULL) { *defglobalError = TRUE; return(FALSE); } /*==========================*/ /* Evaluate the expression. */ /*==========================*/ if (! ConstructData(theEnv)->CheckSyntaxMode) { SetEvaluationError(theEnv,FALSE); if (EvaluateExpression(theEnv,assignPtr,&assignValue)) { ReturnExpression(theEnv,assignPtr); *defglobalError = TRUE; return(FALSE); } } else { ReturnExpression(theEnv,assignPtr); } SavePPBuffer(theEnv,(char*)")"); /*======================================*/ /* Add the variable to the global list. */ /*======================================*/ if (! ConstructData(theEnv)->CheckSyntaxMode) { AddDefglobal(theEnv,variableName,&assignValue,assignPtr); } /*==================================================*/ /* Return TRUE to indicate that the global variable */ /* definition was successfully parsed. */ /*==================================================*/ return(TRUE); }
globle unsigned long HashMultifield( struct multifield *theSegment, unsigned long theRange) { unsigned long length, i; unsigned long tvalue; unsigned long count; struct field *fieldPtr; union { double fv; void *vv; unsigned long liv; } fis; /*================================================*/ /* Initialize variables for computing hash value. */ /*================================================*/ count = 0; length = theSegment->multifieldLength; fieldPtr = theSegment->theFields; /*====================================================*/ /* Loop through each value in the multifield, compute */ /* its hash value, and add it to the running total. */ /*====================================================*/ for (i = 0; i < length; i++) { switch(fieldPtr[i].type) { case MULTIFIELD: count += HashMultifield((struct multifield *) fieldPtr[i].value,theRange); break; case FLOAT: fis.liv = 0; fis.fv = ValueToDouble(fieldPtr[i].value); count += (fis.liv * (i + 29)) + (unsigned long) ValueToDouble(fieldPtr[i].value); break; case INTEGER: count += (((unsigned long) ValueToLong(fieldPtr[i].value)) * (i + 29)) + ((unsigned long) ValueToLong(fieldPtr[i].value)); break; case FACT_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_ADDRESS: #endif fis.liv = 0; fis.vv = fieldPtr[i].value; count += (unsigned long) (fis.liv * (i + 29)); break; case EXTERNAL_ADDRESS: fis.liv = 0; fis.vv = ValueToExternalAddress(fieldPtr[i].value); count += (unsigned long) (fis.liv * (i + 29)); break; case SYMBOL: case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: #endif tvalue = (unsigned long) HashSymbol(ValueToString(fieldPtr[i].value),theRange); count += (unsigned long) (tvalue * (i + 29)); break; } } /*========================*/ /* Return the hash value. */ /*========================*/ return(count); }
void *GetFactOrInstanceArgument( void *theEnv, int thePosition, DATA_OBJECT *item, char *functionName) { void *ptr; /*==============================*/ /* Retrieve the first argument. */ /*==============================*/ EnvRtnUnknown(theEnv,thePosition,item); /*==================================================*/ /* Fact and instance addresses are valid arguments. */ /*==================================================*/ if ((GetpType(item) == FACT_ADDRESS) || (GetpType(item) == INSTANCE_ADDRESS)) { return(GetpValue(item)); } /*==================================================*/ /* An integer is a valid argument if it corresponds */ /* to the fact index of an existing fact. */ /*==================================================*/ #if DEFTEMPLATE_CONSTRUCT else if (GetpType(item) == INTEGER) { if ((ptr = (void *) FindIndexedFact(theEnv,DOPToLong(item))) == NULL) { char tempBuffer[20]; sprintf(tempBuffer,"f-%ld",DOPToLong(item)); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); } return(ptr); } #endif /*================================================*/ /* Instance names and symbols are valid arguments */ /* if they correspond to an existing instance. */ /*================================================*/ #if OBJECT_SYSTEM else if ((GetpType(item) == INSTANCE_NAME) || (GetpType(item) == SYMBOL)) { if ((ptr = (void *) FindInstanceBySymbol(theEnv,(SYMBOL_HN *) GetpValue(item))) == NULL) { CantFindItemErrorMessage(theEnv,"instance",ValueToString(GetpValue(item))); } return(ptr); } #endif /*========================================*/ /* Any other type is an invalid argument. */ /*========================================*/ ExpectedTypeError2(theEnv,functionName,thePosition); return(NULL); }
FString FAIDataProviderValue::ToString() const { return IsDynamic() ? DataBinding->ToString(DataField) : ValueToString(); }
static int FindConstructBeginning( void *theEnv, char *readSource, struct token *theToken, int errorCorrection, int *noErrors) { int leftParenthesisFound = FALSE; int firstAttempt = TRUE; /*===================================================*/ /* Process tokens until the beginning of a construct */ /* is found or there are no more tokens. */ /*===================================================*/ while (theToken->type != STOP) { /*=====================================================*/ /* Constructs begin with a left parenthesis. Make note */ /* that the opening parenthesis has been found. */ /*=====================================================*/ if (theToken->type == LPAREN) { leftParenthesisFound = TRUE; } /*=================================================================*/ /* The name of the construct follows the opening left parenthesis. */ /* If it is the name of a valid construct, then return TRUE. */ /* Otherwise, reset the flags to look for the beginning of a */ /* construct. If error correction is being performed (i.e. the */ /* last construct parsed had an error in it), then don't bother to */ /* print an error message, otherwise, print an error message. */ /*=================================================================*/ else if ((theToken->type == SYMBOL) && (leftParenthesisFound == TRUE)) { /*===========================================================*/ /* Is this a valid construct name (e.g., defrule, deffacts). */ /*===========================================================*/ if (FindConstruct(theEnv,ValueToString(theToken->value)) != NULL) return(TRUE); /*===============================================*/ /* The construct name is invalid. Print an error */ /* message if one hasn't already been printed. */ /*===============================================*/ if (firstAttempt && (! errorCorrection)) { errorCorrection = TRUE; *noErrors = FALSE; PrintErrorID(theEnv,"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Expected the beginning of a construct.\n"); } /*======================================================*/ /* Indicate that an error has been found and that we're */ /* looking for a left parenthesis again. */ /*======================================================*/ firstAttempt = FALSE; leftParenthesisFound = FALSE; } /*====================================================================*/ /* Any token encountered other than a left parenthesis or a construct */ /* name following a left parenthesis is illegal. Again, if error */ /* correction is in progress, no error message is printed, otherwise, */ /* an error message is printed. */ /*====================================================================*/ else { if (firstAttempt && (! errorCorrection)) { errorCorrection = TRUE; *noErrors = FALSE; PrintErrorID(theEnv,"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Expected the beginning of a construct.\n"); } firstAttempt = FALSE; leftParenthesisFound = FALSE; } /*============================================*/ /* Move on to the next token to be processed. */ /*============================================*/ GetToken(theEnv,readSource,theToken); } /*===================================================================*/ /* Couldn't find the beginning of a construct, so FALSE is returned. */ /*===================================================================*/ return(FALSE); }
/**************************************************** NAME : AddDeffunction DESCRIPTION : Adds a deffunction to the list of deffunctions INPUTS : 1) The symbolic name 2) The action expressions 3) The minimum number of arguments 4) The maximum number of arguments (can be -1) 5) The number of local variables 6) A flag indicating if this is a header call so that the deffunction can be recursively called RETURNS : The new deffunction (NULL on errors) SIDE EFFECTS : Deffunction structures allocated NOTES : Assumes deffunction is not executing ****************************************************/ static DEFFUNCTION *AddDeffunction( void *theEnv, SYMBOL_HN *name, EXPRESSION *actions, int min, int max, int lvars, int headerp) { DEFFUNCTION *dfuncPtr; unsigned oldbusy; #if DEBUGGING_FUNCTIONS unsigned DFHadWatch = FALSE; #else #if MAC_XCD #pragma unused(headerp) #endif #endif /*===============================================================*/ /* If the deffunction doesn't exist, create a new structure to */ /* contain it and add it to the List of deffunctions. Otherwise, */ /* use the existing structure and remove the pretty print form */ /* and interpretive code. */ /*===============================================================*/ dfuncPtr = (DEFFUNCTION *) EnvFindDeffunctionInModule(theEnv,ValueToString(name)); if (dfuncPtr == NULL) { dfuncPtr = get_struct(theEnv,deffunctionStruct); InitializeConstructHeader(theEnv,"deffunction",(struct constructHeader *) dfuncPtr,name); IncrementSymbolCount(name); dfuncPtr->code = NULL; dfuncPtr->minNumberOfParameters = min; dfuncPtr->maxNumberOfParameters = max; dfuncPtr->numberOfLocalVars = lvars; dfuncPtr->busy = 0; dfuncPtr->executing = 0; } else { #if DEBUGGING_FUNCTIONS DFHadWatch = EnvGetDeffunctionWatch(theEnv,(void *) dfuncPtr); #endif dfuncPtr->minNumberOfParameters = min; dfuncPtr->maxNumberOfParameters = max; dfuncPtr->numberOfLocalVars = lvars; oldbusy = dfuncPtr->busy; ExpressionDeinstall(theEnv,dfuncPtr->code); dfuncPtr->busy = oldbusy; ReturnPackedExpression(theEnv,dfuncPtr->code); dfuncPtr->code = NULL; EnvSetDeffunctionPPForm(theEnv,(void *) dfuncPtr,NULL); /* ======================================= Remove the deffunction from the list so that it can be added at the end ======================================= */ RemoveConstructFromModule(theEnv,(struct constructHeader *) dfuncPtr); } AddConstructToModule((struct constructHeader *) dfuncPtr); /* ================================== Install the new interpretive code. ================================== */ if (actions != NULL) { /* =============================== If a deffunction is recursive, do not increment its busy count based on self-references =============================== */ oldbusy = dfuncPtr->busy; ExpressionInstall(theEnv,actions); dfuncPtr->busy = oldbusy; dfuncPtr->code = actions; } /* =============================================================== Install the pretty print form if memory is not being conserved. =============================================================== */ #if DEBUGGING_FUNCTIONS EnvSetDeffunctionWatch(theEnv,DFHadWatch ? TRUE : DeffunctionData(theEnv)->WatchDeffunctions,(void *) dfuncPtr); if ((EnvGetConserveMemory(theEnv) == FALSE) && (headerp == FALSE)) EnvSetDeffunctionPPForm(theEnv,(void *) dfuncPtr,CopyPPBuffer(theEnv)); #endif return(dfuncPtr); }
// DECL: static Scene* load(const char* filePath); value hx_Scene_static_load(value filePath) { const char *_filePath = ValueToString(filePath); return ReferenceToValue(Scene::load(_filePath)); }
static struct templateSlot *ParseSlot( void *theEnv, char *readSource, struct token *inputToken, struct templateSlot *slotList) { int parsingMultislot; SYMBOL_HN *slotName; struct templateSlot *newSlot; int rv; /*=====================================================*/ /* Slots must begin with keyword field or multifield. */ /*=====================================================*/ if ((strcmp(ValueToString(inputToken->value),(char*)"field") != 0) && (strcmp(ValueToString(inputToken->value),(char*)"multifield") != 0) && (strcmp(ValueToString(inputToken->value),(char*)"slot") != 0) && (strcmp(ValueToString(inputToken->value),(char*)"multislot") != 0)) { SyntaxErrorMessage(theEnv,(char*)"deftemplate"); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*===============================================*/ /* Determine if multifield slot is being parsed. */ /*===============================================*/ if ((strcmp(ValueToString(inputToken->value),(char*)"multifield") == 0) || (strcmp(ValueToString(inputToken->value),(char*)"multislot") == 0)) { parsingMultislot = TRUE; } else { parsingMultislot = FALSE; } /*========================================*/ /* The name of the slot must be a symbol. */ /*========================================*/ SavePPBuffer(theEnv,(char*)" "); GetToken(theEnv,readSource,inputToken); if (inputToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,(char*)"deftemplate"); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } slotName = (SYMBOL_HN *) inputToken->value; /*================================================*/ /* Determine if the slot has already been parsed. */ /*================================================*/ while (slotList != NULL) { if (slotList->slotName == slotName) { AlreadyParsedErrorMessage(theEnv,(char*)"slot ",ValueToString(slotList->slotName)); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } slotList = slotList->next; } /*===================================*/ /* Parse the attributes of the slot. */ /*===================================*/ newSlot = DefinedSlots(theEnv,readSource,slotName,parsingMultislot,inputToken); if (newSlot == NULL) { DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*=================================*/ /* Check for slot conflict errors. */ /*=================================*/ if (CheckConstraintParseConflicts(theEnv,newSlot->constraints) == FALSE) { ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } if ((newSlot->defaultPresent) || (newSlot->defaultDynamic)) { rv = ConstraintCheckExpressionChain(theEnv,newSlot->defaultList,newSlot->constraints); } else { rv = NO_VIOLATION; } if ((rv != NO_VIOLATION) && EnvGetStaticConstraintChecking(theEnv)) { char *temp; if (newSlot->defaultDynamic) temp = (char*)"the default-dynamic attribute"; else temp = (char*)"the default attribute"; ConstraintViolationErrorMessage(theEnv,(char*)"An expression",temp,FALSE,0, newSlot->slotName,0,rv,newSlot->constraints,TRUE); ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*==================*/ /* Return the slot. */ /*==================*/ return(newSlot); }
static struct templateSlot *DefinedSlots( void *theEnv, char *readSource, SYMBOL_HN *slotName, int multifieldSlot, struct token *inputToken) { struct templateSlot *newSlot; struct expr *defaultList; int defaultFound = FALSE; int noneSpecified, deriveSpecified; CONSTRAINT_PARSE_RECORD parsedConstraints; /*===========================*/ /* Build the slot container. */ /*===========================*/ newSlot = get_struct(theEnv,templateSlot); newSlot->slotName = slotName; newSlot->defaultList = NULL; newSlot->facetList = NULL; newSlot->constraints = GetConstraintRecord(theEnv); if (multifieldSlot) { newSlot->constraints->multifieldsAllowed = TRUE; } newSlot->multislot = multifieldSlot; newSlot->noDefault = FALSE; newSlot->defaultPresent = FALSE; newSlot->defaultDynamic = FALSE; newSlot->next = NULL; /*========================================*/ /* Parse the primitive slot if it exists. */ /*========================================*/ InitializeConstraintParseRecord(&parsedConstraints); GetToken(theEnv,readSource,inputToken); while (inputToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv,(char*)" "); SavePPBuffer(theEnv,inputToken->printForm); /*================================================*/ /* Slot attributes begin with a left parenthesis. */ /*================================================*/ if (inputToken->type != LPAREN) { SyntaxErrorMessage(theEnv,(char*)"deftemplate"); ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*=============================================*/ /* The name of the attribute must be a symbol. */ /*=============================================*/ GetToken(theEnv,readSource,inputToken); if (inputToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,(char*)"deftemplate"); ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*================================================================*/ /* Determine if the attribute is one of the standard constraints. */ /*================================================================*/ if (StandardConstraint(ValueToString(inputToken->value))) { if (ParseStandardConstraint(theEnv,readSource,(ValueToString(inputToken->value)), newSlot->constraints,&parsedConstraints, multifieldSlot) == FALSE) { DeftemplateData(theEnv)->DeftemplateError = TRUE; ReturnSlots(theEnv,newSlot); return(NULL); } } /*=================================================*/ /* else if the attribute is the default attribute, */ /* then get the default list for this slot. */ /*=================================================*/ else if ((strcmp(ValueToString(inputToken->value),"default") == 0) || (strcmp(ValueToString(inputToken->value),"default-dynamic") == 0)) { /*======================================================*/ /* Check to see if the default has already been parsed. */ /*======================================================*/ if (defaultFound) { AlreadyParsedErrorMessage(theEnv,(char*)"default attribute",NULL); DeftemplateData(theEnv)->DeftemplateError = TRUE; ReturnSlots(theEnv,newSlot); return(NULL); } newSlot->noDefault = FALSE; /*=====================================================*/ /* Determine whether the default is dynamic or static. */ /*=====================================================*/ if (strcmp(ValueToString(inputToken->value),"default") == 0) { newSlot->defaultPresent = TRUE; newSlot->defaultDynamic = FALSE; } else { newSlot->defaultPresent = FALSE; newSlot->defaultDynamic = TRUE; } /*===================================*/ /* Parse the list of default values. */ /*===================================*/ defaultList = ParseDefault(theEnv,readSource,multifieldSlot,(int) newSlot->defaultDynamic, TRUE,&noneSpecified,&deriveSpecified,&DeftemplateData(theEnv)->DeftemplateError); if (DeftemplateData(theEnv)->DeftemplateError == TRUE) { ReturnSlots(theEnv,newSlot); return(NULL); } /*==================================*/ /* Store the default with the slot. */ /*==================================*/ defaultFound = TRUE; if (deriveSpecified) newSlot->defaultPresent = FALSE; else if (noneSpecified) { newSlot->noDefault = TRUE; newSlot->defaultPresent = FALSE; } newSlot->defaultList = defaultList; } /*===============================================*/ /* else if the attribute is the facet attribute. */ /*===============================================*/ else if (strcmp(ValueToString(inputToken->value),"facet") == 0) { if (! ParseFacetAttribute(theEnv,readSource,newSlot,FALSE)) { ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } } else if (strcmp(ValueToString(inputToken->value),"multifacet") == 0) { if (! ParseFacetAttribute(theEnv,readSource,newSlot,TRUE)) { ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } } /*============================================*/ /* Otherwise the attribute is an invalid one. */ /*============================================*/ else { SyntaxErrorMessage(theEnv,(char*)("slot attributes")); ReturnSlots(theEnv,newSlot); DeftemplateData(theEnv)->DeftemplateError = TRUE; return(NULL); } /*===================================*/ /* Begin parsing the next attribute. */ /*===================================*/ GetToken(theEnv,readSource,inputToken); } /*============================*/ /* Return the attribute list. */ /*============================*/ return(newSlot); }
/***************************************************** NAME : PerformMessage DESCRIPTION : Calls core framework for a message INPUTS : 1) Caller's result buffer 2) Message argument expressions (including implicit object) 3) Message name RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of message execution and caller's result buffer set NOTES : None *****************************************************/ static void PerformMessage( DATA_OBJECT *result, EXPRESSION *args, SYMBOL_HN *mname) { int oldce; HANDLER_LINK *oldCore; DEFCLASS *cls = NULL; INSTANCE_TYPE *ins = NULL; SYMBOL_HN *oldName; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif result->type = SYMBOL; result->value = FalseSymbol; EvaluationError = FALSE; if (HaltExecution) return; oldce = ExecutingConstruct(); SetExecutingConstruct(TRUE); oldName = CurrentMessageName; CurrentMessageName = mname; CurrentEvaluationDepth++; PushProcParameters(args,CountArguments(args), ValueToString(CurrentMessageName),"message", UnboundHandlerErr); if (EvaluationError) { CurrentEvaluationDepth--; CurrentMessageName = oldName; PeriodicCleanup(FALSE,TRUE); SetExecutingConstruct(oldce); return; } if (ProcParamArray->type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) ProcParamArray->value; if (ins->garbage == 1) { StaleInstanceAddress("send",0); SetEvaluationError(TRUE); } else if (DefclassInScope(ins->cls,(struct defmodule *) GetCurrentModule()) == FALSE) NoInstanceError(ValueToString(ins->name),"send"); else { cls = ins->cls; ins->busy++; } } else if (ProcParamArray->type == INSTANCE_NAME) { ins = FindInstanceBySymbol((SYMBOL_HN *) ProcParamArray->value); if (ins == NULL) { PrintErrorID("MSGPASS",2,FALSE); PrintRouter(WERROR,"No such instance "); PrintRouter(WERROR,ValueToString((SYMBOL_HN *) ProcParamArray->value)); PrintRouter(WERROR," in function send.\n"); SetEvaluationError(TRUE); } else { ProcParamArray->value = (void *) ins; ProcParamArray->type = INSTANCE_ADDRESS; cls = ins->cls; ins->busy++; } } else if ((cls = PrimitiveClassMap[ProcParamArray->type]) == NULL) { SystemError("MSGPASS",1); ExitRouter(EXIT_FAILURE); } if (EvaluationError) { PopProcParameters(); CurrentEvaluationDepth--; CurrentMessageName = oldName; PeriodicCleanup(FALSE,TRUE); SetExecutingConstruct(oldce); return; } oldCore = TopOfCore; TopOfCore = FindApplicableHandlers(cls,mname); if (TopOfCore != NULL) { HANDLER_LINK *oldCurrent,*oldNext; oldCurrent = CurrentCore; oldNext = NextInCore; #if IMPERATIVE_MESSAGE_HANDLERS if (TopOfCore->hnd->type == MAROUND) { CurrentCore = TopOfCore; NextInCore = TopOfCore->nxt; #if DEBUGGING_FUNCTIONS if (WatchMessages) WatchMessage(WTRACE,BEGIN_TRACE); if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount()) { #if PROFILING_FUNCTIONS StartProfile(&profileFrame, &CurrentCore->hnd->usrData, ProfileConstructs); #endif EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule, CurrentCore->hnd->actions, CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,END_TRACE); if (WatchMessages) WatchMessage(WTRACE,END_TRACE); #endif } else #endif /* IMPERATIVE_MESSAGE_HANDLERS */ { CurrentCore = NULL; NextInCore = TopOfCore; #if DEBUGGING_FUNCTIONS if (WatchMessages) WatchMessage(WTRACE,BEGIN_TRACE); #endif CallHandlers(result); #if DEBUGGING_FUNCTIONS if (WatchMessages) WatchMessage(WTRACE,END_TRACE); #endif } DestroyHandlerLinks(TopOfCore); CurrentCore = oldCurrent; NextInCore = oldNext; } TopOfCore = oldCore; ReturnFlag = FALSE; if (ins != NULL) ins->busy--; /* ================================== Restore the original calling frame ================================== */ PopProcParameters(); CurrentEvaluationDepth--; CurrentMessageName = oldName; PropagateReturnValue(result); PeriodicCleanup(FALSE,TRUE); SetExecutingConstruct(oldce); if (EvaluationError) { result->type = SYMBOL; result->value = FalseSymbol; } }
globle void PrintAtom( void *theEnv, char *logicalName, int type, void *value) { 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 EXTERNAL_ADDRESS: if (PrintUtilityData(theEnv)->AddressesToStrings) EnvPrintRouter(theEnv,logicalName,"\""); EnvPrintRouter(theEnv,logicalName,"<Pointer-"); sprintf(buffer,"%p",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; } }
/*************************************************** NAME : HandlerSlotPutFunction DESCRIPTION : Access function for handling the statically-bound direct slot bindings in message-handlers INPUTS : 1) The bitmap expression 2) A data object buffer RETURNS : TRUE if OK, FALSE on errors SIDE EFFECTS : Data object buffer gets symbol TRUE and slot is set. On errors, buffer gets symbol FALSE, EvaluationError is set and error messages are printed NOTES : It is possible for a handler (attached to a superclass of the currently active instance) containing these static references to be called for an instance which does not contain the slots (e.g., an instance of a subclass where the original slot was no-inherit or the subclass overrode the original slot) ***************************************************/ globle BOOLEAN HandlerSlotPutFunction( void *theValue, DATA_OBJECT *theResult) { HANDLER_SLOT_REFERENCE *theReference; DEFCLASS *theDefclass; INSTANCE_TYPE *theInstance; INSTANCE_SLOT *sp; unsigned instanceSlotIndex; DATA_OBJECT theSetVal; theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue); theInstance = (INSTANCE_TYPE *) ProcParamArray[0].value; theDefclass = ClassIDMap[theReference->classID]; if (theInstance->garbage) { StaleInstanceAddress("for slot put",0); theResult->type = SYMBOL; theResult->value = FalseSymbol; SetEvaluationError(TRUE); return(FALSE); } if (theInstance->cls == theDefclass) { instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID]; sp = theInstance->slotAddresses[instanceSlotIndex - 1]; } else { if (theReference->slotID > theInstance->cls->maxSlotNameID) goto HandlerPutError; instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID]; if (instanceSlotIndex == 0) goto HandlerPutError; instanceSlotIndex--; sp = theInstance->slotAddresses[instanceSlotIndex]; if (sp->desc->cls != theDefclass) goto HandlerPutError; } /* ======================================================= The slot has already been verified not to be read-only. However, if it is initialize-only, we need to make sure that we are initializing the instance (something we could not verify at parse-time) ======================================================= */ if (sp->desc->initializeOnly && (!theInstance->initializeInProgress)) { SlotAccessViolationError(ValueToString(sp->desc->slotName->name), TRUE,(void *) theInstance); goto HandlerPutError2; } /* ====================================== No arguments means to use the special NoParamValue to reset the slot to its default value ====================================== */ if (GetFirstArgument()) { if (EvaluateAndStoreInDataObject((int) sp->desc->multiple, GetFirstArgument(),&theSetVal) == FALSE) goto HandlerPutError2; } else { SetDOBegin(theSetVal,1); SetDOEnd(theSetVal,0); SetType(theSetVal,MULTIFIELD); SetValue(theSetVal,NoParamValue); } if (PutSlotValue(theInstance,sp,&theSetVal,theResult,NULL) == FALSE) goto HandlerPutError2; return(TRUE); HandlerPutError: EarlySlotBindError(theInstance,theDefclass,theReference->slotID); HandlerPutError2: theResult->type = SYMBOL; theResult->value = FalseSymbol; SetEvaluationError(TRUE); return(FALSE); }
/******************************************************** NAME : CallNextHandler DESCRIPTION : This function allows around-handlers to execute the rest of the core frame. It also allows primary handlers to execute shadowed primaries. The original handler arguments are left intact. INPUTS : The caller's result-value buffer RETURNS : Nothing useful SIDE EFFECTS : The core frame is called and any appropriate changes are made when used in an around handler See CallHandlers() But when call-next-handler is called from a primary, the same shadowed primary is called over and over again for repeated calls to call-next-handler. NOTES : H/L Syntax: (call-next-handler) OR (override-next-handler <arg> ...) ********************************************************/ globle void CallNextHandler( DATA_OBJECT *result) { EXPRESSION args; int overridep; HANDLER_LINK *oldNext,*oldCurrent; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif SetpType(result,SYMBOL); SetpValue(result,FalseSymbol); EvaluationError = FALSE; if (HaltExecution) return; if (NextHandlerAvailable() == FALSE) { PrintErrorID("MSGPASS",1,FALSE); PrintRouter(WERROR,"Shadowed message-handlers not applicable in current context.\n"); SetEvaluationError(TRUE); return; } if (CurrentExpression->value == (void *) FindFunction("override-next-handler")) { overridep = 1; args.type = (short) ProcParamArray[0].type; if (args.type != MULTIFIELD) args.value = (void *) ProcParamArray[0].value; else args.value = (void *) &ProcParamArray[0]; args.nextArg = GetFirstArgument(); args.argList = NULL; PushProcParameters(&args,CountArguments(&args), ValueToString(CurrentMessageName),"message", UnboundHandlerErr); if (EvaluationError) { ReturnFlag = FALSE; return; } } else overridep = 0; oldNext = NextInCore; oldCurrent = CurrentCore; if (CurrentCore->hnd->type == MAROUND) { if (NextInCore->hnd->type == MAROUND) { CurrentCore = NextInCore; NextInCore = NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount()) { #if PROFILING_FUNCTIONS StartProfile(&profileFrame, &CurrentCore->hnd->usrData, ProfileConstructs); #endif EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule, CurrentCore->hnd->actions, CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,END_TRACE); #endif } else CallHandlers(result); } else { CurrentCore = NextInCore; NextInCore = NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount()) { #if PROFILING_FUNCTIONS StartProfile(&profileFrame, &CurrentCore->hnd->usrData, ProfileConstructs); #endif EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule, CurrentCore->hnd->actions, CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,END_TRACE); #endif } NextInCore = oldNext; CurrentCore = oldCurrent; if (overridep) PopProcParameters(); ReturnFlag = FALSE; }
globle intBool ParseDefglobal( void *theEnv, char *readSource) { int defglobalError = FALSE; #if (MAC_MCW || WIN_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(theEnv,readSource) #endif #if (! RUN_TIME) && (! BLOAD_ONLY) struct token theToken; int tokenRead = TRUE; struct defmodule *theModule; /*=====================================*/ /* Pretty print buffer initialization. */ /*=====================================*/ SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,(char*)"(defglobal "); /*=================================================*/ /* Individual defglobal constructs can't be parsed */ /* while a binary load is in effect. */ /*=================================================*/ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,(char*)"defglobal"); return(TRUE); } #endif /*===========================*/ /* Look for the module name. */ /*===========================*/ GetToken(theEnv,readSource,&theToken); if (theToken.type == SYMBOL) { /*=================================================*/ /* The optional module name can't contain a module */ /* separator like other constructs. For example, */ /* (defrule X::foo is OK for rules, but the right */ /* syntax for defglobals is (defglobal X ?*foo*. */ /*=================================================*/ tokenRead = FALSE; if (FindModuleSeparator(ValueToString(theToken.value))) { SyntaxErrorMessage(theEnv,(char*)"defglobal"); return(TRUE); } /*=================================*/ /* Determine if the module exists. */ /*=================================*/ theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theToken.value)); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,(char*)"defmodule",ValueToString(theToken.value)); return(TRUE); } /*=========================================*/ /* If the module name was OK, then set the */ /* current module to the specified module. */ /*=========================================*/ SavePPBuffer(theEnv,(char*)" "); EnvSetCurrentModule(theEnv,(void *) theModule); } /*===========================================*/ /* If the module name wasn't specified, then */ /* use the current module's name in the */ /* defglobal's pretty print representation. */ /*===========================================*/ else { PPBackup(theEnv); SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)))); SavePPBuffer(theEnv,(char*)" "); SavePPBuffer(theEnv,theToken.printForm); } /*======================*/ /* Parse the variables. */ /*======================*/ while (GetVariableDefinition(theEnv,readSource,&defglobalError,tokenRead,&theToken)) { tokenRead = FALSE; FlushPPBuffer(theEnv); SavePPBuffer(theEnv,(char*)"(defglobal "); SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)))); SavePPBuffer(theEnv,(char*)" "); } #endif /*==================================*/ /* Return the parsing error status. */ /*==================================*/ return(defglobalError); }
/*********************************************************************** NAME : ParseDefmessageHandler DESCRIPTION : Parses a message-handler for a class of objects INPUTS : The logical name of the input source RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Handler allocated and inserted into class NOTES : H/L Syntax: (defmessage-handler <class> <name> [<type>] [<comment>] (<params>) <action>*) <params> ::= <var>* | <var>* $?<name> ***********************************************************************/ globle int ParseDefmessageHandler( void *theEnv, char *readSource) { DEFCLASS *cls; SYMBOL_HN *cname,*mname,*wildcard; unsigned mtype = MPRIMARY; int min,max,error,lvars; EXPRESSION *hndParams,*actions; HANDLER *hnd; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defmessage-handler "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defmessage-handler"); return(TRUE); } #endif cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defmessage-handler", NULL,NULL,"~",TRUE,FALSE,DEFMODULE_CONSTRUCT); if (cname == NULL) return(TRUE); cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(cname)); if (cls == NULL) { PrintErrorID(theEnv,"MSGPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"A class must be defined before its message-handlers.\n"); return(TRUE); } if ((cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) || (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) || (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0])) { PrintErrorID(theEnv,"MSGPSR",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Message-handlers cannot be attached to the class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls)); EnvPrintRouter(theEnv,WERROR,".\n"); return(TRUE); } if (HandlersExecuting(cls)) { PrintErrorID(theEnv,"MSGPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot (re)define message-handlers during execution of \n"); EnvPrintRouter(theEnv,WERROR," other message-handlers for the same class.\n"); return(TRUE); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defmessage-handler"); return(TRUE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv," "); mname = (SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SavePPBuffer(theEnv," "); if (GetType(DefclassData(theEnv)->ObjectParseToken) != STRING) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defmessage-handler"); return(TRUE); } mtype = HandlerType(theEnv,"defmessage-handler",DOToString(DefclassData(theEnv)->ObjectParseToken)); if (mtype == MERROR) return(TRUE); #if ! IMPERATIVE_MESSAGE_HANDLERS if (mtype == MAROUND) return(TRUE); #endif GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING) { SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } } else { SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } } PPBackup(theEnv); PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); hnd = FindHandlerByAddress(cls,mname,mtype); if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv)) { EnvPrintRouter(theEnv,WDIALOG," Handler "); EnvPrintRouter(theEnv,WDIALOG,ValueToString(mname)); EnvPrintRouter(theEnv,WDIALOG," "); EnvPrintRouter(theEnv,WDIALOG,MessageHandlerData(theEnv)->hndquals[mtype]); EnvPrintRouter(theEnv,WDIALOG,(char *) ((hnd == NULL) ? " defined.\n" : " redefined.\n")); } if ((hnd != NULL) ? hnd->system : FALSE) { PrintErrorID(theEnv,"MSGPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n"); return(TRUE); } hndParams = GenConstant(theEnv,SYMBOL,(void *) MessageHandlerData(theEnv)->SELF_SYMBOL); hndParams = ParseProcParameters(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,hndParams, &wildcard,&min,&max,&error,IsParameterSlotReference); if (error) return(TRUE); PPCRAndIndent(theEnv); ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseProcActions(theEnv,"message-handler",readSource, &DefclassData(theEnv)->ObjectParseToken,hndParams,wildcard, SlotReferenceVar,BindSlotReference,&lvars, (void *) cls); if (actions == NULL) { ReturnExpression(theEnv,hndParams); return(TRUE); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,"defmessage-handler"); ReturnExpression(theEnv,hndParams); ReturnPackedExpression(theEnv,actions); return(TRUE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv,"\n"); /* =================================================== If we're only checking syntax, don't add the successfully parsed defmessage-handler to the KB. =================================================== */ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,hndParams); ReturnPackedExpression(theEnv,actions); return(FALSE); } if (hnd != NULL) { ExpressionDeinstall(theEnv,hnd->actions); ReturnPackedExpression(theEnv,hnd->actions); if (hnd->ppForm != NULL) rm(theEnv,(void *) hnd->ppForm, (sizeof(char) * (strlen(hnd->ppForm)+1))); } else { hnd = InsertHandlerHeader(theEnv,cls,mname,(int) mtype); IncrementSymbolCount(hnd->name); } ReturnExpression(theEnv,hndParams); hnd->minParams = min; hnd->maxParams = max; hnd->localVarCount = lvars; hnd->actions = actions; ExpressionInstall(theEnv,hnd->actions); #if DEBUGGING_FUNCTIONS /* =================================================== Old handler trace status is automatically preserved =================================================== */ if (EnvGetConserveMemory(theEnv) == FALSE) hnd->ppForm = CopyPPBuffer(theEnv); else #endif hnd->ppForm = NULL; return(FALSE); }
static intBool ParseFacetAttribute( void *theEnv, char *readSource, struct templateSlot *theSlot, intBool multifacet) { struct token inputToken; SYMBOL_HN *facetName; struct expr *facetPair, *tempFacet, *facetValue = NULL, *lastValue = NULL; /*==============================*/ /* Parse the name of the facet. */ /*==============================*/ SavePPBuffer(theEnv,(char*)(" ")); GetToken(theEnv,readSource,&inputToken); /*==================================*/ /* The facet name must be a symbol. */ /*==================================*/ if (inputToken.type != SYMBOL) { if (multifacet) SyntaxErrorMessage(theEnv,(char*)("multifacet attribute")); else SyntaxErrorMessage(theEnv,(char*)("facet attribute")); return(FALSE); } facetName = (SYMBOL_HN *) inputToken.value; /*===================================*/ /* Don't allow facets with the same */ /* name as a predefined CLIPS facet. */ /*===================================*/ /*====================================*/ /* Has the facet already been parsed? */ /*====================================*/ for (tempFacet = theSlot->facetList; tempFacet != NULL; tempFacet = tempFacet->nextArg) { if (tempFacet->value == facetName) { if (multifacet) AlreadyParsedErrorMessage(theEnv,(char*)("multifacet "),ValueToString(facetName)); else AlreadyParsedErrorMessage(theEnv,(char*)("facet "),ValueToString(facetName)); return(FALSE); } } /*===============================*/ /* Parse the value of the facet. */ /*===============================*/ SavePPBuffer(theEnv,(char*)(" ")); GetToken(theEnv,readSource,&inputToken); while (inputToken.type != RPAREN) { /*=====================================*/ /* The facet value must be a constant. */ /*=====================================*/ if (! ConstantType(inputToken.type)) { if (multifacet) SyntaxErrorMessage(theEnv, (char*)("multifacet attribute")); else SyntaxErrorMessage(theEnv, (char*)("facet attribute")); ReturnExpression(theEnv,facetValue); return(FALSE); } /*======================================*/ /* Add the value to the list of values. */ /*======================================*/ if (lastValue == NULL) { facetValue = GenConstant(theEnv,inputToken.type,inputToken.value); lastValue = facetValue; } else { lastValue->nextArg = GenConstant(theEnv,inputToken.type,inputToken.value); lastValue = lastValue->nextArg; } /*=====================*/ /* Get the next token. */ /*=====================*/ SavePPBuffer(theEnv,(char*)(" ")); GetToken(theEnv,readSource,&inputToken); /*===============================================*/ /* A facet can't contain more than one constant. */ /*===============================================*/ if ((! multifacet) && (inputToken.type != RPAREN)) { SyntaxErrorMessage(theEnv,(char*)("facet attribute")); ReturnExpression(theEnv,facetValue); return(FALSE); } } /*========================================================*/ /* Remove the space before the closing right parenthesis. */ /*========================================================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,(char*)(")")); /*====================================*/ /* A facet must contain one constant. */ /*====================================*/ if ((! multifacet) && (facetValue == NULL)) { SyntaxErrorMessage(theEnv,(char*)("facet attribute")); return(FALSE); } /*=================================================*/ /* Add the facet to the list of the slot's facets. */ /*=================================================*/ facetPair = GenConstant(theEnv,SYMBOL,facetName); if (multifacet) { facetPair->argList = GenConstant(theEnv,FCALL, (void *) FindFunction(theEnv,(char*)("create$"))); facetPair->argList->argList = facetValue; } else { facetPair->argList = facetValue; } facetPair->nextArg = theSlot->facetList; theSlot->facetList = facetPair; /*===============================================*/ /* The facet/multifacet was successfully parsed. */ /*===============================================*/ return(TRUE); }
/*************************************************************************** NAME : ParseDeffunction DESCRIPTION : Parses the deffunction construct INPUTS : The input logical name RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Creates valid deffunction definition NOTES : H/L Syntax : (deffunction <name> [<comment>] (<single-field-varible>* [<multifield-variable>]) <action>*) ***************************************************************************/ globle intBool ParseDeffunction( void *theEnv, const char *readSource) { SYMBOL_HN *deffunctionName; EXPRESSION *actions; EXPRESSION *parameterList; SYMBOL_HN *wildcard; int min,max,lvars,DeffunctionError = FALSE; short overwrite = FALSE, owMin = 0, owMax = 0; DEFFUNCTION *dptr; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(deffunction "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"deffunctions"); return(TRUE); } #endif /* ===================================================== Parse the name and comment fields of the deffunction. ===================================================== */ deffunctionName = GetConstructNameAndComment(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,"deffunction", EnvFindDeffunctionInModule,NULL, "!",TRUE,TRUE,TRUE,FALSE); if (deffunctionName == NULL) return(TRUE); if (ValidDeffunctionName(theEnv,ValueToString(deffunctionName)) == FALSE) return(TRUE); /*==========================*/ /* Parse the argument list. */ /*==========================*/ parameterList = ParseProcParameters(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,NULL,&wildcard, &min,&max,&DeffunctionError,NULL); if (DeffunctionError) return(TRUE); /*===================================================================*/ /* Go ahead and add the deffunction so it can be recursively called. */ /*===================================================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { dptr = (DEFFUNCTION *) EnvFindDeffunctionInModule(theEnv,ValueToString(deffunctionName)); if (dptr == NULL) { dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); } else { overwrite = TRUE; owMin = (short) dptr->minNumberOfParameters; owMax = (short) dptr->maxNumberOfParameters; dptr->minNumberOfParameters = min; dptr->maxNumberOfParameters = max; } } else { dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); } if (dptr == NULL) { ReturnExpression(theEnv,parameterList); return(TRUE); } /*==================================================*/ /* Parse the actions contained within the function. */ /*==================================================*/ PPCRAndIndent(theEnv); ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseProcActions(theEnv,"deffunction",readSource, &DeffunctionData(theEnv)->DFInputToken,parameterList,wildcard, NULL,NULL,&lvars,NULL); /*=============================================================*/ /* Check for the closing right parenthesis of the deffunction. */ /*=============================================================*/ if ((DeffunctionData(theEnv)->DFInputToken.type != RPAREN) && /* DR0872 */ (actions != NULL)) { SyntaxErrorMessage(theEnv,"deffunction"); ReturnExpression(theEnv,parameterList); ReturnPackedExpression(theEnv,actions); if (overwrite) { dptr->minNumberOfParameters = owMin; dptr->maxNumberOfParameters = owMax; } if ((dptr->busy == 0) && (! overwrite)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDeffunction(theEnv,dptr); } return(TRUE); } if (actions == NULL) { ReturnExpression(theEnv,parameterList); if (overwrite) { dptr->minNumberOfParameters = owMin; dptr->maxNumberOfParameters = owMax; } if ((dptr->busy == 0) && (! overwrite)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDeffunction(theEnv,dptr); } return(TRUE); } /*==============================================*/ /* If we're only checking syntax, don't add the */ /* successfully parsed deffunction to the KB. */ /*==============================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,parameterList); ReturnPackedExpression(theEnv,actions); if (overwrite) { dptr->minNumberOfParameters = owMin; dptr->maxNumberOfParameters = owMax; } else { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDeffunction(theEnv,dptr); } return(FALSE); } /*=============================*/ /* Reformat the closing token. */ /*=============================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DeffunctionData(theEnv)->DFInputToken.printForm); SavePPBuffer(theEnv,"\n"); /*======================*/ /* Add the deffunction. */ /*======================*/ AddDeffunction(theEnv,deffunctionName,actions,min,max,lvars,FALSE); ReturnExpression(theEnv,parameterList); return(DeffunctionError); }
globle int ParseDeftemplate( void *theEnv, char *readSource) { #if (! RUN_TIME) && (! BLOAD_ONLY) SYMBOL_HN *deftemplateName; struct deftemplate *newDeftemplate; struct templateSlot *slots; struct token inputToken; /*================================================*/ /* Initialize pretty print and error information. */ /*================================================*/ DeftemplateData(theEnv)->DeftemplateError = FALSE; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SavePPBuffer(theEnv,(char*)"(deftemplate "); /*==============================================================*/ /* Deftemplates can not be added when a binary image is loaded. */ /*==============================================================*/ #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,(char*)("deftemplate")); return(TRUE); } #endif /*=======================================================*/ /* Parse the name and comment fields of the deftemplate. */ /*=======================================================*/ #if DEBUGGING_FUNCTIONS DeftemplateData(theEnv)->DeletedTemplateDebugFlags = 0; #endif deftemplateName = GetConstructNameAndComment(theEnv,readSource,&inputToken,(char*)("deftemplate"), EnvFindDeftemplate,EnvUndeftemplate,(char*)("%"), TRUE,TRUE,TRUE); if (deftemplateName == NULL) return(TRUE); if (ReservedPatternSymbol(theEnv,ValueToString(deftemplateName),(char*)("deftemplate"))) { ReservedPatternSymbolErrorMsg(theEnv,ValueToString(deftemplateName), (char*)("a deftemplate name")); return(TRUE); } /*===========================================*/ /* Parse the slot fields of the deftemplate. */ /*===========================================*/ slots = SlotDeclarations(theEnv,readSource,&inputToken); if (DeftemplateData(theEnv)->DeftemplateError == TRUE) return(TRUE); /*==============================================*/ /* If we're only checking syntax, don't add the */ /* successfully parsed deftemplate to the KB. */ /*==============================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnSlots(theEnv,slots); return(FALSE); } /*=====================================*/ /* Create a new deftemplate structure. */ /*=====================================*/ newDeftemplate = get_struct(theEnv,deftemplate); newDeftemplate->header.name = deftemplateName; newDeftemplate->header.next = NULL; newDeftemplate->header.usrData = NULL; newDeftemplate->slotList = slots; newDeftemplate->implied = FALSE; newDeftemplate->numberOfSlots = 0; newDeftemplate->busyCount = 0; newDeftemplate->watch = 0; newDeftemplate->inScope = TRUE; newDeftemplate->patternNetwork = NULL; newDeftemplate->factList = NULL; newDeftemplate->lastFact = NULL; newDeftemplate->header.whichModule = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,DeftemplateData(theEnv)->DeftemplateModuleIndex); /*================================*/ /* Determine the number of slots. */ /*================================*/ while (slots != NULL) { newDeftemplate->numberOfSlots++; slots = slots->next; } /*====================================*/ /* Store pretty print representation. */ /*====================================*/ if (EnvGetConserveMemory(theEnv) == TRUE) { newDeftemplate->header.ppForm = NULL; } else { newDeftemplate->header.ppForm = CopyPPBuffer(theEnv); } /*=======================================================================*/ /* If a template is redefined, then we want to restore its watch status. */ /*=======================================================================*/ #if DEBUGGING_FUNCTIONS if ((BitwiseTest(DeftemplateData(theEnv)->DeletedTemplateDebugFlags,0)) || EnvGetWatchItem(theEnv,(char*)"facts")) { EnvSetDeftemplateWatch(theEnv,ON,(void *) newDeftemplate); } #endif /*==============================================*/ /* Add deftemplate to the list of deftemplates. */ /*==============================================*/ AddConstructToModule(&newDeftemplate->header); InstallDeftemplate(theEnv,newDeftemplate); #else #endif return(FALSE); }
static struct lhsParseNode *LiteralRestrictionParse( void *theEnv, char *readSource, struct token *theToken, int *error) { struct lhsParseNode *topNode; struct expr *theExpression; /*============================================*/ /* Create a node to represent the constraint. */ /*============================================*/ topNode = GetLHSParseNode(theEnv); /*=================================================*/ /* Determine if the constraint has a '~' preceding */ /* it. If it does, then the field is negated */ /* (e.g. ~red means "not the constant red." */ /*=================================================*/ if (theToken->type == NOT_CONSTRAINT) { GetToken(theEnv,readSource,theToken); topNode->negated = TRUE; } else { topNode->negated = FALSE; } /*===========================================*/ /* Determine if the constraint is one of the */ /* recognized types. These are ?variables, */ /* symbols, strings, numbers, :(expression), */ /* and =(expression). */ /*===========================================*/ topNode->type = theToken->type; /*============================================*/ /* Any symbol is valid, but an = signifies a */ /* return value constraint and an : signifies */ /* a predicate constraint. */ /*============================================*/ if (theToken->type == SYMBOL) { /*==============================*/ /* If the symbol is an =, parse */ /* a return value constraint. */ /*==============================*/ if (strcmp(ValueToString(theToken->value),"=") == 0) { theExpression = Function0Parse(theEnv,readSource); if (theExpression == NULL) { *error = TRUE; ReturnLHSParseNodes(theEnv,topNode); return(NULL); } topNode->type = RETURN_VALUE_CONSTRAINT; topNode->expression = ExpressionToLHSParseNodes(theEnv,theExpression); ReturnExpression(theEnv,theExpression); } /*=============================*/ /* If the symbol is a :, parse */ /* a predicate constraint. */ /*=============================*/ else if (strcmp(ValueToString(theToken->value),":") == 0) { theExpression = Function0Parse(theEnv,readSource); if (theExpression == NULL) { *error = TRUE; ReturnLHSParseNodes(theEnv,topNode); return(NULL); } topNode->type = PREDICATE_CONSTRAINT; topNode->expression = ExpressionToLHSParseNodes(theEnv,theExpression); ReturnExpression(theEnv,theExpression); } /*==============================================*/ /* Otherwise, treat the constraint as a symbol. */ /*==============================================*/ else { topNode->value = theToken->value; } } /*=====================================================*/ /* Single and multifield variables and float, integer, */ /* string, and instance name constants are also valid. */ /*=====================================================*/ else if ((theToken->type == SF_VARIABLE) || (theToken->type == MF_VARIABLE) || (theToken->type == FLOAT) || (theToken->type == INTEGER) || (theToken->type == STRING) || (theToken->type == INSTANCE_NAME)) { topNode->value = theToken->value; } /*===========================*/ /* Anything else is invalid. */ /*===========================*/ else { SyntaxErrorMessage(theEnv,"defrule"); *error = TRUE; ReturnLHSParseNodes(theEnv,topNode); return(NULL); } /*===============================*/ /* Return the parsed constraint. */ /*===============================*/ return(topNode); }
static DATA_OBJECT_PTR GetSaveFactsDeftemplateNames( void *theEnv, struct expr *theList, int saveCode, int *count, int *error) { struct expr *tempList; DATA_OBJECT_PTR theDOArray; int i, tempCount; struct deftemplate *theDeftemplate = NULL; /*=============================*/ /* Initialize the error state. */ /*=============================*/ *error = FALSE; /*=====================================================*/ /* If no deftemplate names were specified as arguments */ /* then the deftemplate name list is empty. */ /*=====================================================*/ if (theList == NULL) { *count = 0; return(NULL); } /*======================================*/ /* Determine the number of deftemplate */ /* names to be stored in the name list. */ /*======================================*/ for (tempList = theList, *count = 0; tempList != NULL; tempList = tempList->nextArg, (*count)++) { /* Do Nothing */ } /*=========================================*/ /* Allocate the storage for the name list. */ /*=========================================*/ theDOArray = (DATA_OBJECT_PTR) gm3(theEnv,(long) sizeof(DATA_OBJECT) * *count); /*=====================================*/ /* Loop through each of the arguments. */ /*=====================================*/ for (tempList = theList, i = 0; i < *count; tempList = tempList->nextArg, i++) { /*========================*/ /* Evaluate the argument. */ /*========================*/ EvaluateExpression(theEnv,tempList,&theDOArray[i]); if (EvaluationData(theEnv)->EvaluationError) { *error = TRUE; rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count); return(NULL); } /*======================================*/ /* A deftemplate name must be a symbol. */ /*======================================*/ if (theDOArray[i].type != SYMBOL) { *error = TRUE; ExpectedTypeError1(theEnv,"save-facts",3+i,"symbol"); rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count); return(NULL); } /*===================================================*/ /* Find the deftemplate. For a local save, look only */ /* in the current module. For a visible save, look */ /* in all visible modules. */ /*===================================================*/ if (saveCode == LOCAL_SAVE) { theDeftemplate = (struct deftemplate *) EnvFindDeftemplate(theEnv,ValueToString(theDOArray[i].value)); if (theDeftemplate == NULL) { *error = TRUE; ExpectedTypeError1(theEnv,"save-facts",3+i,"local deftemplate name"); rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count); return(NULL); } } else if (saveCode == VISIBLE_SAVE) { theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL, ValueToString(theDOArray[i].value), &tempCount,TRUE,NULL); if (theDeftemplate == NULL) { *error = TRUE; ExpectedTypeError1(theEnv,"save-facts",3+i,"visible deftemplate name"); rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count); return(NULL); } } /*==================================*/ /* Add a pointer to the deftemplate */ /* to the array being created. */ /*==================================*/ theDOArray[i].type = DEFTEMPLATE_PTR; theDOArray[i].value = (void *) theDeftemplate; } /*===================================*/ /* Return the array of deftemplates. */ /*===================================*/ return(theDOArray); }
static void *SearchImportedConstructModules( void *theEnv, EXEC_STATUS, struct symbolHashNode *constructType, struct defmodule *matchModule, struct moduleItem *theModuleItem, struct symbolHashNode *findName, int *count, int searchCurrent, struct defmodule *notYetDefinedInModule) { struct defmodule *theModule; struct portItem *theImportList, *theExportList; void *rv, *arv = NULL; int searchModule, exported; struct defmodule *currentModule; /*=========================================*/ /* Start the search in the current module. */ /* If the current module has already been */ /* visited, then return. */ /*=========================================*/ currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv,execStatus)); if (currentModule->visitedFlag) return(NULL); /*=======================================================*/ /* The searchCurrent flag indicates whether the current */ /* module should be included in the search. In addition, */ /* if matchModule is non-NULL, the current module will */ /* only be searched if it is the specific module from */ /* which we want the construct imported. */ /*=======================================================*/ if ((searchCurrent) && ((matchModule == NULL) || (currentModule == matchModule))) { /*===============================================*/ /* Look for the construct in the current module. */ /*===============================================*/ rv = (*theModuleItem->findFunction)(theEnv,execStatus,ValueToString(findName)); /*========================================================*/ /* If we're in the process of defining the construct in */ /* the module we're searching then go ahead and increment */ /* the count indicating the number of modules in which */ /* the construct was found. */ /*========================================================*/ if (notYetDefinedInModule == currentModule) { (*count)++; arv = rv; } /*=========================================================*/ /* Otherwise, if the construct is in the specified module, */ /* increment the count only if the construct actually */ /* belongs to the module. [Some constructs, like the COOL */ /* system classes, can be found in any module, but they */ /* actually belong to the MAIN module.] */ /*=========================================================*/ else if (rv != NULL) { if (((struct constructHeader *) rv)->whichModule->theModule == currentModule) { (*count)++; } arv = rv; } } /*=====================================*/ /* Mark the current module as visited. */ /*=====================================*/ currentModule->visitedFlag = TRUE; /*===================================*/ /* Search through all of the modules */ /* imported by the current module. */ /*===================================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv,execStatus)); theImportList = theModule->importList; while (theImportList != NULL) { /*===================================================*/ /* Determine if the module should be searched (based */ /* upon whether the entire module, all constructs of */ /* a specific type, or specifically named constructs */ /* are imported). */ /*===================================================*/ searchModule = FALSE; if ((theImportList->constructType == NULL) || (theImportList->constructType == constructType)) { if ((theImportList->constructName == NULL) || (theImportList->constructName == findName)) { searchModule = TRUE; } } /*=================================*/ /* Determine if the module exists. */ /*=================================*/ if (searchModule) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,execStatus,ValueToString(theImportList->moduleName)); if (theModule == NULL) searchModule = FALSE; } /*=======================================================*/ /* Determine if the construct is exported by the module. */ /*=======================================================*/ if (searchModule) { exported = FALSE; theExportList = theModule->exportList; while ((theExportList != NULL) && (! exported)) { if ((theExportList->constructType == NULL) || (theExportList->constructType == constructType)) { if ((theExportList->constructName == NULL) || (theExportList->constructName == findName)) { exported = TRUE; } } theExportList = theExportList->next; } if (! exported) searchModule = FALSE; } /*=================================*/ /* Search in the specified module. */ /*=================================*/ if (searchModule) { EnvSetCurrentModule(theEnv,execStatus,(void *) theModule); if ((rv = SearchImportedConstructModules(theEnv,execStatus,constructType,matchModule, theModuleItem,findName, count,TRUE, notYetDefinedInModule)) != NULL) { arv = rv; } } /*====================================*/ /* Move on to the next imported item. */ /*====================================*/ theImportList = theImportList->next; } /*=========================*/ /* Return a pointer to the */ /* last construct found. */ /*=========================*/ return(arv); }
globle void RetractCommand( void *theEnv) { long int 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,"retract",argNumber,"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]; sprintf(tempBuffer,"f-%ld",factIndex); CantFindItemErrorMessage(theEnv,"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,"retract",argNumber,"fact-address, fact-index, or the symbol *"); SetEvaluationError(theEnv,TRUE); } } }
globle int LoadConstructsFromLogicalName( void *theEnv, char *readSource) { int constructFlag; struct token theToken; int noErrors = TRUE; int foundConstruct; /*=========================================*/ /* Reset the halt execution and evaluation */ /* error flags in preparation for parsing. */ /*=========================================*/ if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); /*========================================================*/ /* Find the beginning of the first construct in the file. */ /*========================================================*/ EvaluationData(theEnv)->CurrentEvaluationDepth++; GetToken(theEnv,readSource,&theToken); foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors); /*==================================================*/ /* Parse the file until the end of file is reached. */ /*==================================================*/ while ((foundConstruct == TRUE) && (GetHaltExecution(theEnv) == FALSE)) { /*===========================================================*/ /* Clear the pretty print buffer in preparation for parsing. */ /*===========================================================*/ FlushPPBuffer(theEnv); /*======================*/ /* Parse the construct. */ /*======================*/ constructFlag = ParseConstruct(theEnv,ValueToString(theToken.value),readSource); /*==============================================================*/ /* If an error occurred while parsing, then find the beginning */ /* of the next construct (but don't generate any more error */ /* messages--in effect, skip everything until another construct */ /* is found). */ /*==============================================================*/ if (constructFlag == 1) { EnvPrintRouter(theEnv,WERROR,"\nERROR:\n"); PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv)); EnvPrintRouter(theEnv,WERROR,"\n"); noErrors = FALSE; GetToken(theEnv,readSource,&theToken); foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,TRUE,&noErrors); } /*======================================================*/ /* Otherwise, find the beginning of the next construct. */ /*======================================================*/ else { GetToken(theEnv,readSource,&theToken); foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors); } /*=====================================================*/ /* Yield time if necessary to foreground applications. */ /*=====================================================*/ if (foundConstruct) { IncrementSymbolCount(theToken.value); } EvaluationData(theEnv)->CurrentEvaluationDepth--; PeriodicCleanup(theEnv,FALSE,TRUE); YieldTime(theEnv); EvaluationData(theEnv)->CurrentEvaluationDepth++; if (foundConstruct) { DecrementSymbolCount(theEnv,(SYMBOL_HN *) theToken.value); } } EvaluationData(theEnv)->CurrentEvaluationDepth--; /*========================================================*/ /* Print a carriage return if a single character is being */ /* printed to indicate constructs are being processed. */ /*========================================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") != TRUE) && GetPrintWhileLoading(theEnv)) #else if (GetPrintWhileLoading(theEnv)) #endif { EnvPrintRouter(theEnv,WDIALOG,"\n"); } /*=============================================================*/ /* Once the load is complete, destroy the pretty print buffer. */ /* This frees up any memory that was used to create the pretty */ /* print forms for constructs during parsing. Thus calls to */ /* the mem-used function will accurately reflect the amount of */ /* memory being used after a load command. */ /*=============================================================*/ DestroyPPBuffer(theEnv); /*==========================================================*/ /* Return a boolean flag which indicates whether any errors */ /* were encountered while loading the constructs. */ /*==========================================================*/ return(noErrors); }
globle void FactsCommand( void *theEnv) { int argumentCount; long int 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,(long) start,(long) end,(long) 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)) { SetEvaluationError(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"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } argOffset = 0; } /*==========================================*/ /* Otherwise the first argument is invalid. */ /*==========================================*/ else { ExpectedTypeError1(theEnv,"facts",1,"symbol or positive number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(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,(long) start,(long) end,(long) max); }
globle SYMBOL_HN *GetConstructNameAndComment( void *theEnv, char *readSource, struct token *inputToken, char *constructName, void *(*findFunction)(void *,char *), int (*deleteFunction)(void *,void *), char *constructSymbol, int fullMessageCR, int getComment, int moduleNameAllowed) { #if (MAC_MCW || WIN_MCW || MAC_XCD) && (! DEBUGGING_FUNCTIONS) #pragma unused(fullMessageCR) #endif SYMBOL_HN *name, *moduleName; int redefining = FALSE; void *theConstruct; unsigned separatorPosition; struct defmodule *theModule; /*==========================*/ /* Next token should be the */ /* name of the construct. */ /*==========================*/ GetToken(theEnv,readSource,inputToken); if (inputToken->type != SYMBOL) { PrintErrorID(theEnv,"CSTRCPSR",2,TRUE); EnvPrintRouter(theEnv,WERROR,"Missing name for "); EnvPrintRouter(theEnv,WERROR,constructName); EnvPrintRouter(theEnv,WERROR," construct\n"); return(NULL); } name = (SYMBOL_HN *) inputToken->value; /*===============================*/ /* Determine the current module. */ /*===============================*/ separatorPosition = FindModuleSeparator(ValueToString(name)); if (separatorPosition) { if (moduleNameAllowed == FALSE) { SyntaxErrorMessage(theEnv,"module specifier"); return(NULL); } moduleName = ExtractModuleName(theEnv,separatorPosition,ValueToString(name)); if (moduleName == NULL) { SyntaxErrorMessage(theEnv,"construct name"); return(NULL); } theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName)); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(moduleName)); return(NULL); } EnvSetCurrentModule(theEnv,(void *) theModule); name = ExtractConstructName(theEnv,separatorPosition,ValueToString(name)); if (name == NULL) { SyntaxErrorMessage(theEnv,"construct name"); return(NULL); } } /*=====================================================*/ /* If the module was not specified, record the current */ /* module name as part of the pretty-print form. */ /*=====================================================*/ else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (moduleNameAllowed) { PPBackup(theEnv); SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,theModule)); SavePPBuffer(theEnv,"::"); SavePPBuffer(theEnv,ValueToString(name)); } } /*==================================================================*/ /* Check for import/export conflicts from the construct definition. */ /*==================================================================*/ #if DEFMODULE_CONSTRUCT if (FindImportExportConflict(theEnv,constructName,theModule,ValueToString(name))) { ImportExportConflictMessage(theEnv,constructName,ValueToString(name),NULL,NULL); return(NULL); } #endif /*========================================================*/ /* Remove the construct if it is already in the knowledge */ /* base and we're not just checking syntax. */ /*========================================================*/ if ((findFunction != NULL) && (! ConstructData(theEnv)->CheckSyntaxMode)) { theConstruct = (*findFunction)(theEnv,ValueToString(name)); if (theConstruct != NULL) { redefining = TRUE; if (deleteFunction != NULL) { if ((*deleteFunction)(theEnv,theConstruct) == FALSE) { PrintErrorID(theEnv,"CSTRCPSR",4,TRUE); EnvPrintRouter(theEnv,WERROR,"Cannot redefine "); EnvPrintRouter(theEnv,WERROR,constructName); EnvPrintRouter(theEnv,WERROR," "); EnvPrintRouter(theEnv,WERROR,ValueToString(name)); EnvPrintRouter(theEnv,WERROR," while it is in use.\n"); return(NULL); } } } } /*=============================================*/ /* If compilations are being watched, indicate */ /* that a construct is being compiled. */ /*=============================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) && GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode)) { if (redefining) { PrintWarningID(theEnv,"CSTRCPSR",1,TRUE); EnvPrintRouter(theEnv,WDIALOG,"Redefining "); } else EnvPrintRouter(theEnv,WDIALOG,"Defining "); EnvPrintRouter(theEnv,WDIALOG,constructName); EnvPrintRouter(theEnv,WDIALOG,": "); EnvPrintRouter(theEnv,WDIALOG,ValueToString(name)); if (fullMessageCR) EnvPrintRouter(theEnv,WDIALOG,"\n"); else EnvPrintRouter(theEnv,WDIALOG," "); } else #endif { if (GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode)) { EnvPrintRouter(theEnv,WDIALOG,constructSymbol); } } /*===============================*/ /* Get the comment if it exists. */ /*===============================*/ GetToken(theEnv,readSource,inputToken); if ((inputToken->type == STRING) && getComment) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,inputToken->printForm); GetToken(theEnv,readSource,inputToken); if (inputToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv,"\n "); SavePPBuffer(theEnv,inputToken->printForm); } } else if (inputToken->type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv,"\n "); SavePPBuffer(theEnv,inputToken->printForm); } /*===================================*/ /* Return the name of the construct. */ /*===================================*/ return(name); }
/******************************************************************************* NAME : CreateGetAndPutHandlers DESCRIPTION : Creates two message-handlers with the following syntax for the slot: (defmessage-handler <class> get-<slot-name> primary () ?self:<slot-name>) For single-field slots: (defmessage-handler <class> put-<slot-name> primary (?value) (bind ?self:<slot-name> ?value)) For multifield slots: (defmessage-handler <class> put-<slot-name> primary ($?value) (bind ?self:<slot-name> ?value)) INPUTS : The class slot descriptor RETURNS : Nothing useful SIDE EFFECTS : Message-handlers created NOTES : A put handler is not created for read-only slots *******************************************************************************/ globle void CreateGetAndPutHandlers( void *theEnv, SLOT_DESC *sd) { char *className,*slotName; unsigned bufsz; char *buf,*handlerRouter = "*** Default Public Handlers ***"; int oldPWL,oldCM; char *oldRouter; char *oldString; long oldIndex; if ((sd->createReadAccessor == 0) && (sd->createWriteAccessor == 0)) return; className = ValueToString(sd->cls->header.name); slotName = ValueToString(sd->slotName->name); bufsz = (sizeof(char) * (strlen(className) + (strlen(slotName) * 2) + 80)); buf = (char *) gm2(theEnv,bufsz); oldPWL = GetPrintWhileLoading(theEnv); SetPrintWhileLoading(theEnv,FALSE); oldCM = EnvSetConserveMemory(theEnv,TRUE); if (sd->createReadAccessor) { sprintf(buf,"%s get-%s () ?self:%s)",className,slotName,slotName); oldRouter = RouterData(theEnv)->FastCharGetRouter; oldString = RouterData(theEnv)->FastCharGetString; oldIndex = RouterData(theEnv)->FastCharGetIndex; RouterData(theEnv)->FastCharGetRouter = handlerRouter; RouterData(theEnv)->FastCharGetIndex = 0; RouterData(theEnv)->FastCharGetString = buf; ParseDefmessageHandler(theEnv,handlerRouter); DestroyPPBuffer(theEnv); /* if (OpenStringSource(theEnv,handlerRouter,buf,0)) { ParseDefmessageHandler(handlerRouter); DestroyPPBuffer(); CloseStringSource(theEnv,handlerRouter); } */ RouterData(theEnv)->FastCharGetRouter = oldRouter; RouterData(theEnv)->FastCharGetIndex = oldIndex; RouterData(theEnv)->FastCharGetString = oldString; } if (sd->createWriteAccessor) { sprintf(buf,"%s put-%s ($?value) (bind ?self:%s ?value))", className,slotName,slotName); oldRouter = RouterData(theEnv)->FastCharGetRouter; oldString = RouterData(theEnv)->FastCharGetString; oldIndex = RouterData(theEnv)->FastCharGetIndex; RouterData(theEnv)->FastCharGetRouter = handlerRouter; RouterData(theEnv)->FastCharGetIndex = 0; RouterData(theEnv)->FastCharGetString = buf; ParseDefmessageHandler(theEnv,handlerRouter); DestroyPPBuffer(theEnv); /* if (OpenStringSource(theEnv,handlerRouter,buf,0)) { ParseDefmessageHandler(handlerRouter); DestroyPPBuffer(); CloseStringSource(theEnv,handlerRouter); } */ RouterData(theEnv)->FastCharGetRouter = oldRouter; RouterData(theEnv)->FastCharGetIndex = oldIndex; RouterData(theEnv)->FastCharGetString = oldString; } SetPrintWhileLoading(theEnv,oldPWL); EnvSetConserveMemory(theEnv,oldCM); rm(theEnv,(void *) buf,bufsz); }
globle void *ImplodeMultifield( void *theEnv, DATA_OBJECT *value) { size_t strsize = 0; long i, j; const char *tmp_str; char *ret_str; void *rv; struct multifield *theMultifield; DATA_OBJECT tempDO; /*===================================================*/ /* Determine the size of the string to be allocated. */ /*===================================================*/ theMultifield = (struct multifield *) GetpValue(value); for (i = GetpDOBegin(value) ; i <= GetpDOEnd(value) ; i++) { if (GetMFType(theMultifield,i) == FLOAT) { tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i))); strsize += strlen(tmp_str) + 1; } else if (GetMFType(theMultifield,i) == INTEGER) { tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i))); strsize += strlen(tmp_str) + 1; } else if (GetMFType(theMultifield,i) == STRING) { strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3; tmp_str = ValueToString(GetMFValue(theMultifield,i)); while(*tmp_str) { if (*tmp_str == '"') { strsize++; } else if (*tmp_str == '\\') /* GDR 111599 #835 */ { strsize++; } /* GDR 111599 #835 */ tmp_str++; } } #if OBJECT_SYSTEM else if (GetMFType(theMultifield,i) == INSTANCE_NAME) { strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3; } else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS) { strsize += strlen(ValueToString(((INSTANCE_TYPE *) GetMFValue(theMultifield,i))->name)) + 3; } #endif else { SetType(tempDO,GetMFType(theMultifield,i)); SetValue(tempDO,GetMFValue(theMultifield,i)); strsize += strlen(DataObjectToString(theEnv,&tempDO)) + 1; } } /*=============================================*/ /* Allocate the string and copy all components */ /* of the MULTIFIELD variable to it. */ /*=============================================*/ if (strsize == 0) return(EnvAddSymbol(theEnv,"")); ret_str = (char *) gm2(theEnv,strsize); for(j=0, i=GetpDOBegin(value); i <= GetpDOEnd(value) ; i++) { /*============================*/ /* Convert numbers to strings */ /*============================*/ if (GetMFType(theMultifield,i) == FLOAT) { tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i))); while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } } else if (GetMFType(theMultifield,i) == INTEGER) { tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i))); while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } } /*=======================================*/ /* Enclose strings in quotes and preceed */ /* imbedded quotes with a backslash */ /*=======================================*/ else if (GetMFType(theMultifield,i) == STRING) { tmp_str = ValueToString(GetMFValue(theMultifield,i)); *(ret_str+j) = '"'; j++; while(*tmp_str) { if (*tmp_str == '"') { *(ret_str+j) = '\\'; j++; } else if (*tmp_str == '\\') /* GDR 111599 #835 */ { /* GDR 111599 #835 */ *(ret_str+j) = '\\'; /* GDR 111599 #835 */ j++; /* GDR 111599 #835 */ } /* GDR 111599 #835 */ *(ret_str+j) = *tmp_str; j++, tmp_str++; } *(ret_str+j) = '"'; j++; } #if OBJECT_SYSTEM else if (GetMFType(theMultifield,i) == INSTANCE_NAME) { tmp_str = ValueToString(GetMFValue(theMultifield,i)); *(ret_str + j++) = '['; while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } *(ret_str + j++) = ']'; } else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS) { tmp_str = ValueToString(((INSTANCE_TYPE *) GetMFValue(theMultifield,i))->name); *(ret_str + j++) = '['; while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } *(ret_str + j++) = ']'; } #endif else { SetType(tempDO,GetMFType(theMultifield,i)); SetValue(tempDO,GetMFValue(theMultifield,i)); tmp_str = DataObjectToString(theEnv,&tempDO); while(*tmp_str) { *(ret_str+j) = *tmp_str; j++, tmp_str++; } } *(ret_str+j) = ' '; j++; } *(ret_str+j-1) = '\0'; /*====================*/ /* Return the string. */ /*====================*/ rv = EnvAddSymbol(theEnv,ret_str); rm(theEnv,ret_str,strsize); return(rv); }
/********************************************************* NAME : CheckSlotReference DESCRIPTION : Examines a ?self:<slot-name> reference If the reference is a single-field or global variable, checking and evaluation is delayed until run-time. If the reference is a symbol, this routine verifies that the slot is a legal slot for the reference (i.e., it exists in the class to which the message-handler is being attached, it is visible and it is writable for write reference) INPUTS : 1) A buffer holding the class of the handler being parsed 2) The type of the slot reference 3) The value of the slot reference 4) A flag indicating if this is a read or write access 5) Value expression for write RETURNS : Class slot on success, NULL on errors SIDE EFFECTS : Messages printed on errors. NOTES : For static references, this function insures that the slot is either publicly visible or that the handler is being attached to the same class in which the private slot is defined. *********************************************************/ static SLOT_DESC *CheckSlotReference( void *theEnv, DEFCLASS *theDefclass, int theType, void *theValue, CLIPS_BOOLEAN writeFlag, EXPRESSION *writeExpression) { int slotIndex; SLOT_DESC *sd; int vCode; if (theType != SYMBOL) { PrintErrorID(theEnv,"MSGPSR",7,FALSE); EnvPrintRouter(theEnv,WERROR,"Illegal value for ?self reference.\n"); return(NULL); } slotIndex = FindInstanceTemplateSlot(theEnv,theDefclass,(SYMBOL_HN *) theValue); if (slotIndex == -1) { PrintErrorID(theEnv,"MSGPSR",6,FALSE); EnvPrintRouter(theEnv,WERROR,"No such slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(theValue)); EnvPrintRouter(theEnv,WERROR," in class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) theDefclass)); EnvPrintRouter(theEnv,WERROR," for ?self reference.\n"); return(NULL); } sd = theDefclass->instanceTemplate[slotIndex]; if ((sd->publicVisibility == 0) && (sd->cls != theDefclass)) { SlotVisibilityViolationError(theEnv,sd,theDefclass); return(NULL); } if (! writeFlag) return(sd); /* ================================================= If a slot is initialize-only, the WithinInit flag still needs to be checked at run-time, for the handler could be called out of the context of an init. ================================================= */ if (sd->noWrite && (sd->initializeOnly == 0)) { SlotAccessViolationError(theEnv,ValueToString(theValue), FALSE,(void *) theDefclass); return(NULL); } if (EnvGetStaticConstraintChecking(theEnv)) { vCode = ConstraintCheckExpressionChain(theEnv,writeExpression,sd->constraint); if (vCode != NO_VIOLATION) { PrintErrorID(theEnv,"CSTRNCHK",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Expression for "); PrintSlot(theEnv,WERROR,sd,NULL,"direct slot write"); ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0, vCode,sd->constraint,FALSE); return(NULL); } } return(sd); }
/********************************************************************* NAME : DeleteHandler DESCRIPTION : Deletes one or more message-handlers from a class definition INPUTS : 1) The class address 2) The message-handler name (if this is * and there is no handler called *, then the delete operations will be applied to all handlers matching the type 3) The message-handler type (if this is -1, then the delete operations will be applied to all handlers matching the name 4) A flag saying whether to print error messages when handlers are not found meeting specs RETURNS : 1 if successful, 0 otherwise SIDE EFFECTS : Handlers deleted NOTES : If any handlers for the class are currently executing, this routine will fail **********************************************************************/ globle int DeleteHandler( void *theEnv, EXEC_STATUS, DEFCLASS *cls, SYMBOL_HN *mname, int mtype, int indicate_missing) { long i; HANDLER *hnd; int found,success = 1; if (cls->handlerCount == 0) { if (indicate_missing) { HandlerDeleteError(theEnv,execStatus,EnvGetDefclassName(theEnv,execStatus,(void *) cls)); return(0); } return(1); } if (HandlersExecuting(cls)) { HandlerDeleteError(theEnv,execStatus,EnvGetDefclassName(theEnv,execStatus,(void *) cls)); return(0); } if (mtype == -1) { found = FALSE; for (i = MAROUND ; i <= MAFTER ; i++) { hnd = FindHandlerByAddress(cls,mname,(unsigned) i); if (hnd != NULL) { found = TRUE; if (hnd->system == 0) hnd->mark = 1; else { PrintErrorID(theEnv,execStatus,"MSGPSR",3,FALSE); EnvPrintRouter(theEnv,execStatus,WERROR,"System message-handlers may not be modified.\n"); success = 0; } } } if ((found == FALSE) ? (strcmp(ValueToString(mname),"*") == 0) : FALSE) { for (i = 0 ; i < cls->handlerCount ; i++) if (cls->handlers[i].system == 0) cls->handlers[i].mark = 1; } } else { hnd = FindHandlerByAddress(cls,mname,(unsigned) mtype); if (hnd == NULL) { if (strcmp(ValueToString(mname),"*") == 0) { for (i = 0 ; i < cls->handlerCount ; i++) if ((cls->handlers[i].type == (unsigned) mtype) && (cls->handlers[i].system == 0)) cls->handlers[i].mark = 1; } else { if (indicate_missing) HandlerDeleteError(theEnv,execStatus,EnvGetDefclassName(theEnv,execStatus,(void *) cls)); success = 0; } } else if (hnd->system == 0) hnd->mark = 1; else { if (indicate_missing) { PrintErrorID(theEnv,execStatus,"MSGPSR",3,FALSE); EnvPrintRouter(theEnv,execStatus,WERROR,"System message-handlers may not be modified.\n"); } success = 0; } } DeallocateMarkedHandlers(theEnv,execStatus,cls); return(success); }
static struct expr *ModAndDupParse( void *theEnv, struct expr *top, char *logicalName, char *name) { int error = FALSE; struct token theToken; struct expr *nextOne, *tempSlot; struct expr *newField, *firstField, *lastField; int printError; short done; /*==================================================================*/ /* Parse the fact-address or index to the modify/duplicate command. */ /*==================================================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,logicalName,&theToken); if ((theToken.type == SF_VARIABLE) || (theToken.type == GBL_VARIABLE)) { nextOne = GenConstant(theEnv,theToken.type,theToken.value); } else if (theToken.type == INTEGER) { if (! TopLevelCommand(theEnv)) { PrintErrorID(theEnv,"TMPLTFUN",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Fact-indexes can only be used by "); EnvPrintRouter(theEnv,WERROR,name); EnvPrintRouter(theEnv,WERROR," as a top level command.\n"); ReturnExpression(theEnv,top); return(NULL); } nextOne = GenConstant(theEnv,INTEGER,theToken.value); } else { ExpectedTypeError2(theEnv,name,1); ReturnExpression(theEnv,top); return(NULL); } nextOne->nextArg = NULL; nextOne->argList = NULL; top->argList = nextOne; nextOne = top->argList; /*=======================================================*/ /* Parse the remaining modify/duplicate slot specifiers. */ /*=======================================================*/ GetToken(theEnv,logicalName,&theToken); while (theToken.type != RPAREN) { PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); /*=================================================*/ /* Slot definition begins with a left parenthesis. */ /*=================================================*/ if (theToken.type != LPAREN) { SyntaxErrorMessage(theEnv,"duplicate/modify function"); ReturnExpression(theEnv,top); return(NULL); } /*=================================*/ /* The slot name must be a symbol. */ /*=================================*/ GetToken(theEnv,logicalName,&theToken); if (theToken.type != SYMBOL) { SyntaxErrorMessage(theEnv,"duplicate/modify function"); ReturnExpression(theEnv,top); return(NULL); } /*=================================*/ /* Check for duplicate slot names. */ /*=================================*/ for (tempSlot = top->argList->nextArg; tempSlot != NULL; tempSlot = tempSlot->nextArg) { if (tempSlot->value == theToken.value) { AlreadyParsedErrorMessage(theEnv,"slot ",ValueToString(theToken.value)); ReturnExpression(theEnv,top); return(NULL); } } /*=========================================*/ /* Add the slot name to the list of slots. */ /*=========================================*/ nextOne->nextArg = GenConstant(theEnv,SYMBOL,theToken.value); nextOne = nextOne->nextArg; /*====================================================*/ /* Get the values to be stored in the specified slot. */ /*====================================================*/ firstField = NULL; lastField = NULL; done = FALSE; while (! done) { SavePPBuffer(theEnv," "); newField = GetAssertArgument(theEnv,logicalName,&theToken,&error, RPAREN,FALSE,&printError); if (error) { if (printError) SyntaxErrorMessage(theEnv,"deftemplate pattern"); ReturnExpression(theEnv,top); return(NULL); } if (newField == NULL) { done = TRUE; } if (lastField == NULL) { firstField = newField; } else { lastField->nextArg = newField; } lastField = newField; } /*================================================*/ /* Slot definition ends with a right parenthesis. */ /*================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"duplicate/modify function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,firstField); return(NULL); } else { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } nextOne->argList = firstField; GetToken(theEnv,logicalName,&theToken); } /*================================================*/ /* Return the parsed modify/duplicate expression. */ /*================================================*/ return(top); }