C++ GenConstant函數代碼示例

/**********************************************
  Build functions used by AddPatternParser() to
  provide object access to the pattern network
 **********************************************/
globle EXPRESSION *GenObjectPNConstantCompare(
  void *theEnv,
  struct lhsParseNode *theNode)
  {
   struct ObjectCmpPNConstant hack;
   EXPRESSION *theExp;
   unsigned short tmpType;

   /* ===============================================================
      If the value of a single field slot (or relation name) is being
      compared against a constant, then use specialized routines for
      doing the comparison.

      If a constant comparison is being done within a multifield slot
      and the constant's position has no multifields to the left or
      no multifields to the right, then use the same routine used for
      the single field slot case, but include the offset from either
      the beginning or end of the slot.

      Otherwise, use a general eq/neq test.
      =============================================================== */
   ClearBitString((void *) &hack,(int) sizeof(struct ObjectCmpPNConstant));
   if (theNode->negated)
     hack.fail = 1;
   else
     hack.pass = 1;
   if (((theNode->withinMultifieldSlot == FALSE) ||
        (theNode->multiFieldsAfter == 0) ||
        (theNode->multiFieldsBefore == 0)) &&
       (theNode->slotNumber != ISA_ID) && (theNode->slotNumber != NAME_ID))
     {
      if (theNode->withinMultifieldSlot == FALSE)
        hack.fromBeginning = TRUE;
      else if (theNode->multiFieldsBefore == 0)
        {
         hack.fromBeginning = TRUE;
         hack.offset = theNode->singleFieldsBefore;
        }
      else
        hack.offset = theNode->singleFieldsAfter;
      theExp = GenConstant(theEnv,OBJ_PN_CONSTANT,AddBitMap(theEnv,(void *) &hack,
                                        (int) sizeof(struct ObjectCmpPNConstant)));
      theExp->argList = GenConstant(theEnv,theNode->type,theNode->value);
     }
   else
     {
      hack.general = 1;
      theExp = GenConstant(theEnv,OBJ_PN_CONSTANT,AddBitMap(theEnv,(void *) &hack,
                                        (int) sizeof(struct ObjectCmpPNConstant)));
      theExp->argList = GenConstant(theEnv,0,NULL);
      tmpType = theNode->type;
      theNode->type = SF_VARIABLE;
      GenObjectGetVar(theEnv,FALSE,theExp->argList,theNode);
      theNode->type = tmpType;
      theExp->argList->nextArg = GenConstant(theEnv,theNode->type,theNode->value);
     }
   return(theExp);
  }

static void IntersectAllowedValueExpressions(
  CONSTRAINT_RECORD *constraint1,
  CONSTRAINT_RECORD *constraint2,
  CONSTRAINT_RECORD *newConstraint)
  {
   struct expr *theList1, *theList2;
   struct expr *theHead = NULL, *tmpExpr;

   /*===========================================*/
   /* Loop through each value in allowed-values */
   /* list of the first constraint record. Add  */
   /* each value to a list if it satisfies the  */
   /* restrictions for both constraint records. */
   /*===========================================*/

   for (theList1 = constraint1->restrictionList;
        theList1 != NULL;
        theList1 = theList1->nextArg)
     {
      if (CheckAllowedValuesConstraint(theList1->type,theList1->value,constraint1) &&
          CheckAllowedValuesConstraint(theList1->type,theList1->value,constraint2))
        {
         tmpExpr = GenConstant(theList1->type,theList1->value);
         tmpExpr->nextArg = theHead;
         theHead = tmpExpr;
        }
     }

   /*===========================================*/
   /* Loop through each value in allowed-values */
   /* list of the second constraint record. Add */
   /* each value to a list if it satisfies the  */
   /* restrictions for both constraint records. */
   /*===========================================*/

   for (theList2 = constraint2->restrictionList;
        theList2 != NULL;
        theList2 = theList2->nextArg)
     {
      if (FindItemInExpression(theList2->type,theList2->value,TRUE,theHead))
        { /* The value is already in the list--Do nothing */ }
      else if (CheckAllowedValuesConstraint(theList2->type,theList2->value,constraint1) &&
               CheckAllowedValuesConstraint(theList2->type,theList2->value,constraint2))
        {
         tmpExpr = GenConstant(theList2->type,theList2->value);
         tmpExpr->nextArg = theHead;
         theHead = tmpExpr;
        }
     }

   /*================================================*/
   /* Set the allowed values list for the constraint */
   /* record to the intersected values of the two    */
   /* other constraint records.                      */
   /*================================================*/

   newConstraint->restrictionList = theHead;
  }

globle struct expr *FactPNVariableComparison(
  struct lhsParseNode *selfNode,
  struct lhsParseNode *referringNode)
  {
   struct expr *top;
   struct factCompVarsPN1Call hack;

   /*===================================================*/
   /* Clear the bitmap for storing the argument values. */
   /*===================================================*/

   ClearBitString(&hack,sizeof(struct factCompVarsPN1Call));

   /*================================================================*/
   /* If two single field slots of a deftemplate are being compared, */
   /* then use the following specified variable comparison routine.  */
   /*================================================================*/

   if ((selfNode->withinMultifieldSlot == FALSE) &&
       (selfNode->slotNumber > 0) &&
       (referringNode->withinMultifieldSlot == FALSE) &&
       (referringNode->slotNumber > 0))
     {
      hack.pass = 0;
      hack.fail = 0;
      hack.field1 = (unsigned int) selfNode->slotNumber - 1;
      hack.field2 = (unsigned int) referringNode->slotNumber - 1;

      if (selfNode->negated) hack.fail = 1;
      else hack.pass = 1;

      top = GenConstant(FACT_PN_CMP1,AddBitMap(&hack,sizeof(struct factCompVarsPN1Call)));
     }

   /*================================================================*/
   /* Otherwise, use the eq function to compare the values retrieved */
   /* by the appropriate get variable value functions.               */
   /*================================================================*/

   else
     {
      if (selfNode->negated) top = GenConstant(FCALL,PTR_NEQ);
      else top = GenConstant(FCALL,PTR_EQ);

      top->argList = FactGenGetfield(selfNode);
      top->argList->nextArg = FactGenGetfield(referringNode);
     }

   /*======================================*/
   /* Return the expression for performing */
   /* the variable comparison.             */
   /*======================================*/

   return(top);
  }

/*************************************************************************
  NAME         : ReplaceSlotReference
  DESCRIPTION  : Replaces instance-set query function variable
                   references of the form: <instance-variable>:<slot-name>
                   with function calls to get these instance-slots at run
                   time
  INPUTS       : 1) The instance-set variable list
                 2) The expression containing the variable
                 3) The address of the instance slot access function
                 4) Nesting depth of query functions
  RETURNS      : Nothing useful
  SIDE EFFECTS : If the variable is a slot reference, then it is replaced
                   with the appropriate function-call.
  NOTES        : None
 *************************************************************************/
static void ReplaceSlotReference(
  void *theEnv,
  EXEC_STATUS,
  EXPRESSION *vlist,
  EXPRESSION *theExp,
  struct FunctionDefinition *func,
  int ndepth)
  {
   size_t len;
   int posn,oldpp;
   size_t i;
   register char *str;
   EXPRESSION *eptr;
   struct token itkn;

   str = ValueToString(theExp->value);
   len =  strlen(str);
   if (len < 3)
     return;
   for (i = len-2 ; i >= 1 ; i--)
     {
      if ((str[i] == INSTANCE_SLOT_REF) ? (i >= 1) : FALSE)
        {
         eptr = vlist;
         posn = 0;
         while (eptr && ((i != strlen(ValueToString(eptr->value))) ||
                         strncmp(ValueToString(eptr->value),str,
                                 (STD_SIZE) i)))
           {
            eptr = eptr->nextArg;
            posn++;
           }
         if (eptr != NULL)
           {
            OpenStringSource(theEnv,execStatus,"query-var",str+i+1,0);
            oldpp = GetPPBufferStatus(theEnv,execStatus);
            SetPPBufferStatus(theEnv,execStatus,OFF);
            GetToken(theEnv,execStatus,"query-var",&itkn);
            SetPPBufferStatus(theEnv,execStatus,oldpp);
            CloseStringSource(theEnv,execStatus,"query-var");
            theExp->type = FCALL;
            theExp->value = (void *) func;
            theExp->argList = GenConstant(theEnv,execStatus,INTEGER,(void *) EnvAddLong(theEnv,execStatus,(long long) ndepth));
            theExp->argList->nextArg =
              GenConstant(theEnv,execStatus,INTEGER,(void *) EnvAddLong(theEnv,execStatus,(long long) posn));
            theExp->argList->nextArg->nextArg = GenConstant(theEnv,execStatus,itkn.type,itkn.value);
            break;
           }
        }
     }
  }

static void ReplaceLoopCountVars(
  SYMBOL_HN *loopVar,
  EXPRESSION *exp,
  int depth)
  {
   while (exp != NULL)
     {
      if ((exp->type != SF_VARIABLE) ? FALSE :
          (strcmp(ValueToString(exp->value),ValueToString(loopVar)) == 0))
        {
         exp->type = FCALL;
         exp->value = (void *) FindFunction("(get-loop-count)");
         exp->argList = GenConstant(INTEGER,AddLong((long) depth));
        }
      else if (exp->argList != NULL)
        {
         if ((exp->type != FCALL) ? FALSE :
             (exp->value == (void *) FindFunction("loop-for-count")))
           ReplaceLoopCountVars(loopVar,exp->argList,depth+1);
         else
           ReplaceLoopCountVars(loopVar,exp->argList,depth);
        }
      exp = exp->nextArg;
     }
  }

static struct expr *GenPNColon(
  void *theEnv,
  struct lhsParseNode *theField)
  {
   struct expr *top, *conversion;

   /*==================================================*/
   /* Replace variables with function calls to extract */
   /* the appropriate value from the data entity.      */
   /*==================================================*/

   conversion = GetfieldReplace(theEnv,theField->expression);

   /*================================================*/
   /* If the predicate constraint is negated by a ~, */
   /* then wrap a "not" function call around the     */
   /* expression before returning it. Otherwise,     */
   /* just return the expression.                    */
   /*================================================*/

   if (theField->negated)
     {
      top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NOT);
      top->argList = conversion;
     }
   else
     { top = conversion; }

   return(top);
  }

static void ReplaceLoopCountVars(
  void *theEnv,
  SYMBOL_HN *loopVar,
  EXPRESSION *theExp,
  int depth)
  {
   while (theExp != NULL)
     {
      if ((theExp->type != SF_VARIABLE) ? FALSE :
          (strcmp(ValueToString(theExp->value),ValueToString(loopVar)) == 0))
        {
         theExp->type = FCALL;
         theExp->value = (void *) FindFunction(theEnv,"(get-loop-count)");
         theExp->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long) depth));
        }
      else if (theExp->argList != NULL)
        {
         if ((theExp->type != FCALL) ? FALSE :
             (theExp->value == (void *) FindFunction(theEnv,"loop-for-count")))
           ReplaceLoopCountVars(theEnv,loopVar,theExp->argList,depth+1);
         else
           ReplaceLoopCountVars(theEnv,loopVar,theExp->argList,depth);
        }
      theExp = theExp->nextArg;
     }
  }

/***************************************************
  NAME         : Send
  DESCRIPTION  : C Interface for sending messages to
                  instances
  INPUTS       : 1) The data object of the instance
                 2) The message name-string
                 3) The message arguments string
                    (Constants only)
                 4) Caller's buffer for result
  RETURNS      : Nothing useful
  SIDE EFFECTS : Executes message and stores result
                   caller's buffer
  NOTES        : None
 ***************************************************/
globle void Send(
  DATA_OBJECT *idata,
  char *msg,
  char *args,
  DATA_OBJECT *result)
  {
   int error;
   EXPRESSION *iexp;
   SYMBOL_HN *msym;

   SetEvaluationError(FALSE);
   result->type = SYMBOL;
   result->value = FalseSymbol;
   msym = FindSymbol(msg);
   if (msym == NULL)
     {
      PrintNoHandlerError(msg);
      SetEvaluationError(TRUE);
      return;
     }
   iexp = GenConstant(idata->type,idata->value);
   iexp->nextArg = ParseConstantArguments(args,&error);
   if (error == TRUE)
     {
      ReturnExpression(iexp);
      SetEvaluationError(TRUE);
      return;
     }
   PerformMessage(result,iexp,msym);
   ReturnExpression(iexp);

   if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
       (CurrentExpression == NULL))
     { PeriodicCleanup(TRUE,FALSE); }
  }

static struct expr *StandardLoadFact(
  void *theEnv,
  char *logicalName,
  struct token *theToken)
  {
   int error = FALSE;
   struct expr *temp;

   GetToken(theEnv,logicalName,theToken);
   if (theToken->type != LPAREN) return(NULL);

   temp = GenConstant(theEnv,FCALL,FindFunction(theEnv,(char*)"assert"));
   temp->argList = GetRHSPattern(theEnv,logicalName,theToken,&error,
                                  TRUE,FALSE,TRUE,RPAREN);

   if (error == TRUE)
     {
      EnvPrintRouter(theEnv,WERROR,(char*)"Function load-facts encountered an error\n");
      SetEvaluationError(theEnv,TRUE);
      ReturnExpression(theEnv,temp);
      return(NULL);
     }

   if (ExpressionContainsVariables(temp,TRUE))
     {
      ReturnExpression(theEnv,temp);
      return(NULL);
     }

   return(temp);
  }

/****************************************************
  NAME         : GenObjectLengthTest
  DESCRIPTION  : Generates a test on the cardinality
                 of a slot matching an object pattern
  INPUTS       : The first lhsParseNode for a slot
                 in an object pattern
  RETURNS      : Nothing useful
  SIDE EFFECTS : The lhsParseNode network test is
                 modified to include the length test
  NOTES        : None
 ****************************************************/
globle void GenObjectLengthTest(
  void *theEnv,
  struct lhsParseNode *theNode)
  {
   struct ObjectMatchLength hack;
   EXPRESSION *theTest;

   if ((theNode->singleFieldsAfter == 0) &&
       (theNode->type != SF_VARIABLE) &&
       (theNode->type != SF_WILDCARD))
     return;

   ClearBitString((void *) &hack,(int) sizeof(struct ObjectMatchLength));

   if ((theNode->type != MF_VARIABLE) &&
       (theNode->type != MF_WILDCARD) &&
       (theNode->multiFieldsAfter == 0))
     hack.exactly = 1;
   else
     hack.exactly = 0;

   if ((theNode->type == SF_VARIABLE) || (theNode->type == SF_WILDCARD))
     hack.minLength = 1 + theNode->singleFieldsAfter;
   else
     hack.minLength = theNode->singleFieldsAfter;

   theTest = GenConstant(theEnv,OBJ_SLOT_LENGTH,EnvAddBitMap(theEnv,(void *) &hack,
                                         (int) sizeof(struct ObjectMatchLength)));
                                         
   if (theNode->constantSelector != NULL)
     { theNode->constantSelector->nextArg = CopyExpression(theEnv,theTest); }

   theNode->networkTest = CombineExpressions(theEnv,theTest,theNode->networkTest);
  }

/***********************************************************************************
  NAME         : ReplaceInstanceVariables
  DESCRIPTION  : Replaces all references to instance-variables within an
                   instance query-function with function calls to query-instance
                   (which references the instance array at run-time)
  INPUTS       : 1) The instance-variable list
                 2) A boolean expression containing variable references
                 3) A flag indicating whether to allow slot references of the type
                    <instance-query-variable>:<slot-name> for direct slot access
                    or not
                 4) Nesting depth of query functions
  RETURNS      : Nothing useful
  SIDE EFFECTS : If a SF_VARIABLE node is found and is on the list of instance
                   variables, it is replaced with a query-instance function call.
  NOTES        : Other SF_VARIABLE(S) are left alone for replacement by other
                   parsers.  This implies that a user may use defgeneric,
                   defrule, and defmessage-handler variables within a query-function
                   where they do not conflict with instance-variable names.
 ***********************************************************************************/
static void ReplaceInstanceVariables(
  void *theEnv,
  EXEC_STATUS,
  EXPRESSION *vlist,
  EXPRESSION *bexp,
  int sdirect,
  int ndepth)
  {
   EXPRESSION *eptr;
   struct FunctionDefinition *rindx_func,*rslot_func;
   int posn;

   rindx_func = FindFunction(theEnv,execStatus,"(query-instance)");
   rslot_func = FindFunction(theEnv,execStatus,"(query-instance-slot)");
   while (bexp != NULL)
     {
      if (bexp->type == SF_VARIABLE)
        {
         eptr = vlist;
         posn = 0;
         while ((eptr != NULL) ? (eptr->value != bexp->value) : FALSE)
           {
            eptr = eptr->nextArg;
            posn++;
           }
         if (eptr != NULL)
           {
            bexp->type = FCALL;
            bexp->value = (void *) rindx_func;
            eptr = GenConstant(theEnv,execStatus,INTEGER,(void *) EnvAddLong(theEnv,execStatus,(long long) ndepth));
            eptr->nextArg = GenConstant(theEnv,execStatus,INTEGER,(void *) EnvAddLong(theEnv,execStatus,(long long) posn));
            bexp->argList = eptr;
           }
         else if (sdirect == TRUE)
           ReplaceSlotReference(theEnv,execStatus,vlist,bexp,rslot_func,ndepth);
        }
      if (bexp->argList != NULL)
        {
         if (IsQueryFunction(bexp))
           ReplaceInstanceVariables(theEnv,execStatus,vlist,bexp->argList,sdirect,ndepth+1);
         else
           ReplaceInstanceVariables(theEnv,execStatus,vlist,bexp->argList,sdirect,ndepth);
        }
      bexp = bexp->nextArg;
     }
  }

static struct expr *GenJNVariableComparison(
  void *theEnv,
  EXEC_STATUS,
  struct lhsParseNode *selfNode,
  struct lhsParseNode *referringNode,
  int isNand)
  {
   struct expr *top;

   /*========================================================*/
   /* If either pattern is missing a function for generating */
   /* the appropriate test, then no test is generated.       */
   /*========================================================*/

   if ((selfNode->patternType->genCompareJNValuesFunction == NULL) ||
       (referringNode->patternType->genCompareJNValuesFunction == NULL))
     { return(NULL); }

   /*=====================================================*/
   /* If both patterns are of the same type, then use the */
   /* special function for generating the join test.      */
   /*=====================================================*/

   if (selfNode->patternType->genCompareJNValuesFunction ==
       referringNode->patternType->genCompareJNValuesFunction)

     {
      return (*selfNode->patternType->genCompareJNValuesFunction)(theEnv,execStatus,selfNode,
                                                                  referringNode,isNand);
     }

   /*===========================================================*/
   /* If the patterns are of different types, then generate a   */
   /* join test by using the eq/neq function with its arguments */
   /* being function calls to retrieve the appropriate values   */
   /* from the patterns.                                        */
   /*===========================================================*/

   if (selfNode->negated) top = GenConstant(theEnv,execStatus,FCALL,ExpressionData(theEnv,execStatus)->PTR_NEQ);
   else top = GenConstant(theEnv,execStatus,FCALL,ExpressionData(theEnv,execStatus)->PTR_EQ);

   top->argList = (*selfNode->patternType->genGetJNValueFunction)(theEnv,execStatus,selfNode,RHS);
   top->argList->nextArg = (*referringNode->patternType->genGetJNValueFunction)(theEnv,execStatus,referringNode,LHS);

   return(top);
  }

globle struct expr *FunctionReferenceExpression(
  void *theEnv,
  const char *name)
  {
#if DEFGENERIC_CONSTRUCT
   void *gfunc;
#endif
#if DEFFUNCTION_CONSTRUCT
   void *dptr;
#endif
   struct FunctionDefinition *fptr;

   /*=====================================================*/
   /* Check to see if the function call is a deffunction. */
   /*=====================================================*/

#if DEFFUNCTION_CONSTRUCT
   if ((dptr = (void *) LookupDeffunctionInScope(theEnv,name)) != NULL)
     { return(GenConstant(theEnv,PCALL,dptr)); }
#endif

   /*====================================================*/
   /* Check to see if the function call is a defgeneric. */
   /*====================================================*/

#if DEFGENERIC_CONSTRUCT
   if ((gfunc = (void *) LookupDefgenericInScope(theEnv,name)) != NULL)
     { return(GenConstant(theEnv,GCALL,gfunc)); }
#endif

   /*======================================*/
   /* Check to see if the function call is */
   /* a system or user defined function.   */
   /*======================================*/

   if ((fptr = FindFunction(theEnv,name)) != NULL)
     { return(GenConstant(theEnv,FCALL,fptr)); }

   /*===================================================*/
   /* The specified function name is not a deffunction, */
   /* defgeneric, or user/system defined function.      */
   /*===================================================*/

   return(NULL);
  }

globle EXPRESSION *GenGetJNObjectValue(
  struct lhsParseNode *theNode)
  {
   EXPRESSION *theItem;

   theItem = GenConstant(0,NULL);
   GenObjectGetVar(TRUE,theItem,theNode);
   return(theItem);
  }

static struct expr *AddToUnionList(
  void *theEnv,
  struct expr *theList1,
  struct expr *theHead,
  CONSTRAINT_RECORD *theConstraint)
  {
   struct expr *theList2;
   int flag;

   /*======================================*/
   /* Loop through each value in the list  */
   /* being added to the unioned set.      */
   /*======================================*/

   for (;theList1 != NULL; theList1 = theList1->nextArg)
     {
      /*===================================*/
      /* Determine if the value is already */
      /* in the unioned list.              */
      /*===================================*/

      flag = TRUE;
      for (theList2 = theHead;
           theList2 != NULL;
           theList2 = theList2->nextArg)
        {
         if ((theList1->type == theList2->type) &&
             (theList1->value == theList2->value))
           {
            flag = FALSE;
            break;
           }
        }

      /*=====================================================*/
      /* If the value wasn't in the unioned list and doesn't */
      /* violate any of the unioned list's constraints, then */
      /* add it to the list.                                 */
      /*=====================================================*/

      if (flag)
        {
         if (RestrictionOnType(theList1->type,theConstraint))
           {
            theList2 = GenConstant(theEnv,theList1->type,theList1->value);
            theList2->nextArg = theHead;
            theHead = theList2;
           }
        }
     }

   /*==============================*/
   /* Return the new unioned list. */
   /*==============================*/

   return(theHead);
  }