C++ EnvFalseSymbol函數代碼示例

/***********************************************************************************
  NAME         : MVSlotReplaceCommand
  DESCRIPTION  : Allows user to replace a specified field of a multi-value slot
                 The slot is directly read (w/o a get- message) and the new
                   slot-value is placed via a put- message.
                 This function is not valid for single-value slots.
  INPUTS       : Caller's result buffer
  RETURNS      : TRUE if multi-value slot successfully modified,
                 FALSE otherwise
  SIDE EFFECTS : Put messsage sent for slot
  NOTES        : H/L Syntax : (slot-replace$ <instance> <slot>
                                 <range-begin> <range-end> <value>)
 ***********************************************************************************/
globle void MVSlotReplaceCommand(
  void *theEnv,
  DATA_OBJECT *result)
  {
   DATA_OBJECT newval,newseg,oldseg;
   INSTANCE_TYPE *ins;
   INSTANCE_SLOT *sp;
   int rb,re;
   EXPRESSION arg;

   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv);
   ins = CheckMultifieldSlotInstance(theEnv,"slot-replace$");
   if (ins == NULL)
     return;
   sp = CheckMultifieldSlotModify(theEnv,REPLACE,"slot-replace$",ins,
                            GetFirstArgument()->nextArg,&rb,&re,&newval);
   if (sp == NULL)
     return;
   AssignSlotToDataObject(&oldseg,sp);
   if (ReplaceMultiValueField(theEnv,&newseg,&oldseg,rb,re,&newval,"slot-replace$") == FALSE)
     return;
   arg.type = MULTIFIELD;
   arg.value = (void *) &newseg;
   arg.nextArg = NULL;
   arg.argList = NULL;
   DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg);
  }

/***********************************************************************************
  NAME         : MVSlotInsertCommand
  DESCRIPTION  : Allows user to insert a specified field of a multi-value slot
                 The slot is directly read (w/o a get- message) and the new
                   slot-value is placed via a put- message.
                 This function is not valid for single-value slots.
  INPUTS       : Caller's result buffer
  RETURNS      : TRUE if multi-value slot successfully modified, FALSE otherwise
  SIDE EFFECTS : Put messsage sent for slot
  NOTES        : H/L Syntax : (slot-insert$ <instance> <slot> <index> <value>)
 ***********************************************************************************/
globle void MVSlotInsertCommand(
  void *theEnv,
  DATA_OBJECT *result)
  {
   DATA_OBJECT newval,newseg,oldseg;
   INSTANCE_TYPE *ins;
   INSTANCE_SLOT *sp;
   long theIndex;
   EXPRESSION arg;

   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv);
   ins = CheckMultifieldSlotInstance(theEnv,(char*)"slot-insert$");
   if (ins == NULL)
     return;
   sp = CheckMultifieldSlotModify(theEnv,INSERT,(char*)"slot-insert$",ins,
                            GetFirstArgument()->nextArg,&theIndex,NULL,&newval);
   if (sp == NULL)
     return;
   AssignSlotToDataObject(&oldseg,sp);
   if (InsertMultiValueField(theEnv,&newseg,&oldseg,theIndex,&newval,(char*)"slot-insert$") == FALSE)
     return;
   arg.type = MULTIFIELD;
   arg.value = (void *) &newseg;
   arg.nextArg = NULL;
   arg.argList = NULL;
   DirectMessage(theEnv,sp->desc->overrideMessage,ins,result,&arg);
  }

globle int SetIncrementalResetCommand(
  void *theEnv,
  EXEC_STATUS)
  {
   int oldValue;
   DATA_OBJECT argPtr;
   struct defmodule *theModule;

   oldValue = EnvGetIncrementalReset(theEnv,execStatus);

   /*============================================*/
   /* Check for the correct number of arguments. */
   /*============================================*/

   if (EnvArgCountCheck(theEnv,execStatus,"set-incremental-reset",EXACTLY,1) == -1)
     { return(oldValue); }

   /*=========================================*/
   /* The incremental reset behavior can't be */
   /* changed when rules are loaded.          */
   /*=========================================*/

   SaveCurrentModule(theEnv,execStatus);

   for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,NULL);
        theModule != NULL;
        theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,theModule))
     {
      EnvSetCurrentModule(theEnv,execStatus,(void *) theModule);
      if (EnvGetNextDefrule(theEnv,execStatus,NULL) != NULL)
        {
         RestoreCurrentModule(theEnv,execStatus);
         PrintErrorID(theEnv,execStatus,"INCRRSET",1,FALSE);
         EnvPrintRouter(theEnv,execStatus,WERROR,"The incremental reset behavior cannot be changed with rules loaded.\n");
         SetEvaluationError(theEnv,execStatus,TRUE);
         return(oldValue);
        }
     }
     
   RestoreCurrentModule(theEnv,execStatus);

   /*==================================================*/
   /* The symbol FALSE disables incremental reset. Any */
   /* other value enables incremental reset.           */
   /*==================================================*/

   EnvRtnUnknown(theEnv,execStatus,1,&argPtr);

   if ((argPtr.value == EnvFalseSymbol(theEnv,execStatus)) && (argPtr.type == SYMBOL))
     { EnvSetIncrementalReset(theEnv,execStatus,FALSE); }
   else
     { EnvSetIncrementalReset(theEnv,execStatus,TRUE); }

   /*=======================*/
   /* Return the old value. */
   /*=======================*/

   return(oldValue);
  }

globle void EvalFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   PrintErrorID(theEnv,"STRNGFUN",1,FALSE);
   EnvPrintRouter(theEnv,WERROR,"Function eval does not work in run time modules.\n");
   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,EnvFalseSymbol(theEnv));
  }

globle void *GetFocusFunction(
  void *theEnv)
  {
   struct defmodule *rv;

   EnvArgCountCheck(theEnv,"get-focus",EXACTLY,0);
   rv = (struct defmodule *) EnvGetFocus(theEnv);
   if (rv == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv));
   return(rv->name);
  }

/***********************************************************************
  NAME         : DummyExpandFuncMultifield
  DESCRIPTION  : The expansion of multifield arguments is valid only
                 when done for a function call.  All these expansions
                 are handled by the H/L wrap-around function
                 (expansion-call) - see ExpandFuncCall.  If the H/L
                 function, epand-multifield is ever called directly,
                 it is an error.
  INPUTS       : Data object buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : EvaluationError set
  NOTES        : None
 **********************************************************************/
globle void DummyExpandFuncMultifield(
    void *theEnv,
    DATA_OBJECT *result)
{
    result->type = SYMBOL;
    result->value = EnvFalseSymbol(theEnv);
    SetEvaluationError(theEnv,TRUE);
    PrintErrorID(theEnv,"MISCFUN",1,FALSE);
    EnvPrintRouter(theEnv,WERROR,"expand$ must be used in the argument list of a function call.\n");
}

/*******************************************************
  NAME         : EvaluateDeffunctionCall
  DESCRIPTION  : Primitive support function for
                 calling a deffunction
  INPUTS       : 1) The deffunction
                 2) A data object buffer to hold
                    the evaluation result
  RETURNS      : FALSE if the deffunction
                 returns the symbol FALSE,
                 TRUE otherwise
  SIDE EFFECTS : Data obejct buffer set and any
                 side-effects of calling the deffunction
  NOTES        : None
 *******************************************************/
static intBool EvaluateDeffunctionCall(
  void *theEnv,
  void *value,
  DATA_OBJECT *result)
  {
   CallDeffunction(theEnv,(DEFFUNCTION *) value,GetFirstArgument(),result);
   if ((GetpType(result) == SYMBOL) &&
       (GetpValue(result) == EnvFalseSymbol(theEnv)))
     return(FALSE);
   return(TRUE);
  }

/*****************************************************
  NAME         : ObjectCmpConstantFunction
  DESCRIPTION  : Used to compare object slot values
                 against a constant
  INPUTS       : 1) The constant test bitmap
                 2) Data object buffer to hold result
  RETURNS      : TRUE if test successful,
                 FALSE otherwise
  SIDE EFFECTS : Buffer set to symbol TRUE if test
                 successful, FALSE otherwise
  NOTES        : Called directly by
                   EvaluatePatternExpression()
 *****************************************************/
globle intBool ObjectCmpConstantFunction(
    void *theEnv,
    void *theValue,
    DATA_OBJECT *theResult)
{
    struct ObjectCmpPNConstant *hack;
    DATA_OBJECT theVar;
    EXPRESSION *constantExp;
    int rv;
    SEGMENT *theSegment;

    hack = (struct ObjectCmpPNConstant *) ValueToBitMap(theValue);
    if (hack->general)
    {
        EvaluateExpression(theEnv,GetFirstArgument(),&theVar);
        constantExp = GetFirstArgument()->nextArg;
    }
    else
    {
        constantExp = GetFirstArgument();
        if (ObjectReteData(theEnv)->CurrentPatternObjectSlot->type == MULTIFIELD)
        {
            theSegment = (struct multifield *) ObjectReteData(theEnv)->CurrentPatternObjectSlot->value;
            if (hack->fromBeginning)
            {
                theVar.type = theSegment->theFields[hack->offset].type;
                theVar.value = theSegment->theFields[hack->offset].value;
            }
            else
            {
                theVar.type = theSegment->theFields[theSegment->multifieldLength -
                                                    (hack->offset + 1)].type;
                theVar.value = theSegment->theFields[theSegment->multifieldLength -
                                                     (hack->offset + 1)].value;
            }
        }
        else
        {
            theVar.type = (unsigned short) ObjectReteData(theEnv)->CurrentPatternObjectSlot->type;
            theVar.value = ObjectReteData(theEnv)->CurrentPatternObjectSlot->value;
        }
    }
    if (theVar.type != constantExp->type)
        rv = hack->fail;
    else if (theVar.value != constantExp->value)
        rv = hack->fail;
    else
        rv = hack->pass;
    theResult->type = SYMBOL;
    theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv);
    return(rv);
}

/***************************************************************************
  NAME         : GetQueryFactSlot
  DESCRIPTION  : Internal function for referring to slots of fact in
                    fact array on fact-queries
  INPUTS       : The caller's result buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Caller's result buffer set appropriately
  NOTES        : H/L Syntax : ((query-fact-slot) <index> <slot-name>)
 **************************************************************************/
globle void GetQueryFactSlot(
  void *theEnv,
  DATA_OBJECT *result)
  {
   struct fact *theFact;
   DATA_OBJECT temp;
   QUERY_CORE *core;
   short position;

   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv);

   core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument())));
   theFact = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))];
   EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp);
   if (temp.type != SYMBOL)
     {
      ExpectedTypeError1(theEnv,"get",1,"symbol");
      SetEvaluationError(theEnv,TRUE);
      return;
     }
     
   /*==================================================*/
   /* Make sure the slot exists (the symbol implied is */
   /* used for the implied slot of an ordered fact).   */
   /*==================================================*/

   if (theFact->whichDeftemplate->implied)
     {
      if (strcmp(ValueToString(temp.value),"implied") != 0)
        {
         SlotExistError(theEnv,ValueToString(temp.value),"fact-set query");
         return;
        }
      position = 1;
     }

   else if (FindSlot((struct deftemplate *) theFact->whichDeftemplate,
                     (struct symbolHashNode *) temp.value,&position) == NULL)
     {
      SlotExistError(theEnv,ValueToString(temp.value),"fact-set query");
      return;
     }
     
   result->type = theFact->theProposition.theFields[position-1].type;
   result->value = theFact->theProposition.theFields[position-1].value;
   if (result->type == MULTIFIELD)
     {
      SetpDOBegin(result,1);
      SetpDOEnd(result,((struct multifield *) result->value)->multifieldLength);
     }
  }

globle void *GetCurrentModuleCommand(
  void *theEnv)
  {
   struct defmodule *theModule;

   EnvArgCountCheck(theEnv,"get-current-module",EXACTLY,0);

   theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);

   if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv));

   return((SYMBOL_HN *) EnvAddSymbol(theEnv,ValueToString(theModule->name)));
  }

globle void ReturnFunction(
  void *theEnv,
  DATA_OBJECT_PTR result)
  {
   if (EnvRtnArgCount(theEnv) == 0)
     {
      result->type = RVOID;
      result->value = EnvFalseSymbol(theEnv);
     }
   else
     EnvRtnUnknown(theEnv,1,result);
   ProcedureFunctionData(theEnv)->ReturnFlag = TRUE;
  }

globle void StrIndexFunction(
  void *theEnv,
  DATA_OBJECT_PTR result)
  {
   DATA_OBJECT theArgument1, theArgument2;
   char *strg1, *strg2;
   int i, j;

   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv);

   /*===================================*/
   /* Check and retrieve the arguments. */
   /*===================================*/

   if (EnvArgCountCheck(theEnv,"str-index",EXACTLY,2) == -1) return;

   if (EnvArgTypeCheck(theEnv,"str-index",1,SYMBOL_OR_STRING,&theArgument1) == FALSE) return;

   if (EnvArgTypeCheck(theEnv,"str-index",2,SYMBOL_OR_STRING,&theArgument2) == FALSE) return;

   strg1 = DOToString(theArgument1);
   strg2 = DOToString(theArgument2);

   /*=================================*/
   /* Find the position in string2 of */
   /* string1 (counting from 1).      */
   /*=================================*/

   if (strlen(strg1) == 0)
     {
      result->type = INTEGER;
      result->value = (void *) EnvAddLong(theEnv,(long) strlen(strg2) + 1L);
      return;
     }

   for (i=1; *strg2; i++, strg2++)
     {
      for (j=0; *(strg1+j) && *(strg1+j) == *(strg2+j); j++)
        { /* Do Nothing */ }

      if (*(strg1+j) == '\0')
        {
         result->type = INTEGER;
         result->value = (void *) EnvAddLong(theEnv,(long) i);
         return;
        }
     }

   return;
  }

/****************************************************************
  NAME         : SetSORCommand
  DESCRIPTION  : Toggles SequenceOpMode - if TRUE, multifield
                   references are replaced with sequence
                   expansion operators
  INPUTS       : None
  RETURNS      : The old value of SequenceOpMode
  SIDE EFFECTS : SequenceOpMode toggled
  NOTES        : None
 ****************************************************************/
globle BOOLEAN SetSORCommand(
    void *theEnv)
{
#if (! RUN_TIME) && (! BLOAD_ONLY)
    DATA_OBJECT arg;

    if (EnvArgTypeCheck(theEnv,"set-sequence-operator-recognition",1,SYMBOL,&arg) == FALSE)
        return(ExpressionData(theEnv)->SequenceOpMode);
    return(EnvSetSequenceOperatorRecognition(theEnv,(arg.value == EnvFalseSymbol(theEnv)) ?
            FALSE : TRUE));
#else
    return(ExpressionData(theEnv)->SequenceOpMode);
#endif
}

/******************************************************************************
  NAME         : DelayedQueryDoForAllInstances
  DESCRIPTION  : Finds all sets of instances which satisfy the query and
                   and exceutes a user-action for each set

                 This function differs from QueryDoForAllInstances() in
                   that it forms the complete list of query satisfactions
                   BEFORE executing any actions.
  INPUTS       : Caller's result buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : The query class-expressions are evaluated once,
                   and the query boolean-expression is evaluated
                   once for every instance set.  The action is executed
                   for evry query satisfaction.
                 Caller's result buffer holds result of last action executed.
  NOTES        : H/L Syntax : See ParseQueryNoAction()
 ******************************************************************************/
globle void DelayedQueryDoForAllInstances(
  void *theEnv,
  EXEC_STATUS,
  DATA_OBJECT *result)
  {
   QUERY_CLASS *qclasses;
   unsigned rcnt;
   register unsigned i;

   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv,execStatus);
   qclasses = DetermineQueryClasses(theEnv,execStatus,GetFirstArgument()->nextArg->nextArg,
                                      "delayed-do-for-all-instances",&rcnt);
   if (qclasses == NULL)
     return;
   PushQueryCore(theEnv,execStatus);
   InstanceQueryData(theEnv,execStatus)->QueryCore = get_struct(theEnv,execStatus,query_core);
   InstanceQueryData(theEnv,execStatus)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,execStatus,(sizeof(INSTANCE_TYPE *) * rcnt));
   InstanceQueryData(theEnv,execStatus)->QueryCore->query = GetFirstArgument();
   InstanceQueryData(theEnv,execStatus)->QueryCore->action = NULL;
   InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set = NULL;
   InstanceQueryData(theEnv,execStatus)->QueryCore->soln_size = rcnt;
   InstanceQueryData(theEnv,execStatus)->QueryCore->soln_cnt = 0;
   TestEntireChain(theEnv,execStatus,qclasses,0);
   InstanceQueryData(theEnv,execStatus)->AbortQuery = FALSE;
   InstanceQueryData(theEnv,execStatus)->QueryCore->action = GetFirstArgument()->nextArg;
   while (InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set != NULL)
     {
      for (i = 0 ; i < rcnt ; i++)
        InstanceQueryData(theEnv,execStatus)->QueryCore->solns[i] = InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set->soln[i];
      PopQuerySoln(theEnv,execStatus);
      execStatus->CurrentEvaluationDepth++;
      EvaluateExpression(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->action,result);
      execStatus->CurrentEvaluationDepth--;
      if (ProcedureFunctionData(theEnv,execStatus)->ReturnFlag == TRUE)
        { PropagateReturnValue(theEnv,execStatus,result); }
      PeriodicCleanup(theEnv,execStatus,FALSE,TRUE);
      if (execStatus->HaltExecution || ProcedureFunctionData(theEnv,execStatus)->BreakFlag || ProcedureFunctionData(theEnv,execStatus)->ReturnFlag)
        {
         while (InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set != NULL)
           PopQuerySoln(theEnv,execStatus);
         break;
        }
     }
   ProcedureFunctionData(theEnv,execStatus)->BreakFlag = FALSE;
   rm(theEnv,execStatus,(void *) InstanceQueryData(theEnv,execStatus)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt));
   rtn_struct(theEnv,execStatus,query_core,InstanceQueryData(theEnv,execStatus)->QueryCore);
   PopQueryCore(theEnv,execStatus);
   DeleteQueryClasses(theEnv,execStatus,qclasses);
  }

/*****************************************************************
  NAME         : TestForFirstFactInTemplate
  DESCRIPTION  : Processes all facts in a template
  INPUTS       : 1) Visitation traversal id
                 2) The template
                 3) The current template restriction chain
                 4) The index of the current restriction
  RETURNS      : TRUE if query succeeds, FALSE otherwise
  SIDE EFFECTS : Fact variable values set
  NOTES        : None
 *****************************************************************/
static int TestForFirstFactInTemplate(
  void *theEnv,
  struct deftemplate *templatePtr,
  QUERY_TEMPLATE *qchain,
  int indx)
  {
   struct fact *theFact;
   DATA_OBJECT temp;

   theFact = templatePtr->factList;
   while (theFact != NULL)
     {
      FactQueryData(theEnv)->QueryCore->solns[indx] = theFact;
      if (qchain->nxt != NULL)
        {
         theFact->factHeader.busyCount++;
         if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == TRUE)
           {
            theFact->factHeader.busyCount--;
            break;
           }
         theFact->factHeader.busyCount--;
         if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
           break;
        }
      else
        {
         theFact->factHeader.busyCount++;
         EvaluationData(theEnv)->CurrentEvaluationDepth++;
         EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp);
         EvaluationData(theEnv)->CurrentEvaluationDepth--;
         PeriodicCleanup(theEnv,FALSE,TRUE);
         theFact->factHeader.busyCount--;
         if (EvaluationData(theEnv)->HaltExecution == TRUE)
           break;
         if ((temp.type != SYMBOL) ? TRUE :
             (temp.value != EnvFalseSymbol(theEnv)))
           break;
        }
      theFact = theFact->nextTemplateFact;
      while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE)
        theFact = theFact->nextTemplateFact;
     }

   if (theFact != NULL)
     return(((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
             ? FALSE : TRUE);

   return(FALSE);
  }