inspsr.c

NASA 开发使用的一个专家系统

            PPBackup();
            PPBackup();
            SavePPBuffer(ObjectParseToken.print_rep);
            SavePPBuffer(" ");
            top->argList->nextArg = ArgumentParse(readSource,&error);
            if (error)
              goto ParseInitializeInstanceError;
            if (top->argList->nextArg == NULL)
              {
               SyntaxErrorMessage("instance name");
               goto ParseInitializeInstanceError;
              }
            PPCRAndIndent();
            GetToken(readSource,&ObjectParseToken);
           }
         else
           top->argList->nextArg = GenConstant(FCALL,(VOID *) FindFunction("gensym*"));
         top->argList->nextArg->nextArg = ParseSlotOverrides(readSource,&error);
        }
      else
        top->argList->nextArg = ParseSlotOverrides(readSource,&error);
     }
   if (error)
      goto ParseInitializeInstanceError;
   if (GetType(ObjectParseToken) != RPAREN)
     {
      SyntaxErrorMessage("slot-override");
      goto ParseInitializeInstanceError;
     }
   DecrementIndentDepth(3);
   return(top);
   
ParseInitializeInstanceError:
   SetEvaluationError(CLIPS_TRUE);
   ReturnExpression(top);
   DecrementIndentDepth(3);
   return(NULL);
  }

/********************************************************************************
  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(readSource,error)
  char *readSource;
  int *error;
  {
   EXPRESSION *top = NULL,*bot = NULL,*exp;
   
   while (GetType(ObjectParseToken) == LPAREN)
     {
      *error = CLIPS_FALSE;
      exp = ArgumentParse(readSource,error);
      if (*error == CLIPS_TRUE)
        {
         ReturnExpression(top);
         return(NULL);
        }
      else if (exp == NULL)
        {
         SyntaxErrorMessage("slot-override");
         *error = CLIPS_TRUE;
         ReturnExpression(top);
         SetEvaluationError(CLIPS_TRUE);
         return(NULL);
        }
      exp->nextArg = GenConstant(SYMBOL,CLIPSTrueSymbol);
      if (CollectArguments(exp->nextArg,readSource) == NULL)
        {
         *error = CLIPS_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);
  }

#endif

/****************************************************************************
  NAME         : ParseSimpleInstance
  DESCRIPTION  : Parses instances from file for load-instances
                   into an EXPRESSION forms that
                   can later be evaluated with EvaluateExpression()
  INPUTS       : 1) The address of the top node of the expression
                    containing the make-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 make-instance call
                    (slot-overrides etc.)
                 The "top" expression is deleted on errors.
  NOTES        : The name, class, values etc. must be constants.

                 This function parses a make-instance call into
                 an expression of the following form :
                                             
                  (make-instance <instance> of <class> <slot-override>*)
                  where <slot-override> ::= (<slot-name> <expression>+)
                  
                  goes to -->
                  
                  make-instance
                      |
                      V
                  <instance-name>-><class-name>-><slot-name>-><dummy-node>...
                                                                 |
                                                                 V
                                                          <value-expression>...

 ****************************************************************************/
globle EXPRESSION *ParseSimpleInstance(top,readSource)
  EXPRESSION *top;
  char *readSource;
  {
   EXPRESSION *exp,*vals = NULL,*vbot,*tval;
   int type;

   GetToken(readSource,&ObjectParseToken);
   if ((GetType(ObjectParseToken) != INSTANCE_NAME) &&
       (GetType(ObjectParseToken) != SYMBOL))
     goto MakeInstanceError;
   top->argList = GenConstant(INSTANCE_NAME,
                               (VOID *) GetValue(ObjectParseToken));
   GetToken(readSource,&ObjectParseToken);
   if ((GetType(ObjectParseToken) != SYMBOL) ? CLIPS_TRUE :
       (strcmp(CLASS_RLN,DOToString(ObjectParseToken)) != 0))
     goto MakeInstanceError;
   GetToken(readSource,&ObjectParseToken);
   if (GetType(ObjectParseToken) != SYMBOL)
     goto MakeInstanceError;
   top->argList->nextArg =
        GenConstant(SYMBOL,(VOID *) GetValue(ObjectParseToken));
   exp = top->argList->nextArg;
   if (ReplaceClassNameWithReference(exp) == CLIPS_FALSE)
     goto MakeInstanceError;
   GetToken(readSource,&ObjectParseToken);
   while (GetType(ObjectParseToken) == LPAREN)
     {
      GetToken(readSource,&ObjectParseToken);
      if (GetType(ObjectParseToken) != SYMBOL)
        goto SlotOverrideError;
      exp->nextArg = GenConstant(SYMBOL,(VOID *) GetValue(ObjectParseToken));
      exp->nextArg->nextArg = GenConstant(SYMBOL,CLIPSTrueSymbol);
      exp = exp->nextArg->nextArg;
      GetToken(readSource,&ObjectParseToken);
      vbot = NULL;
      while (GetType(ObjectParseToken) != RPAREN)
        {
         type = GetType(ObjectParseToken);
         if (type == LPAREN)
           {
            GetToken(readSource,&ObjectParseToken);
            if ((GetType(ObjectParseToken) != SYMBOL) ? CLIPS_TRUE :
                (strcmp(ValueToString(ObjectParseToken.value),"create$") != 0))
              goto SlotOverrideError;
            GetToken(readSource,&ObjectParseToken);
            if (GetType(ObjectParseToken) != RPAREN)
              goto SlotOverrideError;
            tval = GenConstant(FCALL,(VOID *) FindFunction("create$"));
           }
         else
           {
            if ((type != SYMBOL) && (type != STRING) &&
                (type != FLOAT) && (type != INTEGER) && (type != INSTANCE_NAME))
              goto SlotOverrideError;
            tval = GenConstant(type,(VOID *) GetValue(ObjectParseToken));
           }
         if (vals == NULL)
           vals = tval;
         else
           vbot->nextArg = tval;
         vbot = tval;
         GetToken(readSource,&ObjectParseToken);
        }
      exp->argList = vals;
      GetToken(readSource,&ObjectParseToken);
      vals = NULL;
     }
   if (GetType(ObjectParseToken) != RPAREN)
     goto SlotOverrideError;
   return(top);
   
MakeInstanceError:
   SyntaxErrorMessage("make-instance");
   SetEvaluationError(CLIPS_TRUE);
   ReturnExpression(top);
   return(NULL);
   
SlotOverrideError:
   SyntaxErrorMessage("slot-override");
   SetEvaluationError(CLIPS_TRUE);
   ReturnExpression(top);
   ReturnExpression(vals);
   return(NULL);
  }

/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/***************************************************
  NAME         : ReplaceClassNameWithReference
  DESCRIPTION  : In parsing a make instance call,
                 this function replaces a constant
                 class name with an actual pointer
                 to the class
  INPUTS       : The expression
  RETURNS      : CLIPS_TRUE if all OK, CLIPS_FALSE
                 if class cannot be found
  SIDE EFFECTS : The expression type and value are
                 modified if class is found
  NOTES        : Searches current nd imported
                 modules for reference
 ***************************************************/
static BOOLEAN ReplaceClassNameWithReference(exp)
  EXPRESSION *exp;
  {
   char *theClassName;
   VOID *theDefclass;
   
   if (exp->type == SYMBOL)
     {
      theClassName = ValueToString(exp->value);
      theDefclass = (VOID *) LookupDefclassInScope(theClassName);
      if (theDefclass == NULL)
        {
         CantFindItemErrorMessage("class",theClassName);
         return(CLIPS_FALSE);
        }
      if (ClassAbstractP(theDefclass))
        {
         PrintErrorID("INSMNGR",3,CLIPS_FALSE);
         PrintCLIPS(WERROR,"Cannot create instances of abstract class ");
         PrintCLIPS(WERROR,theClassName);
         PrintCLIPS(WERROR,".\n");
         return(CLIPS_FALSE);
        }
      exp->type = DEFCLASS_PTR;
      exp->value = theDefclass;
     }
   return(CLIPS_TRUE);
  }

#endif
 
/***************************************************
  NAME         : 
  DESCRIPTION  : 
  INPUTS       : 
  RETURNS      : 
  SIDE EFFECTS : 
  NOTES        : 
 ***************************************************/