/*********************************************************************** NAME : ParseQueryNoAction DESCRIPTION : Parses the following functions : (any-instancep) (find-first-instance) (find-all-instances) INPUTS : 1) The address of the top node of the query function 2) The logical name of the input RETURNS : The completed expression chain, or NULL on errors SIDE EFFECTS : The expression chain is extended, or the "top" node is deleted on errors NOTES : H/L Syntax : (<function> <query-block>) <query-block> :== (<instance-var>+) <query-expression> <instance-var> :== (<var-name> <class-name>+) Parses into following form : <query-function> | V <query-expression> -> <class-1a> -> <class-1b> -> (QDS) -> <class-2a> -> <class-2b> -> (QDS) -> ... ***********************************************************************/ globle EXPRESSION *ParseQueryNoAction( void *theEnv, EXPRESSION *top, char *readSource) { EXPRESSION *insQuerySetVars; struct token queryInputToken; insQuerySetVars = ParseQueryRestrictions(theEnv,top,readSource,&queryInputToken); if (insQuerySetVars == NULL) return(NULL); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); if (ParseQueryTestExpression(theEnv,top,readSource) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } DecrementIndentDepth(theEnv,3); GetToken(theEnv,readSource,&queryInputToken); if (GetType(queryInputToken) != RPAREN) { SyntaxErrorMessage(theEnv,"instance-set query function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,insQuerySetVars); return(NULL); } ReplaceInstanceVariables(theEnv,insQuerySetVars,top->argList,TRUE,0); ReturnExpression(theEnv,insQuerySetVars); return(top); }
/*********************************************************************** NAME : FactParseQueryAction DESCRIPTION : Parses the following functions : (do-for-fact) (do-for-all-facts) (delayed-do-for-all-facts) INPUTS : 1) The address of the top node of the query function 2) The logical name of the input RETURNS : The completed expression chain, or NULL on errors SIDE EFFECTS : The expression chain is extended, or the "top" node is deleted on errors NOTES : H/L Syntax : (<function> <query-block> <query-action>) <query-block> :== (<fact-var>+) <query-expression> <fact-var> :== (<var-name> <template-name>+) Parses into following form : <query-function> | V <query-expression> -> <query-action> -> <template-1a> -> <template-1b> -> (QDS) -> <template-2a> -> <template-2b> -> (QDS) -> ... ***********************************************************************/ globle EXPRESSION *FactParseQueryAction( void *theEnv, EXPRESSION *top, const char *readSource) { EXPRESSION *factQuerySetVars; struct token queryInputToken; factQuerySetVars = ParseQueryRestrictions(theEnv,top,readSource,&queryInputToken); if (factQuerySetVars == NULL) { return(NULL); } IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); if (ParseQueryTestExpression(theEnv,top,readSource) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } PPCRAndIndent(theEnv); if (ParseQueryActionExpression(theEnv,top,readSource,factQuerySetVars,&queryInputToken) == FALSE) { DecrementIndentDepth(theEnv,3); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } DecrementIndentDepth(theEnv,3); if (GetType(queryInputToken) != RPAREN) { SyntaxErrorMessage(theEnv,"fact-set query function"); ReturnExpression(theEnv,top); ReturnExpression(theEnv,factQuerySetVars); return(NULL); } ReplaceFactVariables(theEnv,factQuerySetVars,top->argList,TRUE,0); ReplaceFactVariables(theEnv,factQuerySetVars,top->argList->nextArg,FALSE,0); ReturnExpression(theEnv,factQuerySetVars); return(top); }
/************************************************************* NAME : ParseDefinstancesName DESCRIPTION : Parses definstance name and optional comment and optional "active" keyword INPUTS : 1) The logical name of the input source 2) Buffer to hold flag indicating if definstances should cause pattern-matching to occur during slot-overrides RETURNS : Address of name symbol, or NULL if there was an error SIDE EFFECTS : Token after name or comment is scanned NOTES : Assumes "(definstances" has already been scanned. *************************************************************/ static SYMBOL_HN *ParseDefinstancesName( void *theEnv, char *readSource, int *active) { SYMBOL_HN *dname; *active = FALSE; dname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,(char*)"definstances", EnvFindDefinstances,EnvUndefinstances,(char*)"@", TRUE,FALSE,TRUE); if (dname == NULL) return(NULL); #if DEFRULE_CONSTRUCT if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? FALSE : (strcmp(ValueToString(GetValue(DefclassData(theEnv)->ObjectParseToken)),ACTIVE_RLN) == 0)) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,(char*)" "); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); *active = TRUE; } #endif if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,(char*)" "); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } return(dname); }
/******************************************************************************** NAME : ParseSlotOverrides DESCRIPTION : Forms expressions for slot-overrides INPUTS : 1) The logical name of the input 2) Caller's buffer for error flkag RETURNS : Address override expressions, NULL if none or error. SIDE EFFECTS : Slot-expression built Caller's error flag set NOTES : <slot-override> ::= (<slot-name> <value>*)* goes to <slot-name> --> <dummy-node> --> <slot-name> --> <dummy-node>... | V <value-expression> --> <value-expression> --> ... Assumes first token has already been scanned ********************************************************************************/ globle EXPRESSION *ParseSlotOverrides( void *theEnv, const char *readSource, int *error) { EXPRESSION *top = NULL,*bot = NULL,*theExp; EXPRESSION *theExpNext; while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN) { *error = FALSE; theExp = ArgumentParse(theEnv,readSource,error); if (*error == TRUE) { ReturnExpression(theEnv,top); return(NULL); } else if (theExp == NULL) { SyntaxErrorMessage(theEnv,"slot-override"); *error = TRUE; ReturnExpression(theEnv,top); SetEvaluationError(theEnv,TRUE); return(NULL); } theExpNext = GenConstant(theEnv,SYMBOL,EnvTrueSymbol(theEnv)); if (CollectArguments(theEnv,theExpNext,readSource) == NULL) { *error = TRUE; ReturnExpression(theEnv,top); ReturnExpression(theEnv,theExp); return(NULL); } theExp->nextArg = theExpNext; if (top == NULL) top = theExp; else bot->nextArg = theExp; bot = theExp->nextArg; PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); return(top); }
static struct expr *PrognParse( struct expr *top, char *infile) { struct token tkn; struct expr *tmp; ReturnExpression(top); BreakContext = svContexts->brk; ReturnContext = svContexts->rtn; IncrementIndentDepth(3); PPCRAndIndent(); tmp = GroupActions(infile,&tkn,TRUE,NULL,FALSE); DecrementIndentDepth(3); PPBackup(); PPBackup(); SavePPBuffer(tkn.printForm); return(tmp); }
/******************************************************************************** NAME : ParseSlotOverrides DESCRIPTION : Forms expressions for slot-overrides INPUTS : 1) The logical name of the input 2) Caller's buffer for error flkag RETURNS : Address override expressions, NULL if none or error. SIDE EFFECTS : Slot-expression built Caller's error flag set NOTES : <slot-override> ::= (<slot-name> <value>*)* goes to <slot-name> --> <dummy-node> --> <slot-name> --> <dummy-node>... | V <value-expression> --> <value-expression> --> ... Assumes first token has already been scanned ********************************************************************************/ globle EXPRESSION *ParseSlotOverrides( char *readSource, int *error) { EXPRESSION *top = NULL,*bot = NULL,*exp; while (GetType(ObjectParseToken) == LPAREN) { *error = FALSE; exp = ArgumentParse(readSource,error); if (*error == TRUE) { ReturnExpression(top); return(NULL); } else if (exp == NULL) { SyntaxErrorMessage("slot-override"); *error = TRUE; ReturnExpression(top); SetEvaluationError(TRUE); return(NULL); } exp->nextArg = GenConstant(SYMBOL,TrueSymbol); if (CollectArguments(exp->nextArg,readSource) == NULL) { *error = TRUE; ReturnExpression(top); return(NULL); } if (top == NULL) top = exp; else bot->nextArg = exp; bot = exp->nextArg; PPCRAndIndent(); GetToken(readSource,&ObjectParseToken); } PPBackup(); PPBackup(); SavePPBuffer(ObjectParseToken.print_rep); return(top); }
static struct expr *PrognParse( void *theEnv, struct expr *top, char *infile) { struct token tkn; struct expr *tmp; ReturnExpression(theEnv,top); ExpressionData(theEnv)->BreakContext = ExpressionData(theEnv)->svContexts->brk; ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn; IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); tmp = GroupActions(theEnv,infile,&tkn,TRUE,NULL,FALSE); DecrementIndentDepth(theEnv,3); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,tkn.printForm); return(tmp); }
/*************************************************************************** NAME : ParseDeffunction DESCRIPTION : Parses the deffunction construct INPUTS : The input logical name RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Creates valid deffunction definition NOTES : H/L Syntax : (deffunction <name> [<comment>] (<single-field-varible>* [<multifield-variable>]) <action>*) ***************************************************************************/ globle BOOLEAN ParseDeffunction( void *theEnv, char *readSource) { SYMBOL_HN *deffunctionName; EXPRESSION *actions; EXPRESSION *parameterList; SYMBOL_HN *wildcard; int min,max,lvars,DeffunctionError = FALSE; short overwrite = FALSE, owMin = 0, owMax = 0; DEFFUNCTION *dptr; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(deffunction "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"deffunctions"); return(TRUE); } #endif /* ===================================================== Parse the name and comment fields of the deffunction. ===================================================== */ deffunctionName = GetConstructNameAndComment(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,"deffunction", EnvFindDeffunction,NULL, "!",TRUE,TRUE,TRUE); if (deffunctionName == NULL) return(TRUE); if (ValidDeffunctionName(theEnv,ValueToString(deffunctionName)) == FALSE) return(TRUE); /*==========================*/ /* Parse the argument list. */ /*==========================*/ parameterList = ParseProcParameters(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,NULL,&wildcard, &min,&max,&DeffunctionError,NULL); if (DeffunctionError) return(TRUE); /*===================================================================*/ /* Go ahead and add the deffunction so it can be recursively called. */ /*===================================================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { dptr = (DEFFUNCTION *) EnvFindDeffunction(theEnv,ValueToString(deffunctionName)); if (dptr == NULL) { dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); } else { overwrite = TRUE; owMin = (short) dptr->minNumberOfParameters; owMax = (short) dptr->maxNumberOfParameters; dptr->minNumberOfParameters = min; dptr->maxNumberOfParameters = max; } } else { dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); } if (dptr == NULL) { ReturnExpression(theEnv,parameterList); return(TRUE); } /*==================================================*/ /* Parse the actions contained within the function. */ /*==================================================*/ PPCRAndIndent(theEnv); ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseProcActions(theEnv,"deffunction",readSource, &DeffunctionData(theEnv)->DFInputToken,parameterList,wildcard, NULL,NULL,&lvars,NULL); if (actions == NULL) { ReturnExpression(theEnv,parameterList); if (overwrite) { dptr->minNumberOfParameters = owMin; dptr->maxNumberOfParameters = owMax; } if ((dptr->busy == 0) && (! overwrite)) { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDeffunction(theEnv,dptr); } return(TRUE); } /*==============================================*/ /* If we're only checking syntax, don't add the */ /* successfully parsed deffunction to the KB. */ /*==============================================*/ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,parameterList); ReturnPackedExpression(theEnv,actions); if (overwrite) { dptr->minNumberOfParameters = owMin; dptr->maxNumberOfParameters = owMax; } else { RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr); RemoveDeffunction(theEnv,dptr); } return(FALSE); } /*=============================*/ /* Reformat the closing token. */ /*=============================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DeffunctionData(theEnv)->DFInputToken.printForm); SavePPBuffer(theEnv,"\n"); /*======================*/ /* Add the deffunction. */ /*======================*/ AddDeffunction(theEnv,deffunctionName,actions,min,max,lvars,FALSE); ReturnExpression(theEnv,parameterList); return(DeffunctionError); }
static struct expr *SwitchParse( void *theEnv, struct expr *top, char *infile) { struct token theToken; EXPRESSION *theExp,*chk; int default_count = 0; /*============================*/ /* Process the switch value */ /*============================*/ IncrementIndentDepth(theEnv,3); SavePPBuffer(theEnv," "); top->argList = theExp = ParseAtomOrExpression(theEnv,infile,NULL); if (theExp == NULL) goto SwitchParseError; /*========================*/ /* Parse case statements. */ /*========================*/ GetToken(theEnv,infile,&theToken); while (theToken.type != RPAREN) { PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,theToken.printForm); if (theToken.type != LPAREN) goto SwitchParseErrorAndMessage; GetToken(theEnv,infile,&theToken); SavePPBuffer(theEnv," "); if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"case") == 0)) { if (default_count != 0) goto SwitchParseErrorAndMessage; theExp->nextArg = ParseAtomOrExpression(theEnv,infile,NULL); SavePPBuffer(theEnv," "); if (theExp->nextArg == NULL) goto SwitchParseError; for (chk = top->argList->nextArg ; chk != theExp->nextArg ; chk = chk->nextArg) { if ((chk->type == theExp->nextArg->type) && (chk->value == theExp->nextArg->value) && IdenticalExpression(chk->argList,theExp->nextArg->argList)) { PrintErrorID(theEnv,"PRCDRPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Duplicate case found in switch function.\n"); goto SwitchParseError; } } GetToken(theEnv,infile,&theToken); if ((theToken.type != SYMBOL) ? TRUE : (strcmp(ValueToString(theToken.value),"then") != 0)) goto SwitchParseErrorAndMessage; } else if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"default") == 0)) { if (default_count) goto SwitchParseErrorAndMessage; theExp->nextArg = GenConstant(theEnv,RVOID,NULL); default_count = 1; } else goto SwitchParseErrorAndMessage; theExp = theExp->nextArg; if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; if (ExpressionData(theEnv)->svContexts->brk == TRUE) ExpressionData(theEnv)->BreakContext = TRUE; IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); theExp->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE); DecrementIndentDepth(theEnv,3); ExpressionData(theEnv)->ReturnContext = FALSE; ExpressionData(theEnv)->BreakContext = FALSE; if (theExp->nextArg == NULL) goto SwitchParseError; theExp = theExp->nextArg; PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); GetToken(theEnv,infile,&theToken); } DecrementIndentDepth(theEnv,3); return(top); SwitchParseErrorAndMessage: SyntaxErrorMessage(theEnv,"switch function"); SwitchParseError: ReturnExpression(theEnv,top); DecrementIndentDepth(theEnv,3); return(NULL); }
static struct expr *IfParse( void *theEnv, struct expr *top, char *infile) { struct token theToken; /*============================*/ /* Process the if expression. */ /*============================*/ SavePPBuffer(theEnv," "); top->argList = ParseAtomOrExpression(theEnv,infile,NULL); if (top->argList == NULL) { ReturnExpression(theEnv,top); return(NULL); } /*========================================*/ /* Keyword 'then' must follow expression. */ /*========================================*/ IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); GetToken(theEnv,infile,&theToken); if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"then") != 0)) { SyntaxErrorMessage(theEnv,"if function"); ReturnExpression(theEnv,top); return(NULL); } /*==============================*/ /* Process the if then actions. */ /*==============================*/ PPCRAndIndent(theEnv); if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; if (ExpressionData(theEnv)->svContexts->brk == TRUE) ExpressionData(theEnv)->BreakContext = TRUE; top->argList->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,"else",FALSE); if (top->argList->nextArg == NULL) { ReturnExpression(theEnv,top); return(NULL); } top->argList->nextArg = RemoveUnneededProgn(theEnv,top->argList->nextArg); /*===========================================*/ /* A ')' signals an if then without an else. */ /*===========================================*/ if (theToken.type == RPAREN) { DecrementIndentDepth(theEnv,3); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); return(top); } /*=============================================*/ /* Keyword 'else' must follow if then actions. */ /*=============================================*/ if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"else") != 0)) { SyntaxErrorMessage(theEnv,"if function"); ReturnExpression(theEnv,top); return(NULL); } /*==============================*/ /* Process the if else actions. */ /*==============================*/ PPCRAndIndent(theEnv); top->argList->nextArg->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE); if (top->argList->nextArg->nextArg == NULL) { ReturnExpression(theEnv,top); return(NULL); } top->argList->nextArg->nextArg = RemoveUnneededProgn(theEnv,top->argList->nextArg->nextArg); /*======================================================*/ /* Check for the closing right parenthesis of the if. */ /*======================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"if function"); ReturnExpression(theEnv,top); return(NULL); } /*===========================================*/ /* A ')' signals an if then without an else. */ /*===========================================*/ PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); DecrementIndentDepth(theEnv,3); return(top); }
static struct expr *WhileParse( void *theEnv, struct expr *parse, char *infile) { struct token theToken; int read_first_paren; /*===============================*/ /* Process the while expression. */ /*===============================*/ SavePPBuffer(theEnv," "); parse->argList = ParseAtomOrExpression(theEnv,infile,NULL); if (parse->argList == NULL) { ReturnExpression(theEnv,parse); return(NULL); } /*====================================*/ /* Process the do keyword if present. */ /*====================================*/ GetToken(theEnv,infile,&theToken); if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0)) { read_first_paren = TRUE; PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); } else if (theToken.type == LPAREN) { read_first_paren = FALSE; PPBackup(theEnv); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,theToken.printForm); } else { SyntaxErrorMessage(theEnv,"while function"); ReturnExpression(theEnv,parse); return(NULL); } /*============================*/ /* Process the while actions. */ /*============================*/ if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; ExpressionData(theEnv)->BreakContext = TRUE; parse->argList->nextArg = GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE); if (parse->argList->nextArg == NULL) { ReturnExpression(theEnv,parse); return(NULL); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); /*=======================================================*/ /* Check for the closing right parenthesis of the while. */ /*=======================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"while function"); ReturnExpression(theEnv,parse); return(NULL); } DecrementIndentDepth(theEnv,3); return(parse); }
static struct expr *LoopForCountParse( void *theEnv, struct expr *parse, char *infile) { struct token theToken; SYMBOL_HN *loopVar = NULL; EXPRESSION *tmpexp; int read_first_paren; struct BindInfo *oldBindList,*newBindList,*prev; /*======================================*/ /* Process the loop counter expression. */ /*======================================*/ SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&theToken); /* ========================================== Simple form: loop-for-count <end> [do] ... ========================================== */ if (theToken.type != LPAREN) { parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1L)); parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken); if (parse->argList->nextArg == NULL) { ReturnExpression(theEnv,parse); return(NULL); } } else { GetToken(theEnv,infile,&theToken); if (theToken.type != SF_VARIABLE) { if (theToken.type != SYMBOL) goto LoopForCountParseError; parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1L)); parse->argList->nextArg = Function2Parse(theEnv,infile,ValueToString(theToken.value)); if (parse->argList->nextArg == NULL) { ReturnExpression(theEnv,parse); return(NULL); } } /* ============================================================= Complex form: loop-for-count (<var> [<start>] <end>) [do] ... ============================================================= */ else { loopVar = (SYMBOL_HN *) theToken.value; SavePPBuffer(theEnv," "); parse->argList = ParseAtomOrExpression(theEnv,infile,NULL); if (parse->argList == NULL) { ReturnExpression(theEnv,parse); return(NULL); } if (CheckArgumentAgainstRestriction(theEnv,parse->argList,(int) 'i')) goto LoopForCountParseError; SavePPBuffer(theEnv," "); GetToken(theEnv,infile,&theToken); if (theToken.type == RPAREN) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); tmpexp = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1L)); tmpexp->nextArg = parse->argList; parse->argList = tmpexp; } else { parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken); if (parse->argList->nextArg == NULL) { ReturnExpression(theEnv,parse); return(NULL); } GetToken(theEnv,infile,&theToken); if (theToken.type != RPAREN) goto LoopForCountParseError; } SavePPBuffer(theEnv," "); } } if (CheckArgumentAgainstRestriction(theEnv,parse->argList->nextArg,(int) 'i')) goto LoopForCountParseError; /*====================================*/ /* Process the do keyword if present. */ /*====================================*/ GetToken(theEnv,infile,&theToken); if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0)) { read_first_paren = TRUE; PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,theToken.printForm); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); } else if (theToken.type == LPAREN) { read_first_paren = FALSE; PPBackup(theEnv); IncrementIndentDepth(theEnv,3); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,theToken.printForm); } else goto LoopForCountParseError; /*=====================================*/ /* Process the loop-for-count actions. */ /*=====================================*/ if (ExpressionData(theEnv)->svContexts->rtn == TRUE) ExpressionData(theEnv)->ReturnContext = TRUE; ExpressionData(theEnv)->BreakContext = TRUE; oldBindList = GetParsedBindNames(theEnv); SetParsedBindNames(theEnv,NULL); parse->argList->nextArg->nextArg = GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE); if (parse->argList->nextArg->nextArg == NULL) { SetParsedBindNames(theEnv,oldBindList); ReturnExpression(theEnv,parse); return(NULL); } newBindList = GetParsedBindNames(theEnv); prev = NULL; while (newBindList != NULL) { if ((loopVar == NULL) ? FALSE : (strcmp(ValueToString(newBindList->name),ValueToString(loopVar)) == 0)) { ClearParsedBindNames(theEnv); SetParsedBindNames(theEnv,oldBindList); PrintErrorID(theEnv,"PRCDRPSR",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Cannot rebind loop variable in function loop-for-count.\n"); ReturnExpression(theEnv,parse); return(NULL); } prev = newBindList; newBindList = newBindList->next; } if (prev == NULL) SetParsedBindNames(theEnv,oldBindList); else prev->next = oldBindList; if (loopVar != NULL) ReplaceLoopCountVars(theEnv,loopVar,parse->argList->nextArg->nextArg,0); PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,theToken.printForm); /*================================================================*/ /* Check for the closing right parenthesis of the loop-for-count. */ /*================================================================*/ if (theToken.type != RPAREN) { SyntaxErrorMessage(theEnv,"loop-for-count function"); ReturnExpression(theEnv,parse); return(NULL); } DecrementIndentDepth(theEnv,3); return(parse); LoopForCountParseError: SyntaxErrorMessage(theEnv,"loop-for-count function"); ReturnExpression(theEnv,parse); return(NULL); }
/************************************************************************************* NAME : ParseInitializeInstance DESCRIPTION : Parses initialize-instance and make-instance function calls into an EXPRESSION form that can later be evaluated with EvaluateExpression(theEnv,) INPUTS : 1) The address of the top node of the expression containing the initialize-instance function call 2) The logical name of the input source RETURNS : The address of the modified expression, or NULL if there is an error SIDE EFFECTS : The expression is enhanced to include all aspects of the initialize-instance call (slot-overrides etc.) The "top" expression is deleted on errors. NOTES : This function parses a initialize-instance call into an expression of the following form : (initialize-instance <instance-name> <slot-override>*) where <slot-override> ::= (<slot-name> <expression>+) goes to --> initialize-instance | V <instance or name>-><slot-name>-><dummy-node>... | V <value-expression>... (make-instance <instance> of <class> <slot-override>*) goes to --> make-instance | V <instance-name>-><class-name>-><slot-name>-><dummy-node>... | V <value-expression>... (make-instance of <class> <slot-override>*) goes to --> make-instance | V (gensym*)-><class-name>-><slot-name>-><dummy-node>... | V <value-expression>... (modify-instance <instance> <slot-override>*) goes to --> modify-instance | V <instance or name>-><slot-name>-><dummy-node>... | V <value-expression>... (duplicate-instance <instance> [to <new-name>] <slot-override>*) goes to --> duplicate-instance | V <instance or name>-><new-name>-><slot-name>-><dummy-node>... OR | (gensym*) V <value-expression>... *************************************************************************************/ globle EXPRESSION *ParseInitializeInstance( void *theEnv, EXPRESSION *top, const char *readSource) { int error,fcalltype,readclass; if ((top->value == (void *) FindFunction(theEnv,"make-instance")) || (top->value == (void *) FindFunction(theEnv,"active-make-instance"))) fcalltype = MAKE_TYPE; else if ((top->value == (void *) FindFunction(theEnv,"initialize-instance")) || (top->value == (void *) FindFunction(theEnv,"active-initialize-instance"))) fcalltype = INITIALIZE_TYPE; else if ((top->value == (void *) FindFunction(theEnv,"modify-instance")) || (top->value == (void *) FindFunction(theEnv,"active-modify-instance")) || (top->value == (void *) FindFunction(theEnv,"message-modify-instance")) || (top->value == (void *) FindFunction(theEnv,"active-message-modify-instance"))) fcalltype = MODIFY_TYPE; else fcalltype = DUPLICATE_TYPE; IncrementIndentDepth(theEnv,3); error = FALSE; if (top->type == UNKNOWN_VALUE) top->type = FCALL; else SavePPBuffer(theEnv," "); top->argList = ArgumentParse(theEnv,readSource,&error); if (error) goto ParseInitializeInstanceError; else if (top->argList == NULL) { SyntaxErrorMessage(theEnv,"instance"); goto ParseInitializeInstanceError; } SavePPBuffer(theEnv," "); if (fcalltype == MAKE_TYPE) { /* ====================================== Handle the case of anonymous instances where the name was not specified ====================================== */ if ((top->argList->type != SYMBOL) ? FALSE : (strcmp(ValueToString(top->argList->value),CLASS_RLN) == 0)) { top->argList->nextArg = ArgumentParse(theEnv,readSource,&error); if (error == TRUE) goto ParseInitializeInstanceError; if (top->argList->nextArg == NULL) { SyntaxErrorMessage(theEnv,"instance class"); goto ParseInitializeInstanceError; } if ((top->argList->nextArg->type != SYMBOL) ? TRUE : (strcmp(ValueToString(top->argList->nextArg->value),CLASS_RLN) != 0)) { top->argList->type = FCALL; top->argList->value = (void *) FindFunction(theEnv,"gensym*"); readclass = FALSE; } else readclass = TRUE; } else { GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE : (strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) != 0)) { SyntaxErrorMessage(theEnv,"make-instance"); goto ParseInitializeInstanceError; } SavePPBuffer(theEnv," "); readclass = TRUE; } if (readclass) { top->argList->nextArg = ArgumentParse(theEnv,readSource,&error); if (error) goto ParseInitializeInstanceError; if (top->argList->nextArg == NULL) { SyntaxErrorMessage(theEnv,"instance class"); goto ParseInitializeInstanceError; } } /* ============================================== If the class name is a constant, go ahead and look it up now and replace it with the pointer ============================================== */ if (ReplaceClassNameWithReference(theEnv,top->argList->nextArg) == FALSE) goto ParseInitializeInstanceError; PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); top->argList->nextArg->nextArg = ParseSlotOverrides(theEnv,readSource,&error); } else { PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (fcalltype == DUPLICATE_TYPE) { if ((DefclassData(theEnv)->ObjectParseToken.type != SYMBOL) ? FALSE : (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),DUPLICATE_NAME_REF) == 0)) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv," "); top->argList->nextArg = ArgumentParse(theEnv,readSource,&error); if (error) goto ParseInitializeInstanceError; if (top->argList->nextArg == NULL) { SyntaxErrorMessage(theEnv,"instance name"); goto ParseInitializeInstanceError; } PPCRAndIndent(theEnv); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } else top->argList->nextArg = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"gensym*")); top->argList->nextArg->nextArg = ParseSlotOverrides(theEnv,readSource,&error); } else top->argList->nextArg = ParseSlotOverrides(theEnv,readSource,&error); } if (error) goto ParseInitializeInstanceError; if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,"slot-override"); goto ParseInitializeInstanceError; } DecrementIndentDepth(theEnv,3); return(top); ParseInitializeInstanceError: SetEvaluationError(theEnv,TRUE); ReturnExpression(theEnv,top); DecrementIndentDepth(theEnv,3); return(NULL); }
/*********************************************************************** NAME : ParseDefmessageHandler DESCRIPTION : Parses a message-handler for a class of objects INPUTS : The logical name of the input source RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Handler allocated and inserted into class NOTES : H/L Syntax: (defmessage-handler <class> <name> [<type>] [<comment>] (<params>) <action>*) <params> ::= <var>* | <var>* $?<name> ***********************************************************************/ globle int ParseDefmessageHandler( void *theEnv, char *readSource) { DEFCLASS *cls; SYMBOL_HN *cname,*mname,*wildcard; unsigned mtype = MPRIMARY; int min,max,error,lvars; EXPRESSION *hndParams,*actions; HANDLER *hnd; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defmessage-handler "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defmessage-handler"); return(TRUE); } #endif cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defmessage-handler", NULL,NULL,"~",TRUE,FALSE,DEFMODULE_CONSTRUCT); if (cname == NULL) return(TRUE); cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(cname)); if (cls == NULL) { PrintErrorID(theEnv,"MSGPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"A class must be defined before its message-handlers.\n"); return(TRUE); } if ((cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) || (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) || (cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0])) { PrintErrorID(theEnv,"MSGPSR",8,FALSE); EnvPrintRouter(theEnv,WERROR,"Message-handlers cannot be attached to the class "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls)); EnvPrintRouter(theEnv,WERROR,".\n"); return(TRUE); } if (HandlersExecuting(cls)) { PrintErrorID(theEnv,"MSGPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Cannot (re)define message-handlers during execution of \n"); EnvPrintRouter(theEnv,WERROR," other message-handlers for the same class.\n"); return(TRUE); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defmessage-handler"); return(TRUE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv," "); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv," "); mname = (SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SavePPBuffer(theEnv," "); if (GetType(DefclassData(theEnv)->ObjectParseToken) != STRING) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defmessage-handler"); return(TRUE); } mtype = HandlerType(theEnv,"defmessage-handler",DOToString(DefclassData(theEnv)->ObjectParseToken)); if (mtype == MERROR) return(TRUE); #if ! IMPERATIVE_MESSAGE_HANDLERS if (mtype == MAROUND) return(TRUE); #endif GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING) { SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } } else { SavePPBuffer(theEnv," "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } } PPBackup(theEnv); PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); hnd = FindHandlerByAddress(cls,mname,mtype); if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv)) { EnvPrintRouter(theEnv,WDIALOG," Handler "); EnvPrintRouter(theEnv,WDIALOG,ValueToString(mname)); EnvPrintRouter(theEnv,WDIALOG," "); EnvPrintRouter(theEnv,WDIALOG,MessageHandlerData(theEnv)->hndquals[mtype]); EnvPrintRouter(theEnv,WDIALOG,(char *) ((hnd == NULL) ? " defined.\n" : " redefined.\n")); } if ((hnd != NULL) ? hnd->system : FALSE) { PrintErrorID(theEnv,"MSGPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n"); return(TRUE); } hndParams = GenConstant(theEnv,SYMBOL,(void *) MessageHandlerData(theEnv)->SELF_SYMBOL); hndParams = ParseProcParameters(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,hndParams, &wildcard,&min,&max,&error,IsParameterSlotReference); if (error) return(TRUE); PPCRAndIndent(theEnv); ExpressionData(theEnv)->ReturnContext = TRUE; actions = ParseProcActions(theEnv,"message-handler",readSource, &DefclassData(theEnv)->ObjectParseToken,hndParams,wildcard, SlotReferenceVar,BindSlotReference,&lvars, (void *) cls); if (actions == NULL) { ReturnExpression(theEnv,hndParams); return(TRUE); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,"defmessage-handler"); ReturnExpression(theEnv,hndParams); ReturnPackedExpression(theEnv,actions); return(TRUE); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); SavePPBuffer(theEnv,"\n"); /* =================================================== If we're only checking syntax, don't add the successfully parsed defmessage-handler to the KB. =================================================== */ if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,hndParams); ReturnPackedExpression(theEnv,actions); return(FALSE); } if (hnd != NULL) { ExpressionDeinstall(theEnv,hnd->actions); ReturnPackedExpression(theEnv,hnd->actions); if (hnd->ppForm != NULL) rm(theEnv,(void *) hnd->ppForm, (sizeof(char) * (strlen(hnd->ppForm)+1))); } else { hnd = InsertHandlerHeader(theEnv,cls,mname,(int) mtype); IncrementSymbolCount(hnd->name); } ReturnExpression(theEnv,hndParams); hnd->minParams = min; hnd->maxParams = max; hnd->localVarCount = lvars; hnd->actions = actions; ExpressionInstall(theEnv,hnd->actions); #if DEBUGGING_FUNCTIONS /* =================================================== Old handler trace status is automatically preserved =================================================== */ if (EnvGetConserveMemory(theEnv) == FALSE) hnd->ppForm = CopyPPBuffer(theEnv); else #endif hnd->ppForm = NULL; return(FALSE); }
static struct lhsParseNode *RuleBodyParse( void *theEnv, char *readSource, struct token *theToken, char *ruleName, int *error) { struct lhsParseNode *theNode, *otherNodes; /*=============================*/ /* Set the error return value. */ /*=============================*/ *error = FALSE; /*==================================================*/ /* If we're already at the separator, "=>", between */ /* the LHS and RHS, then the LHS is empty. */ /*==================================================*/ if ((theToken->type == SYMBOL) ? (strcmp(ValueToString(theToken->value),"=>") == 0) : FALSE) { return(NULL); } /*===========================================*/ /* Parse the first pattern as a special case */ /* (the declare statement is allowed). */ /*===========================================*/ theNode = LHSPattern(theEnv,readSource,SYMBOL,"=>",error,TRUE,theToken,ruleName); if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } PPCRAndIndent(theEnv); /*======================================*/ /* Parse the other patterns in the LHS. */ /*======================================*/ otherNodes = GroupPatterns(theEnv,readSource,SYMBOL,"=>",error); if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*================================================*/ /* Construct the final LHS by combining the first */ /* pattern with the remaining patterns. */ /*================================================*/ if (theNode == NULL) { theNode = otherNodes; } else { theNode->bottom = otherNodes; } /*=======================*/ /* Return the final LHS. */ /*=======================*/ return(theNode); }
/*************************************************************************************** NAME : ParseDefclass DESCRIPTION : (defclass ...) is a construct (as opposed to a function), thus no variables may be used. This means classes may only be STATICALLY defined (like rules). INPUTS : The logical name of the router for the parser input RETURNS : FALSE if successful parse, TRUE otherwise SIDE EFFECTS : Inserts valid class definition into Class Table. NOTES : H/L Syntax : (defclass <name> [<comment>] (is-a <superclass-name>+) <class-descriptor>*) <class-descriptor> :== (slot <name> <slot-descriptor>*) | (role abstract|concrete) | (pattern-match reactive|non-reactive) These are for documentation only: (message-handler <name> [<type>]) <slot-descriptor> :== (default <default-expression>) | (default-dynamic <default-expression>) | (storage shared|local) | (access read-only|read-write|initialize-only) | (propagation no-inherit|inherit) | (source composite|exclusive) (pattern-match reactive|non-reactive) (visibility public|private) (override-message <message-name>) (type ...) | (cardinality ...) | (allowed-symbols ...) | (allowed-strings ...) | (allowed-numbers ...) | (allowed-integers ...) | (allowed-floats ...) | (allowed-values ...) | (allowed-instance-names ...) | (allowed-classes ...) | (range ...) <default-expression> ::= ?NONE | ?VARIABLE | <expression>* ***************************************************************************************/ globle int ParseDefclass( void *theEnv, char *readSource) { SYMBOL_HN *cname; DEFCLASS *cls; PACKED_CLASS_LINKS *sclasses,*preclist; TEMP_SLOT_LINK *slots = NULL; int roleSpecified = FALSE, abstract = FALSE, parseError; #if DEFRULE_CONSTRUCT int patternMatchSpecified = FALSE, reactive = TRUE; #endif SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defclass "); #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defclass"); return(TRUE); } #endif cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defclass", EnvFindDefclass,NULL,"#",TRUE, TRUE,TRUE); if (cname == NULL) return(TRUE); if (ValidClassName(theEnv,ValueToString(cname),&cls) == FALSE) return(TRUE); sclasses = ParseSuperclasses(theEnv,readSource,cname); if (sclasses == NULL) return(TRUE); preclist = FindPrecedenceList(theEnv,cls,sclasses); if (preclist == NULL) { DeletePackedClassLinks(theEnv,sclasses,TRUE); return(TRUE); } parseError = FALSE; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SyntaxErrorMessage(theEnv,"defclass"); parseError = TRUE; break; } PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,"("); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,"defclass"); parseError = TRUE; break; } if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),ROLE_RLN) == 0) { if (ParseSimpleQualifier(theEnv,readSource,ROLE_RLN,CONCRETE_RLN,ABSTRACT_RLN, &roleSpecified,&abstract) == FALSE) { parseError = TRUE; break; } } #if DEFRULE_CONSTRUCT else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),MATCH_RLN) == 0) { if (ParseSimpleQualifier(theEnv,readSource,MATCH_RLN,NONREACTIVE_RLN,REACTIVE_RLN, &patternMatchSpecified,&reactive) == FALSE) { parseError = TRUE; break; } } #endif else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),SLOT_RLN) == 0) { slots = ParseSlot(theEnv,readSource,slots,preclist,FALSE,FALSE); if (slots == NULL) { parseError = TRUE; break; } } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),SGL_SLOT_RLN) == 0) { slots = ParseSlot(theEnv,readSource,slots,preclist,FALSE,TRUE); if (slots == NULL) { parseError = TRUE; break; } } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),MLT_SLOT_RLN) == 0) { slots = ParseSlot(theEnv,readSource,slots,preclist,TRUE,TRUE); if (slots == NULL) { parseError = TRUE; break; } } else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),HANDLER_DECL) == 0) { if (ReadUntilClosingParen(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken) == FALSE) { parseError = TRUE; break; } } else { SyntaxErrorMessage(theEnv,"defclass"); parseError = TRUE; break; } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } if ((GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) || (parseError == TRUE)) { DeletePackedClassLinks(theEnv,sclasses,TRUE); DeletePackedClassLinks(theEnv,preclist,TRUE); DeleteSlots(theEnv,slots); return(TRUE); } SavePPBuffer(theEnv,"\n"); /* ========================================================================= The abstract/reactive qualities of a class are inherited if not specified ========================================================================= */ if (roleSpecified == FALSE) { if (preclist->classArray[1]->system && /* Change to cause */ (DefclassData(theEnv)->ClassDefaultsMode == CONVENIENCE_MODE)) /* default role of */ { abstract = FALSE; } /* classes to be concrete. */ else { abstract = preclist->classArray[1]->abstract; } } #if DEFRULE_CONSTRUCT if (patternMatchSpecified == FALSE) { if ((preclist->classArray[1]->system) && /* Change to cause */ (! abstract) && /* default pattern-match */ (DefclassData(theEnv)->ClassDefaultsMode == CONVENIENCE_MODE)) /* of classes to be */ { reactive = TRUE; } /* reactive. */ else { reactive = preclist->classArray[1]->reactive; } } /* ================================================================ An abstract class cannot have direct instances, thus it makes no sense for it to be reactive since it will have no objects to respond to pattern-matching ================================================================ */ if (abstract && reactive) { PrintErrorID(theEnv,"CLASSPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,"An abstract class cannot be reactive.\n"); DeletePackedClassLinks(theEnv,sclasses,TRUE); DeletePackedClassLinks(theEnv,preclist,TRUE); DeleteSlots(theEnv,slots); return(TRUE); } #endif /* ======================================================= If we're only checking syntax, don't add the successfully parsed defclass to the KB. ======================================================= */ if (ConstructData(theEnv)->CheckSyntaxMode) { DeletePackedClassLinks(theEnv,sclasses,TRUE); DeletePackedClassLinks(theEnv,preclist,TRUE); DeleteSlots(theEnv,slots); return(FALSE); } cls = NewClass(theEnv,cname); cls->abstract = abstract; #if DEFRULE_CONSTRUCT cls->reactive = reactive; #endif cls->directSuperclasses.classCount = sclasses->classCount; cls->directSuperclasses.classArray = sclasses->classArray; /* ======================================================= This is a hack to let functions which need to iterate over a class AND its superclasses to conveniently do so The real precedence list starts in position 1 ======================================================= */ preclist->classArray[0] = cls; cls->allSuperclasses.classCount = preclist->classCount; cls->allSuperclasses.classArray = preclist->classArray; rtn_struct(theEnv,packedClassLinks,sclasses); rtn_struct(theEnv,packedClassLinks,preclist); /* ================================= Shove slots into contiguous array ================================= */ if (slots != NULL) PackSlots(theEnv,cls,slots); AddClass(theEnv,cls); return(FALSE); }
static struct lhsParseNode *ConnectedPatternParse( void *theEnv, char *readSource, struct token *theToken, int *error) { unsigned short connectorValue = 0; struct lhsParseNode *theNode, *tempNode, *theGroup; char *errorCE = NULL; int logical = FALSE; int tempValue; /*==========================================================*/ /* Use appropriate spacing for pretty printing of the rule. */ /*==========================================================*/ IncrementIndentDepth(theEnv,5); if (strcmp(ValueToString(theToken->value),"or") == 0) { connectorValue = OR_CE; errorCE = "the or conditional element"; SavePPBuffer(theEnv," "); } else if (strcmp(ValueToString(theToken->value),"and") == 0) { connectorValue = AND_CE; errorCE = "the and conditional element"; SavePPBuffer(theEnv," "); } else if (strcmp(ValueToString(theToken->value),"not") == 0) { connectorValue = NOT_CE; errorCE = "the not conditional element"; SavePPBuffer(theEnv," "); } else if (strcmp(ValueToString(theToken->value),"exists") == 0) { connectorValue = EXISTS_CE; errorCE = "the exists conditional element"; PPCRAndIndent(theEnv); } else if (strcmp(ValueToString(theToken->value),"forall") == 0) { connectorValue = FORALL_CE; errorCE = "the forall conditional element"; PPCRAndIndent(theEnv); } else if (strcmp(ValueToString(theToken->value),"logical") == 0) { connectorValue = AND_CE; errorCE = "the logical conditional element"; logical = TRUE; PPCRAndIndent(theEnv); } /*=====================================================*/ /* The logical CE cannot be contained within a not CE. */ /*=====================================================*/ if (PatternData(theEnv)->WithinNotCE && logical) { PrintErrorID(theEnv,"RULELHS",1,TRUE); EnvPrintRouter(theEnv,WERROR,"The logical CE cannot be used within a not/exists/forall CE.\n"); *error = TRUE; return(NULL); } /*=====================================================*/ /* Remember if we're currently within a *not* CE and */ /* then check to see if we're entering a new *not* CE. */ /*=====================================================*/ tempValue = PatternData(theEnv)->WithinNotCE; if ((connectorValue == NOT_CE) || (connectorValue == EXISTS_CE) || (connectorValue == FORALL_CE)) { PatternData(theEnv)->WithinNotCE = TRUE; } /*===========================================*/ /* Parse all of the CEs contained with the */ /* CE. A ) will terminate the end of the CE. */ /*===========================================*/ theGroup = GroupPatterns(theEnv,readSource,RPAREN,")",error); /*====================================*/ /* Restore the "with a *not* CE" flag */ /* and reset the indentation depth. */ /*====================================*/ PatternData(theEnv)->WithinNotCE = tempValue; DecrementIndentDepth(theEnv,5); /*============================================*/ /* If an error occured while parsing, return. */ /*============================================*/ if (*error == TRUE) { ReturnLHSParseNodes(theEnv,theGroup); return(NULL); } /*=========================================================*/ /* If we parsed a *logical* CE, then mark the logical flag */ /* for all of the CEs contained within the logical CE. */ /*=========================================================*/ if (logical) TagLHSLogicalNodes(theGroup); /*=====================================================*/ /* All the connected CEs must contain at least one CE. */ /*=====================================================*/ if (theGroup == NULL) { SyntaxErrorMessage(theEnv,errorCE); *error = TRUE; return(NULL); } /*============================================*/ /* A not CE may not contain more than one CE. */ /*============================================*/ if ((connectorValue == NOT_CE) && (theGroup->bottom != NULL)) { SyntaxErrorMessage(theEnv,errorCE); ReturnLHSParseNodes(theEnv,theGroup); *error = TRUE; return(NULL); } /*============================================*/ /* A forall CE must contain at least two CEs. */ /*============================================*/ if ((connectorValue == FORALL_CE) && (theGroup->bottom == NULL)) { SyntaxErrorMessage(theEnv,errorCE); ReturnLHSParseNodes(theEnv,theGroup); *error = TRUE; return(NULL); } /*========================================================*/ /* Remove an "and" and "or" CE that only contains one CE. */ /*========================================================*/ if (((connectorValue == AND_CE) || (connectorValue == OR_CE)) && (theGroup->bottom == NULL)) { theGroup->logical = logical; return(theGroup); } /*===========================================================*/ /* Create the top most node which connects the CEs together. */ /*===========================================================*/ theNode = GetLHSParseNode(theEnv); theNode->logical = logical; /*======================================================*/ /* Attach and/or/not CEs directly to the top most node. */ /*======================================================*/ if ((connectorValue == AND_CE) || (connectorValue == OR_CE) || (connectorValue == NOT_CE)) { theNode->type = connectorValue; theNode->right = theGroup; } /*=================================================================*/ /* Wrap two not CEs around the patterns contained in an exists CE. */ /*=================================================================*/ else if (connectorValue == EXISTS_CE) { theNode->type = NOT_CE; theNode->right = GetLHSParseNode(theEnv); theNode->right->type = NOT_CE; theNode->right->logical = logical; if (theGroup->bottom != NULL) { theNode->right->right = GetLHSParseNode(theEnv); theNode->right->right->type = AND_CE; theNode->right->right->logical = logical; theNode->right->right->right = theGroup; } else { theNode->right->right = theGroup; } } /*==================================================*/ /* For a forall CE, wrap a not CE around all of the */ /* CEs and a not CE around the 2nd through nth CEs. */ /*==================================================*/ else if (connectorValue == FORALL_CE) { theNode->type = NOT_CE; tempNode = theGroup->bottom; theGroup->bottom = NULL; theNode->right = GetLHSParseNode(theEnv); theNode->right->type = AND_CE; theNode->right->logical = logical; theNode->right->right = theGroup; theGroup = tempNode; theNode->right->right->bottom = GetLHSParseNode(theEnv); theNode->right->right->bottom->type = NOT_CE; theNode->right->right->bottom->logical = logical; tempNode = theNode->right->right->bottom; if (theGroup->bottom == NULL) { tempNode->right = theGroup; } else { tempNode->right = GetLHSParseNode(theEnv); tempNode->right->type = AND_CE; tempNode->right->logical = logical; tempNode->right->right = theGroup; } } /*================*/ /* Return the CE. */ /*================*/ return(theNode); }
static struct lhsParseNode *GroupPatterns( void *theEnv, char *readSource, int terminator, char *terminatorString, int *error) { struct lhsParseNode *lastNode, *newNode, *theNode; lastNode = theNode = NULL; while (TRUE) { /*==================*/ /* Get the next CE. */ /*==================*/ newNode = LHSPattern(theEnv,readSource,terminator,terminatorString, error,FALSE,NULL,NULL); /*=======================================================*/ /* If an error occurred, release any LHS data structures */ /* previously allocated by this routine. */ /*=======================================================*/ if (*error) { ReturnLHSParseNodes(theEnv,theNode); return(NULL); } /*===============================================*/ /* A NULL value for the CE just parsed indicates */ /* that the terminator for the group of patterns */ /* was encountered (either a "=>" or a ")". */ /*===============================================*/ if (newNode == NULL) { PPBackup(theEnv); PPBackup(theEnv); if (terminator == RPAREN) { SavePPBuffer(theEnv,terminatorString); } else { PPCRAndIndent(theEnv); SavePPBuffer(theEnv,terminatorString); } return(theNode); } /*============================*/ /* Add the new CE to the list */ /* of CEs being grouped. */ /*============================*/ if (lastNode == NULL) { theNode = newNode; } else { lastNode->bottom = newNode; } lastNode = newNode; /*======================================*/ /* Fix the pretty print representation. */ /*======================================*/ PPCRAndIndent(theEnv); } }
/********************************************************************* NAME : ParseDefinstances DESCRIPTION : Parses and allocates a definstances construct INPUTS : The logical name of the input source RETURNS : FALSE if no errors, TRUE otherwise SIDE EFFECTS : Definstances parsed and created NOTES : H/L Syntax : (definstances <name> [active] [<comment>] <instance-definition>+) <instance-definition> ::= (<instance-name> of <class-name> <slot-override>*) <slot-override> ::= (<slot-name> <value-expression>*) *********************************************************************/ static int ParseDefinstances( void *theEnv, char *readSource) { SYMBOL_HN *dname; void *mkinsfcall; EXPRESSION *mkinstance,*mkbot = NULL; DEFINSTANCES *dobj; int active; SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,(char*)"(definstances "); #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,(char*)"definstances"); return(TRUE); } #endif dname = ParseDefinstancesName(theEnv,readSource,&active); if (dname == NULL) return(TRUE); dobj = get_struct(theEnv,definstances); InitializeConstructHeader(theEnv,(char*)"definstances",(struct constructHeader *) dobj,dname); dobj->busy = 0; dobj->mkinstance = NULL; #if DEFRULE_CONSTRUCT if (active) mkinsfcall = (void *) FindFunction(theEnv,(char*)"active-make-instance"); else mkinsfcall = (void *) FindFunction(theEnv,(char*)"make-instance"); #else mkinsfcall = (void *) FindFunction(theEnv,(char*)"make-instance"); #endif while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN) { mkinstance = GenConstant(theEnv,UNKNOWN_VALUE,mkinsfcall); mkinstance = ParseInitializeInstance(theEnv,mkinstance,readSource); if (mkinstance == NULL) { ReturnExpression(theEnv,dobj->mkinstance); rtn_struct(theEnv,definstances,dobj); return(TRUE); } if (ExpressionContainsVariables(mkinstance,FALSE) == TRUE) { LocalVariableErrorMessage(theEnv,(char*)"definstances"); ReturnExpression(theEnv,mkinstance); ReturnExpression(theEnv,dobj->mkinstance); rtn_struct(theEnv,definstances,dobj); return(TRUE); } if (mkbot == NULL) dobj->mkinstance = mkinstance; else GetNextArgument(mkbot) = mkinstance; mkbot = mkinstance; GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); PPBackup(theEnv); PPCRAndIndent(theEnv); SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm); } if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { ReturnExpression(theEnv,dobj->mkinstance); rtn_struct(theEnv,definstances,dobj); SyntaxErrorMessage(theEnv,(char*)"definstances"); return(TRUE); } else { if (ConstructData(theEnv)->CheckSyntaxMode) { ReturnExpression(theEnv,dobj->mkinstance); rtn_struct(theEnv,definstances,dobj); return(FALSE); } #if DEBUGGING_FUNCTIONS if (EnvGetConserveMemory(theEnv) == FALSE) { if (dobj->mkinstance != NULL) PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,(char*)")\n"); SetDefinstancesPPForm((void *) dobj,CopyPPBuffer(theEnv)); } #endif mkinstance = dobj->mkinstance; dobj->mkinstance = PackExpression(theEnv,mkinstance); ReturnExpression(theEnv,mkinstance); IncrementSymbolCount(GetDefinstancesNamePointer((void *) dobj)); ExpressionInstall(theEnv,dobj->mkinstance); } AddConstructToModule((struct constructHeader *) dobj); return(FALSE); }
globle struct expr *BuildRHSAssert( char *logicalName, struct token *theToken, int *error, int atLeastOne, int readFirstParen, char *whereParsed) { struct expr *lastOne, *nextOne, *assertList, *stub; *error = FALSE; /*===============================================================*/ /* If the first parenthesis of the RHS fact pattern has not been */ /* read yet, then get the next token. If a right parenthesis is */ /* encountered then exit (however, set the error return value if */ /* at least one fact was expected). */ /*===============================================================*/ if (readFirstParen == FALSE) { if (theToken->type == RPAREN) { if (atLeastOne) { *error = TRUE; SyntaxErrorMessage(whereParsed); } return(NULL); } } /*================================================*/ /* Parse the facts until no more are encountered. */ /*================================================*/ lastOne = assertList = NULL; while ((nextOne = GetRHSPattern(logicalName,theToken, error,FALSE,readFirstParen, TRUE,RPAREN)) != NULL) { PPCRAndIndent(); stub = GenConstant(FCALL,(void *) FindFunction("assert")); stub->argList = nextOne; nextOne = stub; if (lastOne == NULL) { assertList = nextOne; } else { lastOne->nextArg = nextOne; } lastOne = nextOne; readFirstParen = TRUE; } /*======================================================*/ /* If an error was detected while parsing, then return. */ /*======================================================*/ if (*error) { ReturnExpression(assertList); return(NULL); } /*======================================*/ /* Fix the pretty print representation. */ /*======================================*/ if (theToken->type == RPAREN) { PPBackup(); PPBackup(); SavePPBuffer(")"); } /*==============================================================*/ /* If no facts are being asserted then return NULL. In addition */ /* if at least one fact was required, then signal an error. */ /*==============================================================*/ if (assertList == NULL) { if (atLeastOne) { *error = TRUE; SyntaxErrorMessage(whereParsed); } return(NULL); } /*===============================================*/ /* If more than one fact is being asserted, then */ /* wrap the assert commands within a progn call. */ /*===============================================*/ if (assertList->nextArg != NULL) { stub = GenConstant(FCALL,(void *) FindFunction("progn")); stub->argList = assertList; assertList = stub; } /*==========================================================*/ /* Return the expression for asserting the specified facts. */ /*==========================================================*/ return(assertList); }
globle struct expr *GroupActions( void *theEnv, char *logicalName, struct token *theToken, int readFirstToken, char *endWord, int functionNameParsed) { struct expr *top, *nextOne, *lastOne = NULL; /*=============================*/ /* Create the enclosing progn. */ /*=============================*/ top = GenConstant(theEnv,FCALL,FindFunction(theEnv,"progn")); /*========================================================*/ /* Continue until all appropriate commands are processed. */ /*========================================================*/ while (TRUE) { /*================================================*/ /* Skip reading in the token if this is the first */ /* pass and the initial token was already read */ /* before calling this function. */ /*================================================*/ if (readFirstToken) { GetToken(theEnv,logicalName,theToken); } else { readFirstToken = TRUE; } /*=================================================*/ /* Look to see if a symbol has terminated the list */ /* of actions (such as "else" in an if function). */ /*=================================================*/ if ((theToken->type == SYMBOL) && (endWord != NULL) && (! functionNameParsed)) { if (strcmp(ValueToString(theToken->value),endWord) == 0) { return(top); } } /*====================================*/ /* Process a function if the function */ /* name has already been read. */ /*====================================*/ if (functionNameParsed) { nextOne = Function2Parse(theEnv,logicalName,ValueToString(theToken->value)); functionNameParsed = FALSE; } /*========================================*/ /* Process a constant or global variable. */ /*========================================*/ else if ((theToken->type == SYMBOL) || (theToken->type == STRING) || (theToken->type == INTEGER) || (theToken->type == FLOAT) || #if DEFGLOBAL_CONSTRUCT (theToken->type == GBL_VARIABLE) || (theToken->type == MF_GBL_VARIABLE) || #endif #if OBJECT_SYSTEM (theToken->type == INSTANCE_NAME) || #endif (theToken->type == SF_VARIABLE) || (theToken->type == MF_VARIABLE)) { nextOne = GenConstant(theEnv,theToken->type,theToken->value); } /*=============================*/ /* Otherwise parse a function. */ /*=============================*/ else if (theToken->type == LPAREN) { nextOne = Function1Parse(theEnv,logicalName); } /*======================================*/ /* Otherwise replace sequence expansion */ /* variables and return the expression. */ /*======================================*/ else { if (ReplaceSequenceExpansionOps(theEnv,top,NULL, FindFunction(theEnv,"(expansion-call)"), FindFunction(theEnv,"expand$"))) { ReturnExpression(theEnv,top); return(NULL); } return(top); } /*===========================*/ /* Add the new action to the */ /* list of progn arguments. */ /*===========================*/ if (nextOne == NULL) { theToken->type = UNKNOWN_VALUE; ReturnExpression(theEnv,top); return(NULL); } if (lastOne == NULL) { top->argList = nextOne; } else { lastOne->nextArg = nextOne; } lastOne = nextOne; PPCRAndIndent(theEnv); } }
static int ParsePortSpecifications( void *theEnv, char *readSource, struct token *theToken, struct defmodule *theDefmodule) { int error; /*=============================*/ /* The import and export lists */ /* are initially empty. */ /*=============================*/ theDefmodule->importList = NULL; theDefmodule->exportList = NULL; /*==========================================*/ /* Parse import/export specifications until */ /* a right parenthesis is encountered. */ /*==========================================*/ while (theToken->type != RPAREN) { /*========================================*/ /* Look for the opening left parenthesis. */ /*========================================*/ if (theToken->type != LPAREN) { SyntaxErrorMessage(theEnv,"defmodule"); return(TRUE); } /*====================================*/ /* Look for the import/export keyword */ /* and call the appropriate functions */ /* for parsing the specification. */ /*====================================*/ GetToken(theEnv,readSource,theToken); if (theToken->type != SYMBOL) { SyntaxErrorMessage(theEnv,"defmodule"); return(TRUE); } if (strcmp(ValueToString(theToken->value),"import") == 0) { error = ParseImportSpec(theEnv,readSource,theToken,theDefmodule); } else if (strcmp(ValueToString(theToken->value),"export") == 0) { error = ParseExportSpec(theEnv,readSource,theToken,theDefmodule,NULL); } else { SyntaxErrorMessage(theEnv,"defmodule"); return(TRUE); } if (error) return(TRUE); /*============================================*/ /* Begin parsing the next port specification. */ /*============================================*/ PPCRAndIndent(theEnv); GetToken(theEnv,readSource,theToken); if (theToken->type == RPAREN) { PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,")"); } } /*===================================*/ /* Return FALSE to indicate no error */ /* occurred while parsing the */ /* import/export specifications. */ /*===================================*/ return(FALSE); }
/************************************************************ NAME : ParseSlot DESCRIPTION : Parses slot definitions for a defclass statement INPUTS : 1) The logical name of the input source 2) The current slot list 3) The class precedence list for the class to which this slot is being attached (used to find facets for composite slots) 4) A flag indicating if this is a multifield slot or not 5) A flag indicating if the type of slot (single or multi) was explicitly specified or not RETURNS : The address of the list of slots, NULL if there was an error SIDE EFFECTS : The slot list is allocated NOTES : Assumes "(slot" has already been parsed. ************************************************************/ globle TEMP_SLOT_LINK *ParseSlot( void *theEnv, EXEC_STATUS, char *readSource, TEMP_SLOT_LINK *slist, PACKED_CLASS_LINKS *preclist, int multiSlot, int fieldSpecified) { SLOT_DESC *slot; CONSTRAINT_PARSE_RECORD parsedConstraint; char specbits[2]; int rtnCode; SYMBOL_HN *newOverrideMsg; /* =============================================================== Bits in specbits are when slot qualifiers are specified so that duplicate or conflicting qualifiers can be detected. Shared/local bit-0 Single/multiple bit-1 Read-only/Read-write/Initialize-Only bit-2 Inherit/No-inherit bit-3 Composite/Exclusive bit-4 Reactive/Nonreactive bit-5 Default bit-6 Default-dynamic bit-7 Visibility bit-8 Override-message bit-9 =============================================================== */ SavePPBuffer(theEnv,execStatus," "); specbits[0] = specbits[1] = '\0'; GetToken(theEnv,execStatus,readSource,&DefclassData(theEnv,execStatus)->ObjectParseToken); if (GetType(DefclassData(theEnv,execStatus)->ObjectParseToken) != SYMBOL) { DeleteSlots(theEnv,execStatus,slist); SyntaxErrorMessage(theEnv,execStatus,"defclass slot"); return(NULL); } if ((DefclassData(theEnv,execStatus)->ObjectParseToken.value == (void *) DefclassData(theEnv,execStatus)->ISA_SYMBOL) || (DefclassData(theEnv,execStatus)->ObjectParseToken.value == (void *) DefclassData(theEnv,execStatus)->NAME_SYMBOL)) { DeleteSlots(theEnv,execStatus,slist); SyntaxErrorMessage(theEnv,execStatus,"defclass slot"); return(NULL); } slot = NewSlot(theEnv,execStatus,(SYMBOL_HN *) GetValue(DefclassData(theEnv,execStatus)->ObjectParseToken)); slist = InsertSlot(theEnv,execStatus,slist,slot); if (slist == NULL) return(NULL); if (multiSlot) slot->multiple = TRUE; if (fieldSpecified) SetBitMap(specbits,FIELD_BIT); GetToken(theEnv,execStatus,readSource,&DefclassData(theEnv,execStatus)->ObjectParseToken); IncrementIndentDepth(theEnv,execStatus,3); InitializeConstraintParseRecord(&parsedConstraint); while (GetType(DefclassData(theEnv,execStatus)->ObjectParseToken) == LPAREN) { PPBackup(theEnv,execStatus); PPCRAndIndent(theEnv,execStatus); SavePPBuffer(theEnv,execStatus,"("); GetToken(theEnv,execStatus,readSource,&DefclassData(theEnv,execStatus)->ObjectParseToken); if (GetType(DefclassData(theEnv,execStatus)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,execStatus,"defclass slot"); goto ParseSlotError; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),DEFAULT_FACET) == 0) { if (ParseDefaultFacet(theEnv,execStatus,readSource,specbits,slot) == FALSE) goto ParseSlotError; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),DYNAMIC_FACET) == 0) { SetBitMap(specbits,DEFAULT_DYNAMIC_BIT); if (ParseDefaultFacet(theEnv,execStatus,readSource,specbits,slot) == FALSE) goto ParseSlotError; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),ACCESS_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,ACCESS_FACET,ACCESS_BIT, SLOT_RDWRT_RLN,SLOT_RDONLY_RLN,SLOT_INIT_RLN, NULL,NULL); if (rtnCode == -1) goto ParseSlotError; else if (rtnCode == 1) slot->noWrite = 1; else if (rtnCode == 2) slot->initializeOnly = 1; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),STORAGE_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,STORAGE_FACET,STORAGE_BIT, SLOT_LOCAL_RLN,SLOT_SHARE_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->shared = rtnCode; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),PROPAGATION_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,PROPAGATION_FACET,PROPAGATION_BIT, SLOT_INH_RLN,SLOT_NO_INH_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->noInherit = rtnCode; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),SOURCE_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,SOURCE_FACET,SOURCE_BIT, SLOT_EXCLUSIVE_RLN,SLOT_COMPOSITE_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->composite = rtnCode; } #if DEFRULE_CONSTRUCT else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),MATCH_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,MATCH_FACET,MATCH_BIT, SLOT_NONREACTIVE_RLN,SLOT_REACTIVE_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->reactive = rtnCode; } #endif else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),VISIBILITY_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,VISIBILITY_FACET,VISIBILITY_BIT, SLOT_PRIVATE_RLN,SLOT_PUBLIC_RLN,NULL,NULL,NULL); if (rtnCode == -1) goto ParseSlotError; slot->publicVisibility = rtnCode; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),CREATE_ACCESSOR_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,CREATE_ACCESSOR_FACET, CREATE_ACCESSOR_BIT, SLOT_READ_RLN,SLOT_WRITE_RLN,SLOT_RDWRT_RLN, SLOT_NONE_RLN,NULL); if (rtnCode == -1) goto ParseSlotError; if ((rtnCode == 0) || (rtnCode == 2)) slot->createReadAccessor = TRUE; if ((rtnCode == 1) || (rtnCode == 2)) slot->createWriteAccessor = TRUE; } else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),OVERRIDE_MSG_FACET) == 0) { rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,OVERRIDE_MSG_FACET,OVERRIDE_MSG_BIT, NULL,NULL,NULL,SLOT_DEFAULT_RLN,&newOverrideMsg); if (rtnCode == -1) goto ParseSlotError; if (rtnCode == 4) { DecrementSymbolCount(theEnv,execStatus,slot->overrideMessage); slot->overrideMessage = newOverrideMsg; IncrementSymbolCount(slot->overrideMessage); } slot->overrideMessageSpecified = TRUE; } else if (StandardConstraint(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken))) { if (ParseStandardConstraint(theEnv,execStatus,readSource,DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken), slot->constraint,&parsedConstraint,TRUE) == FALSE) goto ParseSlotError; } else { SyntaxErrorMessage(theEnv,execStatus,"defclass slot"); goto ParseSlotError; } GetToken(theEnv,execStatus,readSource,&DefclassData(theEnv,execStatus)->ObjectParseToken); } if (GetType(DefclassData(theEnv,execStatus)->ObjectParseToken) != RPAREN) { SyntaxErrorMessage(theEnv,execStatus,"defclass slot"); goto ParseSlotError; } if (DefclassData(theEnv,execStatus)->ClassDefaultsMode == CONVENIENCE_MODE) { if (! TestBitMap(specbits,CREATE_ACCESSOR_BIT)) { slot->createReadAccessor = TRUE; if (! slot->noWrite) { slot->createWriteAccessor = TRUE; } } } if (slot->composite) BuildCompositeFacets(theEnv,execStatus,slot,preclist,specbits,&parsedConstraint); if (CheckForFacetConflicts(theEnv,execStatus,slot,&parsedConstraint) == FALSE) goto ParseSlotError; if (CheckConstraintParseConflicts(theEnv,execStatus,slot->constraint) == FALSE) goto ParseSlotError; if (EvaluateSlotDefaultValue(theEnv,execStatus,slot,specbits) == FALSE) goto ParseSlotError; if ((slot->dynamicDefault == 0) && (slot->noWrite == 1) && (slot->initializeOnly == 0)) slot->shared = 1; slot->constraint = AddConstraint(theEnv,execStatus,slot->constraint); DecrementIndentDepth(theEnv,execStatus,3); return(slist); ParseSlotError: DecrementIndentDepth(theEnv,execStatus,3); DeleteSlots(theEnv,execStatus,slist); return(NULL); }