/*************************************************** NAME : LookupDefclassByMdlOrScope DESCRIPTION : Finds a class anywhere (if module is specified) or in current or imported modules INPUTS : The class name RETURNS : The class (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : Assumes no two classes of the same name are ever in the same scope ***************************************************/ globle DEFCLASS *LookupDefclassByMdlOrScope( void *theEnv, const char *classAndModuleName) { DEFCLASS *cls; const char *className; SYMBOL_HN *classSymbol; struct defmodule *theModule; if (FindModuleSeparator(classAndModuleName) == FALSE) return(LookupDefclassInScope(theEnv,classAndModuleName)); SaveCurrentModule(theEnv); className = ExtractModuleAndConstructName(theEnv,classAndModuleName); theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); RestoreCurrentModule(theEnv); if(className == NULL) return(NULL); if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL) return(NULL); cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)]; while (cls != NULL) { if ((cls->header.name == classSymbol) && (cls->header.whichModule->theModule == theModule)) return(cls->installed ? cls : NULL); cls = cls->nxtHash; } return(NULL); }
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)); }
globle int FindImportExportConflict( void *theEnv, char *constructName, struct defmodule *matchModule, char *findName) { struct defmodule *theModule; struct moduleItem *theModuleItem; int count; /*===========================================================*/ /* If the construct type can't be imported or exported, then */ /* it's not possible to have an import/export conflict. */ /*===========================================================*/ if (ValidPortConstructItem(theEnv,constructName) == NULL) return(FALSE); /*============================================*/ /* There module name should already have been */ /* separated fromthe construct's name. */ /*============================================*/ if (FindModuleSeparator(findName)) return(FALSE); /*===============================================================*/ /* The construct must be capable of being stored within a module */ /* (this test should never fail). The construct must also have */ /* a find function associated with it so we can actually look */ /* for import/export conflicts. */ /*===============================================================*/ if ((theModuleItem = FindModuleItem(theEnv,constructName)) == NULL) return(FALSE); if (theModuleItem->findFunction == NULL) return(FALSE); /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*================================================================*/ /* Look at each module and count each definition of the specified */ /* construct which is visible to the module. If more than one */ /* definition is visible, then an import/export conflict exists */ /* and TRUE is returned. */ /*================================================================*/ for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL); theModule != NULL; theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule)) { EnvSetCurrentModule(theEnv,(void *) theModule); FindImportedConstruct(theEnv,constructName,NULL,findName,&count,TRUE,matchModule); if (count > 1) { RestoreCurrentModule(theEnv); return(TRUE); } } /*==========================================*/ /* Restore the current module. No conflicts */ /* were detected so FALSE is returned. */ /*==========================================*/ RestoreCurrentModule(theEnv); return(FALSE); }
globle struct expr *GetRHSPattern( char *readSource, struct token *tempToken, int *error, int constantsOnly, int readFirstParen, int checkFirstParen, int endType) { struct expr *lastOne = NULL; struct expr *nextOne, *firstOne, *argHead = NULL; int printError, count; struct deftemplate *theDeftemplate; struct symbolHashNode *templateName; /*=================================================*/ /* Get the opening parenthesis of the RHS pattern. */ /*=================================================*/ *error = FALSE; if (readFirstParen) GetToken(readSource,tempToken); if (checkFirstParen) { if (tempToken->type == endType) return(NULL); if (tempToken->type != LPAREN) { SyntaxErrorMessage("RHS patterns"); *error = TRUE; return(NULL); } } /*======================================================*/ /* The first field of an asserted fact must be a symbol */ /* (but not = or : which have special significance). */ /*======================================================*/ GetToken(readSource,tempToken); if (tempToken->type != SYMBOL) { SyntaxErrorMessage("first field of a RHS pattern"); *error = TRUE; return(NULL); } else if ((strcmp(ValueToString(tempToken->value),"=") == 0) || (strcmp(ValueToString(tempToken->value),":") == 0)) { SyntaxErrorMessage("first field of a RHS pattern"); *error = TRUE; return(NULL); } /*=========================================================*/ /* Check to see if the relation name is a reserved symbol. */ /*=========================================================*/ templateName = (struct symbolHashNode *) tempToken->value; if (ReservedPatternSymbol(ValueToString(templateName),NULL)) { ReservedPatternSymbolErrorMsg(ValueToString(templateName),"a relation name"); *error = TRUE; return(NULL); } /*============================================================*/ /* A module separator in the name is illegal in this context. */ /*============================================================*/ if (FindModuleSeparator(ValueToString(templateName))) { IllegalModuleSpecifierMessage(); *error = TRUE; return(NULL); } /*=============================================================*/ /* Determine if there is an associated deftemplate. If so, let */ /* the deftemplate parsing functions parse the RHS pattern and */ /* then return the fact pattern that was parsed. */ /*=============================================================*/ theDeftemplate = (struct deftemplate *) FindImportedConstruct("deftemplate",NULL,ValueToString(templateName), &count,TRUE,NULL); if (count > 1) { AmbiguousReferenceErrorMessage("deftemplate",ValueToString(templateName)); *error = TRUE; return(NULL); } /*======================================================*/ /* If no deftemplate exists with the specified relation */ /* name, then create an implied deftemplate. */ /*======================================================*/ if (theDeftemplate == NULL) #if (! BLOAD_ONLY) && (! RUN_TIME) { #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded()) && (! CheckSyntaxMode)) { NoSuchTemplateError(ValueToString(templateName)); *error = TRUE; return(NULL); } #endif #if DEFMODULE_CONSTRUCT if (FindImportExportConflict("deftemplate",((struct defmodule *) GetCurrentModule()),ValueToString(templateName))) { ImportExportConflictMessage("implied deftemplate",ValueToString(templateName),NULL,NULL); *error = TRUE; return(NULL); } #endif if (! CheckSyntaxMode) { theDeftemplate = CreateImpliedDeftemplate((SYMBOL_HN *) templateName,TRUE); } } #else { NoSuchTemplateError(ValueToString(templateName)); *error = TRUE; return(NULL); } #endif /*=========================================*/ /* If an explicit deftemplate exists, then */ /* parse the fact as a deftemplate fact. */ /*=========================================*/ if ((theDeftemplate != NULL) && (theDeftemplate->implied == FALSE)) { firstOne = GenConstant(DEFTEMPLATE_PTR,theDeftemplate); firstOne->nextArg = ParseAssertTemplate(readSource,tempToken, error,endType, constantsOnly,theDeftemplate); if (*error) { ReturnExpression(firstOne); firstOne = NULL; } return(firstOne); } /*========================================*/ /* Parse the fact as an ordered RHS fact. */ /*========================================*/ firstOne = GenConstant(DEFTEMPLATE_PTR,theDeftemplate); #if (! RUN_TIME) && (! BLOAD_ONLY) SavePPBuffer(" "); #endif while ((nextOne = GetAssertArgument(readSource,tempToken, error,endType,constantsOnly,&printError)) != NULL) { if (argHead == NULL) argHead = nextOne; else lastOne->nextArg = nextOne; lastOne = nextOne; #if (! RUN_TIME) && (! BLOAD_ONLY) SavePPBuffer(" "); #endif } /*===========================================================*/ /* If an error occurred, set the error flag and return NULL. */ /*===========================================================*/ if (*error) { if (printError) SyntaxErrorMessage("RHS patterns"); ReturnExpression(firstOne); ReturnExpression(argHead); return(NULL); } /*=====================================*/ /* Fix the pretty print representation */ /* of the RHS ordered fact. */ /*=====================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) PPBackup(); PPBackup(); SavePPBuffer(tempToken->printForm); #endif /*==========================================================*/ /* Ordered fact assertions are processed by stuffing all of */ /* the fact's proposition (except the relation name) into a */ /* single multifield slot. */ /*==========================================================*/ firstOne->nextArg = GenConstant(FACT_STORE_MULTIFIELD,AddBitMap("\0",1)); firstOne->nextArg->argList = argHead; /*==============================*/ /* Return the RHS ordered fact. */ /*==============================*/ return(firstOne); }
globle struct lhsParseNode *FactPatternParse( void *theEnv, char *readSource, struct token *theToken) { struct deftemplate *theDeftemplate; int count; /*=========================================*/ /* A module separator can not be included */ /* as part of the pattern's relation name. */ /*=========================================*/ if (FindModuleSeparator(ValueToString(theToken->value))) { IllegalModuleSpecifierMessage(theEnv); return(NULL); } /*=========================================================*/ /* Find the deftemplate associated with the relation name. */ /*=========================================================*/ theDeftemplate = (struct deftemplate *) FindImportedConstruct(theEnv,"deftemplate",NULL,ValueToString(theToken->value), &count,TRUE,NULL); if (count > 1) { AmbiguousReferenceErrorMessage(theEnv,"deftemplate",ValueToString(theToken->value)); return(NULL); } /*======================================================*/ /* If no deftemplate exists with the specified relation */ /* name, then create an implied deftemplate. */ /*======================================================*/ if (theDeftemplate == NULL) { #if DEFMODULE_CONSTRUCT if (FindImportExportConflict(theEnv,"deftemplate",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(theToken->value))) { ImportExportConflictMessage(theEnv,"implied deftemplate",ValueToString(theToken->value),NULL,NULL); return(NULL); } #endif /* DEFMODULE_CONSTRUCT */ if (! ConstructData(theEnv)->CheckSyntaxMode) { theDeftemplate = CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) theToken->value,TRUE); } else { theDeftemplate = NULL; } } /*===============================================*/ /* If an explicit deftemplate exists, then parse */ /* the pattern as a deftemplate pattern. */ /*===============================================*/ if ((theDeftemplate != NULL) && (theDeftemplate->implied == FALSE)) { return(DeftemplateLHSParse(theEnv,readSource,theDeftemplate)); } /*================================*/ /* Parse an ordered fact pattern. */ /*================================*/ return(SequenceRestrictionParse(theEnv,readSource,theToken)); }
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); }
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); }
globle void *FindImportedConstruct( void *theEnv, EXEC_STATUS, char *constructName, struct defmodule *matchModule, char *findName, int *count, int searchCurrent, struct defmodule *notYetDefinedInModule) { void *rv; struct moduleItem *theModuleItem; /*=============================================*/ /* Set the number of references found to zero. */ /*=============================================*/ *count = 0; /*===============================*/ /* The :: should not be included */ /* in the construct's name. */ /*===============================*/ if (FindModuleSeparator(findName)) return(NULL); /*=============================================*/ /* Remember the current module since we'll be */ /* changing it during the search and will want */ /* to restore it once the search is completed. */ /*=============================================*/ SaveCurrentModule(theEnv,execStatus); /*==========================================*/ /* Find the module related access functions */ /* for the construct type being sought. */ /*==========================================*/ if ((theModuleItem = FindModuleItem(theEnv,execStatus,constructName)) == NULL) { RestoreCurrentModule(theEnv,execStatus); return(NULL); } /*===========================================*/ /* If the construct type doesn't have a find */ /* function, then we can't look for it. */ /*===========================================*/ if (theModuleItem->findFunction == NULL) { RestoreCurrentModule(theEnv,execStatus); return(NULL); } /*==================================*/ /* Initialize the search by marking */ /* all modules as unvisited. */ /*==================================*/ MarkModulesAsUnvisited(theEnv,execStatus); /*===========================*/ /* Search for the construct. */ /*===========================*/ rv = SearchImportedConstructModules(theEnv,execStatus,(SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,constructName), matchModule,theModuleItem, (SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,findName),count, searchCurrent,notYetDefinedInModule); /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv,execStatus); /*====================================*/ /* Return a pointer to the construct. */ /*====================================*/ return(rv); }
globle struct expr *Function2Parse( void *theEnv, char *logicalName, char *name) { struct FunctionDefinition *theFunction; struct expr *top; #if DEFGENERIC_CONSTRUCT void *gfunc; #endif #if DEFFUNCTION_CONSTRUCT void *dptr; #endif /*=========================================================*/ /* Module specification cannot be used in a function call. */ /*=========================================================*/ if (FindModuleSeparator(name)) { IllegalModuleSpecifierMessage(theEnv); return(NULL); } /*================================*/ /* Has the function been defined? */ /*================================*/ theFunction = FindFunction(theEnv,name); #if DEFGENERIC_CONSTRUCT gfunc = (void *) LookupDefgenericInScope(theEnv,name); #endif #if DEFFUNCTION_CONSTRUCT if ((theFunction == NULL) #if DEFGENERIC_CONSTRUCT && (gfunc == NULL) #endif ) 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,"EXPRNPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Missing function declaration for "); EnvPrintRouter(theEnv,WERROR,name); EnvPrintRouter(theEnv,WERROR,".\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,"(expansion-call)"), FindFunction(theEnv,"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,"(expansion-call)"), FindFunction(theEnv,"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,"(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); }
/************************************************************** NAME : ParseSuperclasses DESCRIPTION : Parses the (is-a <superclass>+) portion of the (defclass ...) construct and returns a list of direct superclasses. The class "standard-class" is the precedence list for classes with no direct superclasses. The final precedence list (not calculated here) will have the class in question first followed by the merged precedence lists of its direct superclasses. INPUTS : 1) The logical name of the input source 2) The symbolic name of the new class RETURNS : The address of the superclass list or NULL if there was an error SIDE EFFECTS : None NOTES : Assumes "(defclass <name> [<comment>] (" has already been scanned. All superclasses must be defined before their subclasses. Duplicates in the (is-a ...) list are are not allowed (a class may only inherits from a superclass once). This routine also checks the class-precedence lists of each of the direct superclasses for an occurrence of the new class - i.e. cycles! This can only happen when a class is redefined (a new class cannot have an unspecified superclass). This routine allocates the space for the list ***************************************************************/ globle PACKED_CLASS_LINKS *ParseSuperclasses( void *theEnv, char *readSource, SYMBOL_HN *newClassName) { CLASS_LINK *clink = NULL,*cbot = NULL,*ctmp; DEFCLASS *sclass; PACKED_CLASS_LINKS *plinks; if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SyntaxErrorMessage(theEnv,(char*)"defclass inheritance"); return(NULL); } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE : (DefclassData(theEnv)->ObjectParseToken.value != (void *) DefclassData(theEnv)->ISA_SYMBOL)) { SyntaxErrorMessage(theEnv,(char*)"defclass inheritance"); return(NULL); } SavePPBuffer(theEnv,(char*)" "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,(char*)"defclass"); goto SuperclassParseError; } if (FindModuleSeparator(ValueToString(newClassName))) { IllegalModuleSpecifierMessage(theEnv); goto SuperclassParseError; } if (GetValue(DefclassData(theEnv)->ObjectParseToken) == (void *) newClassName) { PrintErrorID(theEnv,(char*)"INHERPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"A class may not have itself as a superclass.\n"); goto SuperclassParseError; } for (ctmp = clink ; ctmp != NULL ; ctmp = ctmp->nxt) { if (GetValue(DefclassData(theEnv)->ObjectParseToken) == (void *) ctmp->cls->header.name) { PrintErrorID(theEnv,(char*)"INHERPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"A class may inherit from a superclass only once.\n"); goto SuperclassParseError; } } sclass = LookupDefclassInScope(theEnv,ValueToString(GetValue(DefclassData(theEnv)->ObjectParseToken))); if (sclass == NULL) { PrintErrorID(theEnv,(char*)"INHERPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"A class must be defined after all its superclasses.\n"); goto SuperclassParseError; } if ((sclass == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) || (sclass == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) || (sclass == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0])) { PrintErrorID(theEnv,(char*)"INHERPSR",6,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"A user-defined class cannot be a subclass of "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) sclass)); EnvPrintRouter(theEnv,WERROR,(char*)".\n"); goto SuperclassParseError; } ctmp = get_struct(theEnv,classLink); ctmp->cls = sclass; if (clink == NULL) clink = ctmp; else cbot->nxt = ctmp; ctmp->nxt = NULL; cbot = ctmp; SavePPBuffer(theEnv,(char*)" "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } if (clink == NULL) { PrintErrorID(theEnv,(char*)"INHERPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"Must have at least one superclass.\n"); return(NULL); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,(char*)")"); plinks = get_struct(theEnv,packedClassLinks); PackClassLinks(theEnv,plinks,clink); return(plinks); SuperclassParseError: DeleteClassLinks(theEnv,clink); return(NULL); }
globle struct expr *GetRHSPattern( char *readSource, struct token *tempToken, int *error, int constantsOnly, int readFirstParen, int checkFirstParen, int endType) { struct expr *lastOne = NULL; struct expr *nextOne, *firstOne, *argHead = NULL; int printError, count; struct deftemplate *theDeftemplate; struct symbolHashNode *templateName; /*=================================================*/ /* Get the opening parenthesis of the RHS pattern. */ /*=================================================*/ *error = FALSE; if (readFirstParen) GetToken(readSource,tempToken); if (checkFirstParen) { if (tempToken->type == endType) return(NULL); if (tempToken->type != LPAREN) { SyntaxErrorMessage("RHS patterns"); *error = TRUE; return(NULL); } } /*======================================================*/ /* The first field of an asserted fact must be a symbol */ /* (but not = or : which have special significance). */ /*======================================================*/ GetToken(readSource,tempToken); if (tempToken->type != SYMBOL) { SyntaxErrorMessage("first field of a RHS pattern"); *error = TRUE; return(NULL); } else if ((strcmp(ValueToString(tempToken->value),"=") == 0) || (strcmp(ValueToString(tempToken->value),":") == 0)) { SyntaxErrorMessage("first field of a RHS pattern"); *error = TRUE; return(NULL); } /*=========================================================*/ /* Check to see if the relation name is a reserved symbol. */ /*=========================================================*/ templateName = (struct symbolHashNode *) tempToken->value; if (ReservedPatternSymbol(ValueToString(templateName),NULL)) { ReservedPatternSymbolErrorMsg(ValueToString(templateName),"a relation name"); *error = TRUE; return(NULL); } /*============================================================*/ /* A module separator in the name is illegal in this context. */ /*============================================================*/ if (FindModuleSeparator(ValueToString(templateName))) { IllegalModuleSpecifierMessage(); *error = TRUE; return(NULL); } /*=============================================================*/ /* Determine if there is an associated deftemplate. If so, let */ /* the deftemplate parsing functions parse the RHS pattern and */ /* then return the fact pattern that was parsed. */ /*=============================================================*/ theDeftemplate = (struct deftemplate *) FindImportedConstruct("deftemplate",NULL,ValueToString(templateName), &count,TRUE,NULL); if (count > 1) { AmbiguousReferenceErrorMessage("deftemplate",ValueToString(templateName)); *error = TRUE; return(NULL); } /*======================================================*/ /* If no deftemplate exists with the specified relation */ /* name, then create an implied deftemplate. */ /*======================================================*/ if (theDeftemplate == NULL) #if (! BLOAD_ONLY) && (! RUN_TIME) { #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded()) && (! CheckSyntaxMode)) { NoSuchTemplateError(ValueToString(templateName)); *error = TRUE; return(NULL); } #endif #if DEFMODULE_CONSTRUCT if (FindImportExportConflict("deftemplate",((struct defmodule *) GetCurrentModule()),ValueToString(templateName))) { ImportExportConflictMessage("implied deftemplate",ValueToString(templateName),NULL,NULL); *error = TRUE; return(NULL); } #endif if (! CheckSyntaxMode) { theDeftemplate = CreateImpliedDeftemplate((SYMBOL_HN *) templateName,TRUE); } } #else { NoSuchTemplateError(ValueToString(templateName)); *error = TRUE; return(NULL); } #endif /*=========================================*/ /* If an explicit deftemplate exists, then */ /* parse the fact as a deftemplate fact. */ /*=========================================*/ if ((theDeftemplate != NULL) && (theDeftemplate->implied == FALSE)) { firstOne = GenConstant(DEFTEMPLATE_PTR,theDeftemplate); #if FUZZY_DEFTEMPLATES if (theDeftemplate->fuzzyTemplate != NULL) firstOne->nextArg = ParseAssertFuzzyFact(readSource,tempToken, error,endType, constantsOnly,theDeftemplate, TRUE); else #endif firstOne->nextArg = ParseAssertTemplate(readSource,tempToken, error,endType, constantsOnly,theDeftemplate); if (*error) { ReturnExpression(firstOne); firstOne = NULL; } #if CERTAINTY_FACTORS else { /* if certaintly factors allowed then the next item after a fact specifier COULD be a certainty factor spec --- CF x.xxx */ SavePPBuffer(" "); GetToken(readSource,tempToken); if ((tempToken->type == SYMBOL) && ((strcmp(ValueToString(tempToken->value),"CF") == 0) || (strcmp(ValueToString(tempToken->value),"cf") == 0)) ) { struct expr *CFexpr; /* expecting a certainty factor (float) expression */ /* tokenToFloatExpression expect 1st token already read */ SavePPBuffer(" "); GetToken(readSource,tempToken); CFexpr = tokenToFloatExpression(readSource,tempToken,error,constantsOnly); if (*error) { ReturnExpression(firstOne); return( NULL ); } if (CFexpr->type == FLOAT) /* if constant -- check range */ { double cfval = ValueToDouble(CFexpr->value); if (cfval > 1.0 || cfval < 0.0) { *error = TRUE; ReturnExpression(CFexpr); cfRangeError(); ReturnExpression(firstOne); return( NULL ); } } /* store the CF expression in the argList of the DEFTEMPLATE_PTR expr */ firstOne->argList = CFexpr; } else { /* Do an 'UnGetToken' function here to undo the lookahead for a CF. Also need to PPBackup over the space added before reading the potential CF expression -- UnGetToken does one PPBackup over the token which was added to the PP Buffer */ UnGetToken(tempToken); PPBackup(); } } #endif return(firstOne); } /*========================================*/ /* Parse the fact as an ordered RHS fact. */ /*========================================*/ firstOne = GenConstant(DEFTEMPLATE_PTR,theDeftemplate); #if FUZZY_DEFTEMPLATES /*=============================================*/ /* Fuzzy facts parsed differently */ /*=============================================*/ if (theDeftemplate->fuzzyTemplate != NULL) { firstOne->nextArg = ParseAssertFuzzyFact(readSource,tempToken, error,endType, constantsOnly,theDeftemplate, TRUE); if (*error) { ReturnExpression(firstOne); return(NULL); } } else { /* --- matches } below with FUZZY_DEFTEMPLATES */ #endif /* FUZZY_DEFTEMPLATES */ #if (! RUN_TIME) && (! BLOAD_ONLY) SavePPBuffer(" "); #endif while ((nextOne = GetAssertArgument(readSource,tempToken, error,endType,constantsOnly,&printError)) != NULL) { if (argHead == NULL) argHead = nextOne; else lastOne->nextArg = nextOne; lastOne = nextOne; #if (! RUN_TIME) && (! BLOAD_ONLY) SavePPBuffer(" "); #endif } /*===========================================================*/ /* If an error occurred, set the error flag and return NULL. */ /*===========================================================*/ if (*error) { if (printError) SyntaxErrorMessage("RHS patterns"); ReturnExpression(firstOne); ReturnExpression(argHead); return(NULL); } /*=====================================*/ /* Fix the pretty print representation */ /* of the RHS ordered fact. */ /*=====================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) PPBackup(); PPBackup(); SavePPBuffer(tempToken->printForm); #endif /*==========================================================*/ /* Ordered fact assertions are processed by stuffing all of */ /* the fact's proposition (except the relation name) into a */ /* single multifield slot. */ /*==========================================================*/ firstOne->nextArg = GenConstant(FACT_STORE_MULTIFIELD,AddBitMap("\0",1)); firstOne->nextArg->argList = argHead; #if FUZZY_DEFTEMPLATES } /* --- matches else { above with FUZZY_DEFTEMPLATES */ #endif #if CERTAINTY_FACTORS /* if certaintly factors allowed then the next item after a fact specifier could be a certainty factor spec --- CF x.xxx */ #if (! RUN_TIME) && (! BLOAD_ONLY) SavePPBuffer(" "); #endif GetToken(readSource,tempToken); if ((tempToken->type == SYMBOL) && ((strcmp(ValueToString(tempToken->value),"CF") == 0) || (strcmp(ValueToString(tempToken->value),"cf") == 0)) ) { struct expr *CFexpr; /* expecting a certainty factor (float) expression */ /* tokenToFloatExpression expect 1st token already read */ #if (! RUN_TIME) && (! BLOAD_ONLY) SavePPBuffer(" "); #endif GetToken(readSource,tempToken); CFexpr = tokenToFloatExpression(readSource,tempToken,error,constantsOnly); if (*error) { ReturnExpression(firstOne); return( NULL ); } if (CFexpr->type == FLOAT) /* if constant -- check range */ { double cfval = ValueToDouble(CFexpr->value); if (cfval > 1.0 || cfval < 0.0) { *error = TRUE; ReturnExpression(CFexpr); cfRangeError(); ReturnExpression(firstOne); return( NULL ); } } /* store the CF expression in the argList of the DEFTEMPLATE_PTR expr */ firstOne->argList = CFexpr; } else { /* Do an 'UnGetToken' function here to undo the lookahead for a CF. Also need to PPBackup over the space added before reading the potential CF expression -- UnGetToken does one PPBackup over the token which was added to the PP Buffer */ UnGetToken(tempToken); #if (! RUN_TIME) && (! BLOAD_ONLY) PPBackup(); #endif } #endif /* CERTAINTY_FACTORS */ /*==============================*/ /* Return the RHS ordered fact. */ /*==============================*/ return(firstOne); }