/*************************************************** NAME : ReplaceClassNameWithReference DESCRIPTION : In parsing a make instance call, this function replaces a constant class name with an actual pointer to the class INPUTS : The expression RETURNS : TRUE if all OK, FALSE if class cannot be found SIDE EFFECTS : The expression type and value are modified if class is found NOTES : Searches current nd imported modules for reference ***************************************************/ static intBool ReplaceClassNameWithReference( void *theEnv, EXPRESSION *theExp) { char *theClassName; void *theDefclass; if (theExp->type == SYMBOL) { theClassName = ValueToString(theExp->value); theDefclass = (void *) LookupDefclassInScope(theEnv,theClassName); if (theDefclass == NULL) { CantFindItemErrorMessage(theEnv,(char*)"class",theClassName); return(FALSE); } if (EnvClassAbstractP(theEnv,theDefclass)) { PrintErrorID(theEnv,(char*)"INSMNGR",3,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"Cannot create instances of abstract class "); EnvPrintRouter(theEnv,WERROR,theClassName); EnvPrintRouter(theEnv,WERROR,(char*)".\n"); return(FALSE); } theExp->type = DEFCLASS_PTR; theExp->value = theDefclass; } return(TRUE); }
globle void RefreshCommand( void *theEnv) { char *ruleName; void *rulePtr; /*===========================*/ /* Get the name of the rule. */ /*===========================*/ ruleName = GetConstructName(theEnv,(char*)"refresh",(char*)"rule name"); if (ruleName == NULL) return; /*===============================*/ /* Determine if the rule exists. */ /*===============================*/ rulePtr = EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,(char*)"defrule",ruleName); return; } /*===================*/ /* Refresh the rule. */ /*===================*/ EnvRefresh(theEnv,rulePtr); }
/*************************************************** NAME : ReplaceTemplateNameWithReference DESCRIPTION : In parsing an fact-set query, this function replaces a constant template name with an actual pointer to the template INPUTS : The expression RETURNS : TRUE if all OK, FALSE if template cannot be found SIDE EFFECTS : The expression type and value are modified if template is found NOTES : Searches current and imported modules for reference ***************************************************/ static intBool ReplaceTemplateNameWithReference( void *theEnv, EXPRESSION *theExp) { const char *theTemplateName; void *theDeftemplate; int count; if (theExp->type == SYMBOL) { theTemplateName = ValueToString(theExp->value); theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,theTemplateName, &count,TRUE,NULL); if (theDeftemplate == NULL) { CantFindItemErrorMessage(theEnv,"deftemplate",theTemplateName); return(FALSE); } if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"deftemplate",theTemplateName); return(FALSE); } theExp->type = DEFTEMPLATE_PTR; theExp->value = theDeftemplate; } return(TRUE); }
/*************************************************** NAME : ReplaceClassNameWithReference DESCRIPTION : In parsing a make instance call, this function replaces a constant class name with an actual pointer to the class INPUTS : The expression RETURNS : TRUE if all OK, FALSE if class cannot be found SIDE EFFECTS : The expression type and value are modified if class is found NOTES : Searches current nd imported modules for reference CHANGES : It's now possible to create an instance of a class that's not in scope if the module name is specified. ***************************************************/ static intBool ReplaceClassNameWithReference( void *theEnv, EXPRESSION *theExp) { const char *theClassName; void *theDefclass; if (theExp->type == SYMBOL) { theClassName = ValueToString(theExp->value); //theDefclass = (void *) LookupDefclassInScope(theEnv,theClassName); theDefclass = (void *) LookupDefclassByMdlOrScope(theEnv,theClassName); // Module or scope is now allowed if (theDefclass == NULL) { CantFindItemErrorMessage(theEnv,"class",theClassName); return(FALSE); } if (EnvClassAbstractP(theEnv,theDefclass)) { PrintErrorID(theEnv,"INSMNGR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot create instances of abstract class "); EnvPrintRouter(theEnv,WERROR,theClassName); EnvPrintRouter(theEnv,WERROR,".\n"); return(FALSE); } theExp->type = DEFCLASS_PTR; theExp->value = theDefclass; #if (! RUN_TIME) && (! BLOAD_ONLY) if (! ConstructData(theEnv)->ParsingConstruct) { ConstructData(theEnv)->DanglingConstructs++; } #endif } return(TRUE); }
globle void RemoveBreakCommand( void *theEnv) { DATA_OBJECT argPtr; char *argument; int nargs; void *defrulePtr; if ((nargs = EnvArgCountCheck(theEnv,"remove-break",NO_MORE_THAN,1)) == -1) { return; } if (nargs == 0) { RemoveAllBreakpoints(theEnv); return; } if (EnvArgTypeCheck(theEnv,"remove-break",1,SYMBOL,&argPtr) == FALSE) return; argument = DOToString(argPtr); if ((defrulePtr = EnvFindDefrule(theEnv,argument)) == NULL) { CantFindItemErrorMessage(theEnv,"defrule",argument); return; } if (EnvRemoveBreak(theEnv,defrulePtr) == FALSE) { EnvPrintRouter(theEnv,WERROR,"Rule "); EnvPrintRouter(theEnv,WERROR,argument); EnvPrintRouter(theEnv,WERROR," does not have a breakpoint set.\n"); } }
/*************************************************** NAME : ReplaceClassNameWithReference DESCRIPTION : In parsing a make instance call, this function replaces a constant class name with an actual pointer to the class INPUTS : The expression RETURNS : TRUE if all OK, FALSE if class cannot be found SIDE EFFECTS : The expression type and value are modified if class is found NOTES : Searches current nd imported modules for reference ***************************************************/ static BOOLEAN ReplaceClassNameWithReference( EXPRESSION *exp) { char *theClassName; void *theDefclass; if (exp->type == SYMBOL) { theClassName = ValueToString(exp->value); theDefclass = (void *) LookupDefclassInScope(theClassName); if (theDefclass == NULL) { CantFindItemErrorMessage("class",theClassName); return(FALSE); } if (ClassAbstractP(theDefclass)) { PrintErrorID("INSMNGR",3,FALSE); PrintRouter(WERROR,"Cannot create instances of abstract class "); PrintRouter(WERROR,theClassName); PrintRouter(WERROR,".\n"); return(FALSE); } exp->type = DEFCLASS_PTR; exp->value = theDefclass; } return(TRUE); }
void SetCurrentModuleCommand( Environment *theEnv, UDFContext *context, UDFValue *returnValue) { UDFValue theArg; const char *argument; Defmodule *theModule; CLIPSLexeme *oldModuleName; /*=======================*/ /* Set the return value. */ /*=======================*/ theModule = GetCurrentModule(theEnv); if (theModule == NULL) { returnValue->lexemeValue = FalseSymbol(theEnv); return; } oldModuleName = theModule->header.name; returnValue->value = oldModuleName; /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) { return; } argument = theArg.lexemeValue->contents; /*================================================*/ /* Set the current module to the specified value. */ /*================================================*/ theModule = FindDefmodule(theEnv,argument); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",argument,true); return; } SetCurrentModule(theEnv,theModule); }
globle void *SetCurrentModuleCommand( void *theEnv) { DATA_OBJECT argPtr; char *argument; struct defmodule *theModule; SYMBOL_HN *defaultReturn; /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv)); defaultReturn = (SYMBOL_HN *) EnvAddSymbol(theEnv,ValueToString(((struct defmodule *) EnvGetCurrentModule(theEnv))->name)); if (EnvArgCountCheck(theEnv,"set-current-module",EXACTLY,1) == -1) { return(defaultReturn); } if (EnvArgTypeCheck(theEnv,"set-current-module",1,SYMBOL,&argPtr) == FALSE) { return(defaultReturn); } argument = DOToString(argPtr); /*================================================*/ /* Set the current module to the specified value. */ /*================================================*/ theModule = (struct defmodule *) EnvFindDefmodule(theEnv,argument); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",argument); return(defaultReturn); } EnvSetCurrentModule(theEnv,(void *) theModule); /*================================*/ /* Return the new current module. */ /*================================*/ return((SYMBOL_HN *) defaultReturn); }
globle long long JoinActivityCommand( void *theEnv) { char *ruleName; void *rulePtr; ruleName = GetConstructName(theEnv,"join-activity","rule name"); if (ruleName == NULL) return(0); rulePtr = EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return(0); } return EnvJoinActivity(theEnv,rulePtr,0); }
globle int PPDefmodule( void *theEnv, char *defmoduleName, char *logicalName) { void *defmodulePtr; defmodulePtr = EnvFindDefmodule(theEnv,defmoduleName); if (defmodulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",defmoduleName); return(FALSE); } if (EnvGetDefmodulePPForm(theEnv,defmodulePtr) == NULL) return(TRUE); PrintInChunks(theEnv,logicalName,EnvGetDefmodulePPForm(theEnv,defmodulePtr)); return(TRUE); }
bool PPDefmodule( void *theEnv, const char *defmoduleName, const char *logicalName) { void *defmodulePtr; defmodulePtr = EnvFindDefmodule(theEnv,defmoduleName); if (defmodulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",defmoduleName); return(false); } if (EnvGetDefmodulePPForm(theEnv,defmodulePtr) == NULL) return(true); PrintInChunks(theEnv,logicalName,EnvGetDefmodulePPForm(theEnv,defmodulePtr)); return(true); }
globle long RuleComplexityCommand( void *theEnv) { char *ruleName; struct defrule *rulePtr; ruleName = GetConstructName(theEnv,"rule-complexity","rule name"); if (ruleName == NULL) return(-1); rulePtr = (struct defrule *) EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return(-1); } return(rulePtr->complexity); }
globle void MatchesCountCommand( void *theEnv) { char *ruleName; void *rulePtr; ruleName = GetConstructName(theEnv,"matches-count","rule name"); if (ruleName == NULL) return; rulePtr = EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return; } EnvMatchesCount(theEnv,rulePtr); }
/******************************************************************** NAME : GetFunctionRestrictions DESCRIPTION : Gets DefineFunction2() restriction list for function INPUTS : None RETURNS : A string containing the function restriction codes SIDE EFFECTS : EvaluationError set on errors NOTES : None ********************************************************************/ globle void *GetFunctionRestrictions( void *theEnv) { DATA_OBJECT temp; struct FunctionDefinition *fptr; if (EnvArgTypeCheck(theEnv,"get-function-restrictions",1,SYMBOL,&temp) == FALSE) return((SYMBOL_HN *) EnvAddSymbol(theEnv,"")); fptr = FindFunction(theEnv,DOToString(temp)); if (fptr == NULL) { CantFindItemErrorMessage(theEnv,"function",DOToString(temp)); SetEvaluationError(theEnv,TRUE); return((SYMBOL_HN *) EnvAddSymbol(theEnv,"")); } if (fptr->restrictions == NULL) return((SYMBOL_HN *) EnvAddSymbol(theEnv,"0**")); return((SYMBOL_HN *) EnvAddSymbol(theEnv,fptr->restrictions)); }
globle int FocusCommand( void *theEnv) { DATA_OBJECT argPtr; char *argument; struct defmodule *theModule; int argCount, i; /*=====================================================*/ /* Check for the correct number and type of arguments. */ /*=====================================================*/ if ((argCount = EnvArgCountCheck(theEnv,"focus",AT_LEAST,1)) == -1) { return(FALSE); } /*===========================================*/ /* Focus on the specified defrule module(s). */ /*===========================================*/ for (i = argCount; i > 0; i--) { if (EnvArgTypeCheck(theEnv,"focus",i,SYMBOL,&argPtr) == FALSE) { return(FALSE); } argument = DOToString(argPtr); theModule = (struct defmodule *) EnvFindDefmodule(theEnv,argument); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",argument); return(FALSE); } EnvFocus(theEnv,(void *) theModule); } /*===================================================*/ /* Return TRUE to indicate success of focus command. */ /*===================================================*/ return(TRUE); }
globle void ShowJoinsCommand( void *theEnv) { char *ruleName; void *rulePtr; ruleName = GetConstructName(theEnv,"show-joins","rule name"); if (ruleName == NULL) return; rulePtr = EnvFindDefrule(theEnv,ruleName); if (rulePtr == NULL) { CantFindItemErrorMessage(theEnv,"defrule",ruleName); return; } ShowJoins(theEnv,rulePtr); return; }
globle struct fact *GetFactAddressOrIndexArgument( void *theEnv, const char *theFunction, int position, int noFactError) { DATA_OBJECT item; long long factIndex; struct fact *theFact; char tempBuffer[20]; EnvRtnUnknown(theEnv,position,&item); if (GetType(item) == FACT_ADDRESS) { if (((struct fact *) GetValue(item))->garbage) return(NULL); else return (((struct fact *) GetValue(item))); } else if (GetType(item) == INTEGER) { factIndex = ValueToLong(item.value); if (factIndex < 0) { ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index"); return(NULL); } theFact = FindIndexedFact(theEnv,factIndex); if ((theFact == NULL) && noFactError) { gensprintf(tempBuffer,"f-%lld",factIndex); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); return(NULL); } return(theFact); } ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index"); return(NULL); }
/*************************************************** NAME : ReplaceClassNameWithReference DESCRIPTION : In parsing an instance-set query, this function replaces a constant class name with an actual pointer to the class INPUTS : The expression RETURNS : TRUE if all OK, FALSE if class cannot be found SIDE EFFECTS : The expression type and value are modified if class is found NOTES : Searches current and imported modules for reference ***************************************************/ static BOOLEAN ReplaceClassNameWithReference( void *theEnv, EXPRESSION *theExp) { char *theClassName; void *theDefclass; if (theExp->type == SYMBOL) { theClassName = ValueToString(theExp->value); theDefclass = (void *) LookupDefclassByMdlOrScope(theEnv,theClassName); if (theDefclass == NULL) { CantFindItemErrorMessage(theEnv,"class",theClassName); return(FALSE); } theExp->type = DEFCLASS_PTR; theExp->value = theDefclass; } return(TRUE); }
globle void SetBreakCommand( void *theEnv) { DATA_OBJECT argPtr; char *argument; void *defrulePtr; if (EnvArgCountCheck(theEnv,"set-break",EXACTLY,1) == -1) return; if (EnvArgTypeCheck(theEnv,"set-break",1,SYMBOL,&argPtr) == FALSE) return; argument = DOToString(argPtr); if ((defrulePtr = EnvFindDefrule(theEnv,argument)) == NULL) { CantFindItemErrorMessage(theEnv,"defrule",argument); return; } EnvSetBreak(theEnv,defrulePtr); }
/*************************************************** NAME : ReplaceTemplateNameWithReference DESCRIPTION : In parsing an fact-set query, this function replaces a constant template name with an actual pointer to the template INPUTS : The expression RETURNS : TRUE if all OK, FALSE if template cannot be found SIDE EFFECTS : The expression type and value are modified if template is found NOTES : Searches current and imported modules for reference ***************************************************/ static intBool ReplaceTemplateNameWithReference( void *theEnv, EXPRESSION *theExp) { const char *theTemplateName; void *theDeftemplate; int count; if (theExp->type == SYMBOL) { theTemplateName = ValueToString(theExp->value); theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,theTemplateName, &count,TRUE,NULL); if (theDeftemplate == NULL) { CantFindItemErrorMessage(theEnv,"deftemplate",theTemplateName); return(FALSE); } if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"deftemplate",theTemplateName); return(FALSE); } theExp->type = DEFTEMPLATE_PTR; theExp->value = theDeftemplate; #if (! RUN_TIME) && (! BLOAD_ONLY) if (! ConstructData(theEnv)->ParsingConstruct) { ConstructData(theEnv)->DanglingConstructs++; } #endif } return(TRUE); }
void *GetFactOrInstanceArgument( UDFContext *context, unsigned int thePosition, UDFValue *item) { Environment *theEnv = context->environment; #if DEFTEMPLATE_CONSTRUCT || OBJECT_SYSTEM void *ptr; #endif /*==============================*/ /* Retrieve the first argument. */ /*==============================*/ UDFNthArgument(context,thePosition,ANY_TYPE_BITS,item); /*==================================================*/ /* Fact and instance addresses are valid arguments. */ /*==================================================*/ if (CVIsType(item,FACT_ADDRESS_BIT)) { if (item->factValue->garbage) { FactRetractedErrorMessage(theEnv,item->factValue); return NULL; } return item->value; } else if (CVIsType(item,INSTANCE_ADDRESS_BIT)) { if (item->instanceValue->garbage) { CantFindItemErrorMessage(theEnv,"instance",item->instanceValue->name->contents,false); return NULL; } return item->value; } /*==================================================*/ /* An integer is a valid argument if it corresponds */ /* to the fact index of an existing fact. */ /*==================================================*/ #if DEFTEMPLATE_CONSTRUCT else if (item->header->type == INTEGER_TYPE) { if ((ptr = (void *) FindIndexedFact(theEnv,item->integerValue->contents)) == NULL) { char tempBuffer[20]; gensprintf(tempBuffer,"f-%lld",item->integerValue->contents); CantFindItemErrorMessage(theEnv,"fact",tempBuffer,false); } return ptr; } #endif /*================================================*/ /* Instance names and symbols are valid arguments */ /* if they correspond to an existing instance. */ /*================================================*/ #if OBJECT_SYSTEM else if (CVIsType(item,INSTANCE_NAME_BIT | SYMBOL_BIT)) { if ((ptr = (void *) FindInstanceBySymbol(theEnv,item->lexemeValue)) == NULL) { CantFindItemErrorMessage(theEnv,"instance",item->lexemeValue->contents,false); } return ptr; } #endif /*========================================*/ /* Any other type is an invalid argument. */ /*========================================*/ ExpectedTypeError2(theEnv,UDFContextFunctionName(context),thePosition); return NULL; }
globle void FactsCommand( void *theEnv) { int argumentCount; long long start = UNSPECIFIED, end = UNSPECIFIED, max = UNSPECIFIED; struct defmodule *theModule; DATA_OBJECT theValue; int argOffset; /*=========================================================*/ /* Determine the number of arguments to the facts command. */ /*=========================================================*/ if ((argumentCount = EnvArgCountCheck(theEnv,(char*)"facts",NO_MORE_THAN,4)) == -1) return; /*==================================*/ /* The default module for the facts */ /* command is the current module. */ /*==================================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); /*==========================================*/ /* If no arguments were specified, then use */ /* the default values to list the facts. */ /*==========================================*/ if (argumentCount == 0) { EnvFacts(theEnv,WDISPLAY,theModule,start,end,max); return; } /*========================================================*/ /* Since there are one or more arguments, see if a module */ /* or start index was specified as the first argument. */ /*========================================================*/ EnvRtnUnknown(theEnv,1,&theValue); /*===============================================*/ /* If the first argument is a symbol, then check */ /* to see that a valid module was specified. */ /*===============================================*/ if (theValue.type == SYMBOL) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theValue.value)); if ((theModule == NULL) && (strcmp(ValueToString(theValue.value),"*") != 0)) { SetEvaluationError(theEnv,TRUE); CantFindItemErrorMessage(theEnv,(char*)"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,(char*)"facts",1,(char*)"symbol or positive number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } argOffset = 0; } /*==========================================*/ /* Otherwise the first argument is invalid. */ /*==========================================*/ else { ExpectedTypeError1(theEnv,(char*)"facts",1,(char*)"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,start,end,max); }
globle void RetractCommand( void *theEnv) { long long 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,(char*)"retract",argNumber,(char*)"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]; gensprintf(tempBuffer,"f-%lld",factIndex); CantFindItemErrorMessage(theEnv,(char*)"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,(char*)"retract",argNumber,(char*)"fact-address, fact-index, or the symbol *"); SetEvaluationError(theEnv,TRUE); } } }
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); }
static void DuplicateModifyCommand( void *theEnv, int retractIt, DATA_OBJECT_PTR returnValue) { long int factNum; struct fact *oldFact, *newFact, *theFact; struct expr *testPtr; DATA_OBJECT computeResult; struct deftemplate *templatePtr; struct templateSlot *slotPtr; int i, position, found; /*===================================================*/ /* Set the default return value to the symbol FALSE. */ /*===================================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,SymbolData(theEnv)->FalseSymbol); /*==================================================*/ /* Evaluate the first argument which is used to get */ /* a pointer to the fact to be modified/duplicated. */ /*==================================================*/ testPtr = GetFirstArgument(); EvaluateExpression(theEnv,testPtr,&computeResult); /*==============================================================*/ /* If an integer is supplied, then treat it as a fact-index and */ /* search the fact-list for the fact with that fact-index. */ /*==============================================================*/ if (computeResult.type == INTEGER) { factNum = ValueToLong(computeResult.value); if (factNum < 0) { if (retractIt) ExpectedTypeError2(theEnv,"modify",1); else ExpectedTypeError2(theEnv,"duplicate",1); SetEvaluationError(theEnv,TRUE); return; } oldFact = (struct fact *) EnvGetNextFact(theEnv,NULL); while (oldFact != NULL) { if (oldFact->factIndex == factNum) { break; } else { oldFact = oldFact->nextFact; } } if (oldFact == NULL) { char tempBuffer[20]; sprintf(tempBuffer,"f-%ld",factNum); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); return; } } /*==========================================*/ /* Otherwise, if a pointer is supplied then */ /* no lookup is required. */ /*==========================================*/ else if (computeResult.type == FACT_ADDRESS) { oldFact = (struct fact *) computeResult.value; } /*===========================================*/ /* Otherwise, the first argument is invalid. */ /*===========================================*/ else { if (retractIt) ExpectedTypeError2(theEnv,"modify",1); else ExpectedTypeError2(theEnv,"duplicate",1); SetEvaluationError(theEnv,TRUE); return; } /*==================================*/ /* See if it is a deftemplate fact. */ /*==================================*/ templatePtr = oldFact->whichDeftemplate; if (templatePtr->implied) return; /*================================================================*/ /* Duplicate the values from the old fact (skipping multifields). */ /*================================================================*/ newFact = (struct fact *) CreateFactBySize(theEnv,oldFact->theProposition.multifieldLength); newFact->whichDeftemplate = templatePtr; for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++) { newFact->theProposition.theFields[i].type = oldFact->theProposition.theFields[i].type; if (newFact->theProposition.theFields[i].type != MULTIFIELD) { newFact->theProposition.theFields[i].value = oldFact->theProposition.theFields[i].value; } else { newFact->theProposition.theFields[i].value = NULL; } } /*========================*/ /* Start replacing slots. */ /*========================*/ testPtr = testPtr->nextArg; while (testPtr != NULL) { /*============================================================*/ /* If the slot identifier is an integer, then the slot was */ /* previously identified and its position within the template */ /* was stored. Otherwise, the position of the slot within the */ /* deftemplate has to be determined by comparing the name of */ /* the slot against the list of slots for the deftemplate. */ /*============================================================*/ if (testPtr->type == INTEGER) { position = (int) ValueToLong(testPtr->value); } else { found = FALSE; position = 0; slotPtr = templatePtr->slotList; while (slotPtr != NULL) { if (slotPtr->slotName == (SYMBOL_HN *) testPtr->value) { found = TRUE; slotPtr = NULL; } else { slotPtr = slotPtr->next; position++; } } if (! found) { InvalidDeftemplateSlotMessage(theEnv,ValueToString(testPtr->value), ValueToString(templatePtr->header.name)); SetEvaluationError(theEnv,TRUE); ReturnFact(theEnv,newFact); return; } } /*===================================================*/ /* If a single field slot is being replaced, then... */ /*===================================================*/ if (newFact->theProposition.theFields[position].type != MULTIFIELD) { /*======================================================*/ /* If the list of values to store in the slot is empty */ /* or contains more than one member than an error has */ /* occured because a single field slot can only contain */ /* a single value. */ /*======================================================*/ if ((testPtr->argList == NULL) ? TRUE : (testPtr->argList->nextArg != NULL)) { MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr); ReturnFact(theEnv,newFact); return; } /*===================================================*/ /* Evaluate the expression to be stored in the slot. */ /*===================================================*/ EvaluateExpression(theEnv,testPtr->argList,&computeResult); SetEvaluationError(theEnv,FALSE); /*====================================================*/ /* If the expression evaluated to a multifield value, */ /* then an error occured since a multifield value can */ /* not be stored in a single field slot. */ /*====================================================*/ if (computeResult.type == MULTIFIELD) { ReturnFact(theEnv,newFact); MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr); return; } /*=============================*/ /* Store the value in the slot */ /*=============================*/ newFact->theProposition.theFields[position].type = computeResult.type; newFact->theProposition.theFields[position].value = computeResult.value; } /*=================================*/ /* Else replace a multifield slot. */ /*=================================*/ else { /*======================================*/ /* Determine the new value of the slot. */ /*======================================*/ StoreInMultifield(theEnv,&computeResult,testPtr->argList,FALSE); SetEvaluationError(theEnv,FALSE); /*=============================*/ /* Store the value in the slot */ /*=============================*/ newFact->theProposition.theFields[position].type = computeResult.type; newFact->theProposition.theFields[position].value = computeResult.value; } testPtr = testPtr->nextArg; } /*=====================================*/ /* Copy the multifield values from the */ /* old fact that were not replaced. */ /*=====================================*/ for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++) { if ((newFact->theProposition.theFields[i].type == MULTIFIELD) && (newFact->theProposition.theFields[i].value == NULL)) { newFact->theProposition.theFields[i].value = CopyMultifield(theEnv,(struct multifield *) oldFact->theProposition.theFields[i].value); } } /*======================================*/ /* Perform the duplicate/modify action. */ /*======================================*/ if (retractIt) EnvRetract(theEnv,oldFact); theFact = (struct fact *) EnvAssert(theEnv,newFact); /*========================================*/ /* The asserted fact is the return value. */ /*========================================*/ if (theFact != NULL) { SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,theFact->theProposition.multifieldLength); SetpType(returnValue,FACT_ADDRESS); SetpValue(returnValue,(void *) theFact); } return; }
//madianyi End globle void UpdateCommand( void *theEnv, DATA_OBJECT_PTR rv) { long long factIndex; struct fact *oldFact, *newFact, *theFact; struct defrule *ExecutingRule = NULL; struct expr *testPtr; DATA_OBJECT computeResult; /*===================================================*/ /* Set the default return value to the symbol FALSE. */ /*===================================================*/ SetpType(rv,SYMBOL); SetpValue(rv,EnvFalseSymbol(theEnv)); /*==================================================*/ /* Evaluate the first argument which is used to get */ /* a pointer to the fact to be updated. */ /*==================================================*/ testPtr = GetFirstArgument(); EnvIncrementClearReadyLocks(theEnv); EvaluateExpression(theEnv,testPtr,&computeResult); EnvDecrementClearReadyLocks(theEnv); /*==============================================================*/ /* If an integer is supplied, then treat it as a fact-index and */ /* search the fact-list for the fact with that fact-index. */ /*==============================================================*/ if (computeResult.type == INTEGER) { factIndex = ValueToLong(computeResult.value); if (factIndex < 0) { ExpectedTypeError1(theEnv,"update",1,"fact-address, fact-index, or the symbol *"); return; } /*================================================*/ /* See if a fact with the specified index exists. */ /*================================================*/ oldFact = FindIndexedFact(theEnv,factIndex); if (oldFact == NULL) { char tempBuffer[20]; gensprintf(tempBuffer,"f-%lld",factIndex); CantFindItemErrorMessage(theEnv,"fact",tempBuffer); return; } } /*==========================================*/ /* Otherwise, if a pointer is supplied then */ /* no lookup is required. */ /*==========================================*/ else if (computeResult.type == FACT_ADDRESS) { oldFact = (struct fact *) computeResult.value; } /*============================================*/ /* Otherwise the argument has evaluated to an */ /* illegal value for the retract command. */ /*============================================*/ else { ExpectedTypeError1(theEnv,"update",1,"fact-address, fact-index, or the symbol *"); SetEvaluationError(theEnv,TRUE); } /*============================================*/ /* Retract oldFact and Assert newFact */ /*============================================*/ if (oldFact->localFact != NULL) { newFact = oldFact->localFact; //Remove oldFact from localFactList of ExecutingRule ExecutingRule = EngineData(theEnv)->ExecutingRule; if (oldFact == ExecutingRule->lastLocalFact) { ExecutingRule->lastLocalFact = oldFact->previousLocalFact; } if (oldFact->previousLocalFact == NULL) { ExecutingRule->localFactList = ExecutingRule->localFactList->nextLocalFact; if (ExecutingRule->localFactList != NULL) { ExecutingRule->localFactList->previousLocalFact = NULL; } } else { oldFact->previousLocalFact->nextLocalFact = oldFact->nextLocalFact; if (oldFact->nextLocalFact != NULL) { oldFact->nextLocalFact->previousLocalFact = oldFact->previousLocalFact; } } EnvRetract(theEnv,oldFact); theFact = (struct fact *) EnvAssert(theEnv,(void *) newFact); if (theFact != NULL) { SetpType(rv,FACT_ADDRESS); SetpValue(rv,(void *) theFact); } return; } else { ExpectedTypeError1(theEnv,"update",1,"been set before *"); SetEvaluationError(theEnv,TRUE); } }
globle intBool ParseDefglobal( void *theEnv, char *readSource) { int defglobalError = FALSE; #if (MAC_MCW || IBM_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,"(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,"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,"defglobal"); return(TRUE); } /*=================================*/ /* Determine if the module exists. */ /*=================================*/ theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theToken.value)); if (theModule == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken.value)); return(TRUE); } /*=========================================*/ /* If the module name was OK, then set the */ /* current module to the specified module. */ /*=========================================*/ SavePPBuffer(theEnv," "); 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," "); SavePPBuffer(theEnv,theToken.printForm); } /*======================*/ /* Parse the variables. */ /*======================*/ while (GetVariableDefinition(theEnv,readSource,&defglobalError,tokenRead,&theToken)) { tokenRead = FALSE; FlushPPBuffer(theEnv); SavePPBuffer(theEnv,"(defglobal "); SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)))); SavePPBuffer(theEnv," "); } #endif /*==================================*/ /* Return the parsing error status. */ /*==================================*/ return(defglobalError); }
static int ParseImportSpec( void *theEnv, char *readSource, struct token *theToken, struct defmodule *newModule) { struct defmodule *theModule; struct portItem *thePort, *oldImportSpec; int found, count; /*===========================*/ /* Look for the module name. */ /*===========================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,theToken); if (theToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"defmodule import specification"); return(TRUE); } /*=====================================*/ /* Verify the existence of the module. */ /*=====================================*/ if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theToken->value))) == NULL) { CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken->value)); return(TRUE); } /*========================================*/ /* If the specified module doesn't export */ /* any constructs, then the import */ /* specification is meaningless. */ /*========================================*/ if (theModule->exportList == NULL) { NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),NULL,NULL); return(TRUE); } /*==============================================*/ /* Parse the remaining portion of the import */ /* specification and return if an error occurs. */ /*==============================================*/ oldImportSpec = newModule->importList; if (ParseExportSpec(theEnv,readSource,theToken,newModule,theModule)) return(TRUE); /*========================================================*/ /* If the ?NONE keyword was used with the import spec, */ /* then no constructs were actually imported and the */ /* import spec does not need to be checked for conflicts. */ /*========================================================*/ if (newModule->importList == oldImportSpec) return(FALSE); /*======================================================*/ /* Check to see if the construct being imported can be */ /* by the specified module. This check exported doesn't */ /* guarantee that a specific named construct actually */ /* exists. It just checks that it could be exported if */ /* it does exists. */ /*======================================================*/ if (newModule->importList->constructType != NULL) { /*=============================*/ /* Look for the construct in */ /* the module that exports it. */ /*=============================*/ found = FALSE; for (thePort = theModule->exportList; (thePort != NULL) && (! found); thePort = thePort->next) { if (thePort->constructType == NULL) found = TRUE; else if (thePort->constructType == newModule->importList->constructType) { if (newModule->importList->constructName == NULL) found = TRUE; else if (thePort->constructName == NULL) found = TRUE; else if (thePort->constructName == newModule->importList->constructName) { found = TRUE; } } } /*=======================================*/ /* If it's not exported by the specified */ /* module, print an error message. */ /*=======================================*/ if (! found) { if (newModule->importList->constructName == NULL) { NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule), ValueToString(newModule->importList->constructType), NULL); } else { NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule), ValueToString(newModule->importList->constructType), ValueToString(newModule->importList->constructName)); } return(TRUE); } } /*======================================================*/ /* Verify that specific named constructs actually exist */ /* and can be seen from the module importing them. */ /*======================================================*/ SaveCurrentModule(theEnv); EnvSetCurrentModule(theEnv,(void *) newModule); for (thePort = newModule->importList; thePort != NULL; thePort = thePort->next) { if ((thePort->constructType == NULL) || (thePort->constructName == NULL)) { continue; } theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(thePort->moduleName)); EnvSetCurrentModule(theEnv,theModule); if (FindImportedConstruct(theEnv,ValueToString(thePort->constructType),NULL, ValueToString(thePort->constructName),&count, TRUE,FALSE) == NULL) { NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule), ValueToString(thePort->constructType), ValueToString(thePort->constructName)); RestoreCurrentModule(theEnv); return(TRUE); } } RestoreCurrentModule(theEnv); /*===============================================*/ /* The import list has been successfully parsed. */ /*===============================================*/ return(FALSE); }
void *GetFactOrInstanceArgument( void *theEnv, int thePosition, DATA_OBJECT *item, char *functionName) { #if DEFTEMPLATE_CONSTRUCT || OBJECT_SYSTEM void *ptr; #endif /*==============================*/ /* 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); }