prcdrfun.c

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

   
   else if ((returnValue->value != CLIPSFalseSymbol) ||
            (returnValue->type != SYMBOL))
     {
      RtnUnknown(2,returnValue);
      return;
     }

   /*=========================================*/
   /* Return FALSE if the condition evaluated */
   /* to FALSE and there is no "else" portion */
   /* of the if statement.                    */
   /*=========================================*/
   
   returnValue->type = SYMBOL;
   returnValue->value = CLIPSFalseSymbol;
   return;
  }

/**************************************/
/* BindFunction: CLIPS access routine */
/*   for the bind function.           */
/**************************************/
globle VOID BindFunction(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   DATA_OBJECT *theBind, *lastBind;
   int found = CLIPS_FALSE,
       unbindVar = CLIPS_FALSE;
   SYMBOL_HN *variableName = NULL;
#if DEFGLOBAL_CONSTRUCT
   struct defglobal *theGlobal = NULL;
#endif
   
   /*===============================================*/
   /* Determine the name of the variable to be set. */
   /*===============================================*/
   
#if DEFGLOBAL_CONSTRUCT
   if (GetFirstArgument()->type == DEFGLOBAL_PTR)
     { theGlobal = (struct defglobal *) GetFirstArgument()->value; }
   else 
#endif
     {
      EvaluateExpression(GetFirstArgument(),returnValue);
      variableName = (SYMBOL_HN *) DOPToPointer(returnValue);
     }
      
   /*===========================================*/
   /* Determine the new value for the variable. */
   /*===========================================*/

   if (GetFirstArgument()->nextArg == NULL)
     { unbindVar = CLIPS_TRUE; }
   else if (GetFirstArgument()->nextArg->nextArg == NULL)
     { EvaluateExpression(GetFirstArgument()->nextArg,returnValue); }
   else
     { StoreInMultifield(returnValue,GetFirstArgument()->nextArg,CLIPS_TRUE); }
     
   /*==================================*/
   /* Bind a defglobal if appropriate. */
   /*==================================*/

#if DEFGLOBAL_CONSTRUCT
   if (theGlobal != NULL)
     {
      QSetDefglobalValue(theGlobal,returnValue,unbindVar);
      return;
     }
#endif

   /*===============================================*/
   /* Search for the variable in the list of binds. */
   /*===============================================*/

   theBind = BindList;
   lastBind = NULL;

   while ((theBind != NULL) && (found == CLIPS_FALSE))
     {
      if (theBind->supplementalInfo == (VOID *) variableName)
        { found = CLIPS_TRUE; }
      else
        {
         lastBind = theBind;
         theBind = theBind->next;
        }
     }

   /*========================================================*/
   /* If variable was not in the list of binds, then add it. */
   /* Make sure that this operation preserves the bind list  */
   /* as a stack.                                            */
   /*========================================================*/

   if (found == CLIPS_FALSE)
     {
      if (unbindVar == CLIPS_FALSE)
        {
         theBind = get_struct(dataObject);
         theBind->supplementalInfo = (VOID *) variableName;
         theBind->next = NULL;
         if (lastBind == NULL)
           { BindList = theBind; }
         else
           { lastBind->next = theBind; }
        }
      else
        {
         returnValue->type = SYMBOL;
         returnValue->value = CLIPSFalseSymbol;
         return;
        }
     }
   else
     { ValueDeinstall(theBind); }

   /*================================*/
   /* Set the value of the variable. */
   /*================================*/
   
   if (unbindVar == CLIPS_FALSE)
     {
      theBind->type = returnValue->type;
      theBind->value = returnValue->value;
      theBind->begin = returnValue->begin;
      theBind->end = returnValue->end;
      ValueInstall(returnValue);
     }
   else
     {
      if (lastBind == NULL) BindList = theBind->next;
      else lastBind->next = theBind->next;
      rtn_struct(dataObject,theBind);
      returnValue->type = SYMBOL;
      returnValue->value = CLIPSFalseSymbol;
     }
  }
  
/*******************************************/
/* GetBoundVariable: Searches the BindList */
/*   for a specified variable.             */
/*******************************************/
globle BOOLEAN GetBoundVariable(vPtr,varName)
  DATA_OBJECT_PTR vPtr;
  SYMBOL_HN *varName;
  {
   DATA_OBJECT_PTR bindPtr;

   for (bindPtr = BindList; bindPtr != NULL; bindPtr = bindPtr->next)
     {
      if (bindPtr->supplementalInfo == (VOID *) varName)
        {
         vPtr->type = bindPtr->type;
         vPtr->value = bindPtr->value;
         vPtr->begin = bindPtr->begin;
         vPtr->end = bindPtr->end;
         return(CLIPS_TRUE);
        }
     }
     
   return(CLIPS_FALSE);
  }
  
/*************************************************/
/* FlushBindList: Removes all variables from the */
/*   list of currently bound local variables.    */
/*************************************************/
globle VOID FlushBindList()
  {
   ReturnValues(BindList);
   BindList = NULL;
  }
  
/***************************************/
/* PrognFunction: CLIPS access routine */
/*   for the progn function.           */
/***************************************/
globle VOID PrognFunction(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   int numa, i;

   numa = RtnArgCount();

   if (numa == 0)
     {
      returnValue->type = SYMBOL;
      returnValue->value = CLIPSFalseSymbol;
      return;
     }

   i = 1;
   while ((i <= numa) && (GetHaltExecution() != CLIPS_TRUE))
     {
      RtnUnknown(i,returnValue);
      if ((BreakFlag == CLIPS_TRUE) || (ReturnFlag == CLIPS_TRUE))
        break;
      i++;
     }

   if (GetHaltExecution() == CLIPS_TRUE)
     {
      returnValue->type = SYMBOL;
      returnValue->value = CLIPSFalseSymbol;
      return;
     }

   return;
  }

/*****************************************************************/
/* ReturnFunction: CLIPS access routine for the return function. */
/*****************************************************************/
globle VOID ReturnFunction(result)
  DATA_OBJECT_PTR result;
  {
   if (RtnArgCount() == 0)
     {
      result->type = RVOID;
      result->value = CLIPSFalseSymbol;
     }
   else
     RtnUnknown(1,result);
   ReturnFlag = CLIPS_TRUE;
  }

/***************************************************************/
/* BreakFunction: CLIPS access routine for the break function. */   
/***************************************************************/
globle VOID BreakFunction()
  {
   BreakFlag = CLIPS_TRUE;
  }

/*****************************************************************/
/* SwitchFunction: CLIPS access routine for the switch function. */
/*****************************************************************/
globle VOID SwitchFunction(result)
  DATA_OBJECT_PTR result;
  {
   DATA_OBJECT switch_val,case_val;
   EXPRESSION *exp;
   
   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   
   /* ==========================
      Get the value to switch on
      ========================== */
   EvaluateExpression(GetFirstArgument(),&switch_val);
   if (EvaluationError)
     return;
   for (exp = GetFirstArgument()->nextArg ; exp != NULL ; exp = exp->nextArg->nextArg)
     {
      /* =================================================
         RVOID is the default case (if any) for the switch
         ================================================= */
      if (exp->type == RVOID)
        {
         EvaluateExpression(exp->nextArg,result);
         return;
        }
        
      /* ====================================================
         If the case matches, evaluate the actions and return
         ==================================================== */
      EvaluateExpression(exp,&case_val);
      if (EvaluationError)
        return;
      if (switch_val.type == case_val.type)
        {
         if ((case_val.type == MULTIFIELD) ? MultifieldDOsEqual(&switch_val,&case_val) :
             (switch_val.value == case_val.value))
           {
            EvaluateExpression(exp->nextArg,result);
            return;
           }
        }
     }
  }