globle intBool ConstructExported( void *theEnv, EXEC_STATUS, char *constructTypeStr, struct symbolHashNode *moduleName, struct symbolHashNode *findName) { struct symbolHashNode *constructType; struct defmodule *theModule; struct portItem *theExportList; constructType = FindSymbolHN(theEnv,execStatus,constructTypeStr); theModule = (struct defmodule *) EnvFindDefmodule(theEnv,execStatus,ValueToString(moduleName)); if ((constructType == NULL) || (theModule == NULL) || (findName == NULL)) { return(FALSE); } theExportList = theModule->exportList; while (theExportList != NULL) { if ((theExportList->constructType == NULL) || (theExportList->constructType == constructType)) { if ((theExportList->constructName == NULL) || (theExportList->constructName == findName)) { return TRUE; } } theExportList = theExportList->next; } return FALSE; }
static void ClearDefrules( void *theEnv) { struct defmodule *theModule; theModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); EnvFocus(theEnv,(void *) theModule); }
static void ClearDefrules( void *theEnv, EXEC_STATUS) { struct defmodule *theModule; theModule = (struct defmodule *) EnvFindDefmodule(theEnv,execStatus,"MAIN"); EnvFocus(theEnv,execStatus,(void *) theModule); }
static void ResetDefrules( void *theEnv) { struct defmodule *theModule; DefruleData(theEnv)->CurrentEntityTimeTag = 0L; EnvClearFocusStack(theEnv); theModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); EnvFocus(theEnv,(void *) theModule); }
globle void GetFactListFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { struct defmodule *theModule; DATA_OBJECT result; int numArgs; /*===========================================*/ /* Determine if a module name was specified. */ /*===========================================*/ if ((numArgs = EnvArgCountCheck(theEnv,"get-fact-list",NO_MORE_THAN,1)) == -1) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } if (numArgs == 1) { EnvRtnUnknown(theEnv,1,&result); if (GetType(result) != SYMBOL) { EnvSetMultifieldErrorValue(theEnv,returnValue); ExpectedTypeError1(theEnv,"get-fact-list",1,"defmodule name"); return; } if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL) { if (strcmp("*",DOToString(result)) != 0) { EnvSetMultifieldErrorValue(theEnv,returnValue); ExpectedTypeError1(theEnv,"get-fact-list",1,"defmodule name"); return; } theModule = NULL; } } else { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); } /*=====================*/ /* Get the constructs. */ /*=====================*/ EnvGetFactList(theEnv,returnValue,theModule); }
globle struct defmodule *GetModuleName( void *theEnv, char *functionName, int whichArgument, int *error) { DATA_OBJECT result; struct defmodule *theModule; *error = FALSE; /*========================*/ /* Retrieve the argument. */ /*========================*/ EnvRtnUnknown(theEnv,whichArgument,&result); /*=================================*/ /* A module name must be a symbol. */ /*=================================*/ if (GetType(result) != SYMBOL) { ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name"); *error = TRUE; return(NULL); } /*=======================================*/ /* Check to see that the symbol actually */ /* corresponds to a defined module. */ /*=======================================*/ if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL) { if (strcmp("*",DOToString(result)) != 0) { ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name"); *error = TRUE; } return(NULL); } /*=================================*/ /* Return a pointer to the module. */ /*=================================*/ return(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 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 char *ExtractModuleAndConstructName( void *theEnv, EXEC_STATUS, char *theName) { unsigned separatorPosition; SYMBOL_HN *moduleName, *shortName; struct defmodule *theModule; /*========================*/ /* Find the :: separator. */ /*========================*/ separatorPosition = FindModuleSeparator(theName); if (! separatorPosition) return(theName); /*==========================*/ /* Extract the module name. */ /*==========================*/ moduleName = ExtractModuleName(theEnv,execStatus,separatorPosition,theName); if (moduleName == NULL) return(NULL); /*====================================*/ /* Check to see if the module exists. */ /*====================================*/ theModule = (struct defmodule *) EnvFindDefmodule(theEnv,execStatus,ValueToString(moduleName)); if (theModule == NULL) return(NULL); /*============================*/ /* Change the current module. */ /*============================*/ EnvSetCurrentModule(theEnv,execStatus,(void *) theModule); /*=============================*/ /* Extract the construct name. */ /*=============================*/ shortName = ExtractConstructName(theEnv,execStatus,separatorPosition,theName); if (shortName == NULL) return(NULL); return(ValueToString(shortName)); }
static void ResetDefrules( void *theEnv, EXEC_STATUS) { struct defmodule *theModule; struct joinLink *theLink; struct partialMatch *notParent; DefruleData(theEnv,execStatus)->CurrentEntityTimeTag = 1L; EnvClearFocusStack(theEnv,execStatus); theModule = (struct defmodule *) EnvFindDefmodule(theEnv,execStatus,"MAIN"); EnvFocus(theEnv,execStatus,(void *) theModule); for (theLink = DefruleData(theEnv,execStatus)->RightPrimeJoins; theLink != NULL; theLink = theLink->next) { PosEntryRetractAlpha(theEnv,execStatus,theLink->join->rightMemory->beta[0]); } for (theLink = DefruleData(theEnv,execStatus)->LeftPrimeJoins; theLink != NULL; theLink = theLink->next) { if ((theLink->join->patternIsNegated || theLink->join->joinFromTheRight) && (! theLink->join->patternIsExists)) { notParent = theLink->join->leftMemory->beta[0]; if (notParent->marker) { RemoveBlockedLink(notParent); } /*==========================================================*/ /* Prevent any retractions from generating partial matches. */ /*==========================================================*/ notParent->marker = notParent; if (notParent->children != NULL) { PosEntryRetractBeta(theEnv,execStatus,notParent,notParent->children); } /* if (notParent->dependents != NULL) { RemoveLogicalSupport(theEnv,execStatus,notParent); } */ } } }
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); }
static struct activation *NextActivationToFire( void *theEnv) { struct activation *theActivation; struct defmodule *theModule; /*====================================*/ /* If there is no current focus, then */ /* focus on the MAIN module. */ /*====================================*/ if (EngineData(theEnv)->CurrentFocus == NULL) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); EnvFocus(theEnv,theModule); } /*===========================================================*/ /* Determine the top activation on the agenda of the current */ /* focus. If the current focus has no activations on its */ /* agenda, then pop the focus off the focus stack until */ /* a focus that has an activation on its agenda is found. */ /*===========================================================*/ theActivation = EngineData(theEnv)->CurrentFocus->theDefruleModule->agenda; while ((theActivation == NULL) && (EngineData(theEnv)->CurrentFocus != NULL)) { if (EngineData(theEnv)->CurrentFocus != NULL) EnvPopFocus(theEnv); if (EngineData(theEnv)->CurrentFocus != NULL) theActivation = EngineData(theEnv)->CurrentFocus->theDefruleModule->agenda; } /*=========================================*/ /* Return the next activation to be fired. */ /*=========================================*/ return(theActivation); }
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); }
globle int ParseDefmodule( void *theEnv, char *readSource) { SYMBOL_HN *defmoduleName; struct defmodule *newDefmodule; struct token inputToken; int i; struct moduleItem *theItem; struct portItem *portSpecs, *nextSpec; struct defmoduleItemHeader *theHeader; struct callFunctionItem *defineFunctions; struct defmodule *redefiningMainModule = NULL; int parseError; struct portItem *oldImportList = NULL, *oldExportList = NULL; short overwrite = FALSE; /*================================================*/ /* Flush the buffer which stores the pretty print */ /* representation for a module. Add the already */ /* parsed keyword defmodule to this buffer. */ /*================================================*/ SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defmodule "); /*===============================*/ /* Modules cannot be loaded when */ /* a binary load is in effect. */ /*===============================*/ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defmodule"); return(TRUE); } #endif /*=====================================================*/ /* Parse the name and comment fields of the defmodule. */ /* Remove the defmodule if it already exists. */ /*=====================================================*/ defmoduleName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"defmodule", EnvFindDefmodule,DeleteDefmodule,"+", TRUE,TRUE,FALSE); if (defmoduleName == NULL) { return(TRUE); } if (strcmp(ValueToString(defmoduleName),"MAIN") == 0) { redefiningMainModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); } /*==============================================*/ /* Create the defmodule structure if necessary. */ /*==============================================*/ if (redefiningMainModule == NULL) { newDefmodule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(defmoduleName)); if (newDefmodule) { overwrite = TRUE; } else { newDefmodule = get_struct(theEnv,defmodule); newDefmodule->name = defmoduleName; newDefmodule->usrData = NULL; newDefmodule->next = NULL; } } else { overwrite = TRUE; newDefmodule = redefiningMainModule; } if (overwrite) { oldImportList = newDefmodule->importList; oldExportList = newDefmodule->exportList; } newDefmodule->importList = NULL; newDefmodule->exportList = NULL; /*===================================*/ /* Finish parsing the defmodule (its */ /* import/export specifications). */ /*===================================*/ parseError = ParsePortSpecifications(theEnv,readSource,&inputToken,newDefmodule); /*====================================*/ /* Check for import/export conflicts. */ /*====================================*/ if (! parseError) parseError = FindMultiImportConflict(theEnv,newDefmodule); /*======================================================*/ /* If an error occured in parsing or an import conflict */ /* was detected, abort the definition of the defmodule. */ /* If we're only checking syntax, then we want to exit */ /* at this point as well. */ /*======================================================*/ if (parseError || ConstructData(theEnv)->CheckSyntaxMode) { while (newDefmodule->importList != NULL) { nextSpec = newDefmodule->importList->next; rtn_struct(theEnv,portItem,newDefmodule->importList); newDefmodule->importList = nextSpec; } while (newDefmodule->exportList != NULL) { nextSpec = newDefmodule->exportList->next; rtn_struct(theEnv,portItem,newDefmodule->exportList); newDefmodule->exportList = nextSpec; } if ((redefiningMainModule == NULL) && (! overwrite)) { rtn_struct(theEnv,defmodule,newDefmodule); } if (overwrite) { newDefmodule->importList = oldImportList; newDefmodule->exportList = oldExportList; } if (parseError) return(TRUE); return(FALSE); } /*===============================================*/ /* Increment the symbol table counts for symbols */ /* used in the defmodule data structures. */ /*===============================================*/ if (redefiningMainModule == NULL) { IncrementSymbolCount(newDefmodule->name); } else { if ((newDefmodule->importList != NULL) || (newDefmodule->exportList != NULL)) { DefmoduleData(theEnv)->MainModuleRedefinable = FALSE; } } for (portSpecs = newDefmodule->importList; portSpecs != NULL; portSpecs = portSpecs->next) { if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName); if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType); if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName); } for (portSpecs = newDefmodule->exportList; portSpecs != NULL; portSpecs = portSpecs->next) { if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName); if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType); if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName); } /*====================================================*/ /* Allocate storage for the module's construct lists. */ /*====================================================*/ if (redefiningMainModule != NULL) { /* Do nothing */ } else if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL; else { newDefmodule->itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems); for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems; (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL); i++, theItem = theItem->next) { if (theItem->allocateFunction == NULL) { newDefmodule->itemsArray[i] = NULL; } else { newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *) (*theItem->allocateFunction)(theEnv); theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i]; theHeader->theModule = newDefmodule; theHeader->firstItem = NULL; theHeader->lastItem = NULL; } } } /*=======================================*/ /* Save the pretty print representation. */ /*=======================================*/ SavePPBuffer(theEnv,"\n"); if (EnvGetConserveMemory(theEnv) == TRUE) { newDefmodule->ppForm = NULL; } else { newDefmodule->ppForm = CopyPPBuffer(theEnv); } /*==============================================*/ /* Add the defmodule to the list of defmodules. */ /*==============================================*/ if (redefiningMainModule == NULL) { if (DefmoduleData(theEnv)->LastDefmodule == NULL) DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule; else DefmoduleData(theEnv)->LastDefmodule->next = newDefmodule; DefmoduleData(theEnv)->LastDefmodule = newDefmodule; newDefmodule->bsaveID = DefmoduleData(theEnv)->NumberOfDefmodules++; } EnvSetCurrentModule(theEnv,(void *) newDefmodule); /*=========================================*/ /* Call any functions required by other */ /* constructs when a new module is defined */ /*=========================================*/ for (defineFunctions = DefmoduleData(theEnv)->AfterModuleDefinedFunctions; defineFunctions != NULL; defineFunctions = defineFunctions->next) { (* (void (*)(void *)) defineFunctions->func)(theEnv); } /*===============================================*/ /* Defmodule successfully parsed with no errors. */ /*===============================================*/ return(FALSE); }
globle void EnvReset( void *theEnv) { struct callFunctionItem *resetPtr; /*=====================================*/ /* The reset command can't be executed */ /* while a reset is in progress. */ /*=====================================*/ if (ConstructData(theEnv)->ResetInProgress) return; ConstructData(theEnv)->ResetInProgress = TRUE; ConstructData(theEnv)->ResetReadyInProgress = TRUE; /*================================================*/ /* If the reset is performed from the top level */ /* command prompt, reset the halt execution flag. */ /*================================================*/ if (UtilityData(theEnv)->CurrentGarbageFrame->topLevel) SetHaltExecution(theEnv,FALSE); /*=======================================================*/ /* Call the before reset function to determine if the */ /* reset should continue. [Used by the some of the */ /* windowed interfaces to query the user whether a */ /* reset should proceed with activations on the agenda.] */ /*=======================================================*/ if ((ConstructData(theEnv)->BeforeResetFunction != NULL) ? ((*ConstructData(theEnv)->BeforeResetFunction)(theEnv) == FALSE) : FALSE) { ConstructData(theEnv)->ResetReadyInProgress = FALSE; ConstructData(theEnv)->ResetInProgress = FALSE; return; } ConstructData(theEnv)->ResetReadyInProgress = FALSE; /*===========================*/ /* Call each reset function. */ /*===========================*/ for (resetPtr = ConstructData(theEnv)->ListOfResetFunctions; (resetPtr != NULL) && (GetHaltExecution(theEnv) == FALSE); resetPtr = resetPtr->next) { if (resetPtr->environmentAware) { (*resetPtr->func)(theEnv); } else { (* (void (*)(void)) resetPtr->func)(); } } /*============================================*/ /* Set the current module to the MAIN module. */ /*============================================*/ EnvSetCurrentModule(theEnv,(void *) EnvFindDefmodule(theEnv,"MAIN")); /*===========================================*/ /* Perform periodic cleanup if the reset was */ /* issued from an embedded controller. */ /*===========================================*/ if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } /*===================================*/ /* A reset is no longer in progress. */ /*===================================*/ ConstructData(theEnv)->ResetInProgress = FALSE; }
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 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 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 struct expr *Function2Parse( void *theEnv, char *logicalName, char *name) { struct FunctionDefinition *theFunction; struct expr *top; int moduleSpecified = FALSE; unsigned position; struct symbolHashNode *moduleName = NULL, *constructName = NULL; #if DEFGENERIC_CONSTRUCT void *gfunc; #endif #if DEFFUNCTION_CONSTRUCT void *dptr; #endif /*=========================================================*/ /* Module specification cannot be used in a function call. */ /*=========================================================*/ if ((position = FindModuleSeparator(name)) != FALSE) { moduleName = ExtractModuleName(theEnv,position,name); constructName = ExtractConstructName(theEnv,position,name); moduleSpecified = TRUE; } /*================================*/ /* Has the function been defined? */ /*================================*/ theFunction = FindFunction(theEnv,name); #if DEFGENERIC_CONSTRUCT if (moduleSpecified) { if (ConstructExported(theEnv,(char*)"defgeneric",moduleName,constructName) || EnvGetCurrentModule(theEnv) == EnvFindDefmodule(theEnv,ValueToString(moduleName))) { gfunc = (void *) EnvFindDefgeneric(theEnv,name); } else { gfunc = NULL; } } else { gfunc = (void *) LookupDefgenericInScope(theEnv,name); } #endif #if DEFFUNCTION_CONSTRUCT if ((theFunction == NULL) #if DEFGENERIC_CONSTRUCT && (gfunc == NULL) #endif ) if (moduleSpecified) { if (ConstructExported(theEnv,(char*)"deffunction",moduleName,constructName) || EnvGetCurrentModule(theEnv) == EnvFindDefmodule(theEnv,ValueToString(moduleName))) { dptr = (void *) EnvFindDeffunction(theEnv,name); } else { dptr = NULL; } } else { dptr = (void *) LookupDeffunctionInScope(theEnv,name); } else dptr = NULL; #endif /*=============================*/ /* Define top level structure. */ /*=============================*/ #if DEFFUNCTION_CONSTRUCT if (dptr != NULL) top = GenConstant(theEnv,PCALL,dptr); else #endif #if DEFGENERIC_CONSTRUCT if (gfunc != NULL) top = GenConstant(theEnv,GCALL,gfunc); else #endif if (theFunction != NULL) top = GenConstant(theEnv,FCALL,theFunction); else { PrintErrorID(theEnv,(char*)"EXPRNPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,(char*)"Missing function declaration for "); EnvPrintRouter(theEnv,WERROR,name); EnvPrintRouter(theEnv,WERROR,(char*)".\n"); return(NULL); } /*=======================================================*/ /* Check to see if function has its own parsing routine. */ /*=======================================================*/ PushRtnBrkContexts(theEnv); ExpressionData(theEnv)->ReturnContext = FALSE; ExpressionData(theEnv)->BreakContext = FALSE; #if DEFGENERIC_CONSTRUCT || DEFFUNCTION_CONSTRUCT if (top->type == FCALL) #endif { if (theFunction->parser != NULL) { top = (*theFunction->parser)(theEnv,top,logicalName); PopRtnBrkContexts(theEnv); if (top == NULL) return(NULL); if (ReplaceSequenceExpansionOps(theEnv,top->argList,top,FindFunction(theEnv,(char*)"(expansion-call)"), FindFunction(theEnv,(char*)"expand$"))) { ReturnExpression(theEnv,top); return(NULL); } return(top); } } /*========================================*/ /* Default parsing routine for functions. */ /*========================================*/ top = CollectArguments(theEnv,top,logicalName); PopRtnBrkContexts(theEnv); if (top == NULL) return(NULL); if (ReplaceSequenceExpansionOps(theEnv,top->argList,top,FindFunction(theEnv,(char*)"(expansion-call)"), FindFunction(theEnv,(char*)"expand$"))) { ReturnExpression(theEnv,top); return(NULL); } /*============================================================*/ /* If the function call uses the sequence expansion operator, */ /* its arguments cannot be checked until runtime. */ /*============================================================*/ if (top->value == (void *) FindFunction(theEnv,(char*)"(expansion-call)")) { return(top); } /*============================*/ /* Check for argument errors. */ /*============================*/ if ((top->type == FCALL) && EnvGetStaticConstraintChecking(theEnv)) { if (CheckExpressionAgainstRestrictions(theEnv,top,theFunction->restrictions,name)) { ReturnExpression(theEnv,top); return(NULL); } } #if DEFFUNCTION_CONSTRUCT else if (top->type == PCALL) { if (CheckDeffunctionCall(theEnv,top->value,CountArguments(top->argList)) == FALSE) { ReturnExpression(theEnv,top); return(NULL); } } #endif /*========================*/ /* Return the expression. */ /*========================*/ return(top); }
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); }