自学教程：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);  }

static void ClearDeffacts(  void *theEnv)  {#if (! RUN_TIME) && (! BLOAD_ONLY)   struct expr *stub;   struct deffacts *newDeffacts;   /*=====================================*/   /* Create the data structures for the  */   /* expression (assert (initial-fact)). */   /*=====================================*/   stub = GenConstant(theEnv,FCALL,FindFunction(theEnv,"assert"));   stub->argList = GenConstant(theEnv,DEFTEMPLATE_PTR,EnvFindDeftemplate(theEnv,"initial-fact"));   ExpressionInstall(theEnv,stub);   /*=============================================*/   /* Create a deffacts data structure to contain */   /* the expression and initialize it.           */   /*=============================================*/   newDeffacts = get_struct(theEnv,deffacts);   newDeffacts->header.whichModule =      (struct defmoduleItemHeader *) GetDeffactsModuleItem(theEnv,NULL);   newDeffacts->header.name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact");   IncrementSymbolCount(newDeffacts->header.name);   newDeffacts->assertList = PackExpression(theEnv,stub);   newDeffacts->header.next = NULL;   newDeffacts->header.ppForm = NULL;   newDeffacts->header.usrData = NULL;   ReturnExpression(theEnv,stub);   /*===========================================*/   /* Store the deffacts in the current module. */   /*===========================================*/   AddConstructToModule(&newDeffacts->header);#else#if MAC_MCW || WIN_MCW || MAC_XCD#pragma unused(theEnv)#endif#endif  }

globle EXPRESSION *GenGetPNObjectValue(  void *theEnv,  struct lhsParseNode *theNode)  {   EXPRESSION *theItem;   theItem = GenConstant(theEnv,0,NULL);   GenObjectGetVar(theEnv,FALSE,theItem,theNode,-1);   return(theItem);  }

/***************************************************  NAME         : CheckForFacetConflicts  DESCRIPTION  : Determines if all facets specified                 (and inherited) for a slot are                 consistent  INPUTS       : 1) The slot descriptor                 2) The parse record for the                    type constraints on the slot  RETURNS      : TRUE if all OK,                 FALSE otherwise  SIDE EFFECTS : Min and Max fields replaced in                 constraint for single-field slot  NOTES        : None ***************************************************/static intBool CheckForFacetConflicts(  void *theEnv,  EXEC_STATUS,  SLOT_DESC *sd,  CONSTRAINT_PARSE_RECORD *parsedConstraint)  {   if (sd->multiple == 0)     {      if (parsedConstraint->cardinality)        {         PrintErrorID(theEnv,execStatus,"CLSLTPSR",3,TRUE);         EnvPrintRouter(theEnv,execStatus,WERROR,"Cardinality facet can only be used with multifield slots/n");         return(FALSE);        }      else        {         ReturnExpression(theEnv,execStatus,sd->constraint->minFields);         ReturnExpression(theEnv,execStatus,sd->constraint->maxFields);         sd->constraint->minFields = GenConstant(theEnv,execStatus,INTEGER,EnvAddLong(theEnv,execStatus,1LL));         sd->constraint->maxFields = GenConstant(theEnv,execStatus,INTEGER,EnvAddLong(theEnv,execStatus,1LL));        }     }   if (sd->noDefault && sd->noWrite)     {      PrintErrorID(theEnv,execStatus,"CLSLTPSR",4,TRUE);      EnvPrintRouter(theEnv,execStatus,WERROR,"read-only slots must have a default value/n");      return(FALSE);     }   if (sd->noWrite && (sd->createWriteAccessor || sd->overrideMessageSpecified))     {      PrintErrorID(theEnv,execStatus,"CLSLTPSR",5,TRUE);      EnvPrintRouter(theEnv,execStatus,WERROR,"read-only slots cannot have a write accessor/n");      return(FALSE);     }   if (sd->noInherit && sd->publicVisibility)     {      PrintErrorID(theEnv,execStatus,"CLSLTPSR",6,TRUE);      EnvPrintRouter(theEnv,execStatus,WERROR,"no-inherit slots cannot also be public/n");      return(FALSE);     }   return(TRUE);  }

/********************************************************  NAME         : CreateInitialDefinstances  DESCRIPTION  : Makes the initial-object definstances                 structure for creating an initial-object                 which will match default object patterns                 in defrules  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : initial-object definstances created  NOTES        : None ********************************************************/static void CreateInitialDefinstances(  void *theEnv)  {   EXPRESSION *tmp;   DEFINSTANCES *theDefinstances;   theDefinstances = get_struct(theEnv,definstances);   InitializeConstructHeader(theEnv,(char*)"definstances",(struct constructHeader *) theDefinstances,                             DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);   theDefinstances->busy = 0;   tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,(char*)"make-instance"));   tmp->argList = GenConstant(theEnv,INSTANCE_NAME,(void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);   tmp->argList->nextArg =       GenConstant(theEnv,DEFCLASS_PTR,(void *) LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME));   theDefinstances->mkinstance = PackExpression(theEnv,tmp);   ReturnExpression(theEnv,tmp);   IncrementSymbolCount(GetDefinstancesNamePointer((void *) theDefinstances));   ExpressionInstall(theEnv,theDefinstances->mkinstance);   AddConstructToModule((struct constructHeader *) theDefinstances);  }

/***************************************************  NAME         : CheckForFacetConflicts  DESCRIPTION  : Determines if all facets specified                 (and inherited) for a slot are                 consistent  INPUTS       : 1) The slot descriptor                 2) The parse record for the                    type constraints on the slot  RETURNS      : True if all OK,                 false otherwise  SIDE EFFECTS : Min and Max fields replaced in                 constraint for single-field slot  NOTES        : None ***************************************************/static bool CheckForFacetConflicts(  Environment *theEnv,  SlotDescriptor *sd,  CONSTRAINT_PARSE_RECORD *parsedConstraint)  {   if (sd->multiple == 0)     {      if (parsedConstraint->cardinality)        {         PrintErrorID(theEnv,"CLSLTPSR",3,true);         WriteString(theEnv,STDERR,"The 'cardinality' facet can only be used with multifield slots./n");         return false;        }      else        {         ReturnExpression(theEnv,sd->constraint->minFields);         ReturnExpression(theEnv,sd->constraint->maxFields);         sd->constraint->minFields = GenConstant(theEnv,INTEGER_TYPE,CreateInteger(theEnv,1LL));         sd->constraint->maxFields = GenConstant(theEnv,INTEGER_TYPE,CreateInteger(theEnv,1LL));        }     }   if (sd->noDefault && sd->noWrite)     {      PrintErrorID(theEnv,"CLSLTPSR",4,true);      WriteString(theEnv,STDERR,"Slots with an 'access' facet value of 'read-only' must have a default value./n");      return false;     }   if (sd->noWrite && (sd->createWriteAccessor || sd->overrideMessageSpecified))     {      PrintErrorID(theEnv,"CLSLTPSR",5,true);      WriteString(theEnv,STDERR,"Slots with an 'access' facet value of 'read-only' cannot have a write accessor./n");      return false;     }   if (sd->noInherit && sd->publicVisibility)     {      PrintErrorID(theEnv,"CLSLTPSR",6,true);      WriteString(theEnv,STDERR,"Slots with a 'propagation' facet value of 'no-inherit' cannot have a 'visibility' facet value of 'public'./n");      return false;     }   return true;  }

globle struct expr *ArgumentParse(  void *theEnv,  char *logicalName,  int *errorFlag)  {   struct expr *top;   struct token theToken;   /*===============*/   /* Grab a token. */   /*===============*/   GetToken(theEnv,logicalName,&theToken);   /*============================*/   /* ')' counts as no argument. */   /*============================*/   if (theToken.type == RPAREN)     { return(NULL); }   /*================================*/   /* Parse constants and variables. */   /*================================*/   if ((theToken.type == SF_VARIABLE) || (theToken.type == MF_VARIABLE) ||       (theToken.type == SYMBOL) || (theToken.type == STRING) ||#if DEFGLOBAL_CONSTRUCT       (theToken.type == GBL_VARIABLE) ||       (theToken.type == MF_GBL_VARIABLE) ||#endif#if OBJECT_SYSTEM       (theToken.type == INSTANCE_NAME) ||#endif       (theToken.type == FLOAT) || (theToken.type == INTEGER))     { return(GenConstant(theEnv,theToken.type,theToken.value)); }   /*======================*/   /* Parse function call. */   /*======================*/   if (theToken.type != LPAREN)     {      PrintErrorID(theEnv,"EXPRNPSR",2,TRUE);      EnvPrintRouter(theEnv,WERROR,"Expected a constant, variable, or expression./n");      *errorFlag = TRUE;      return(NULL);     }   top = Function1Parse(theEnv,logicalName);   if (top == NULL) *errorFlag = TRUE;   return(top);  }

static int DefaultCompareSwapFunction(  void *theEnv,  DATA_OBJECT *item1,  DATA_OBJECT *item2)  {   DATA_OBJECT returnValue;   SortFunctionData(theEnv)->SortComparisonFunction->argList = GenConstant(theEnv,item1->type,item1->value);   SortFunctionData(theEnv)->SortComparisonFunction->argList->nextArg = GenConstant(theEnv,item2->type,item2->value);   ExpressionInstall(theEnv,SortFunctionData(theEnv)->SortComparisonFunction);   EvaluateExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction,&returnValue);   ExpressionDeinstall(theEnv,SortFunctionData(theEnv)->SortComparisonFunction);   ReturnExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction->argList);   SortFunctionData(theEnv)->SortComparisonFunction->argList = NULL;   if ((GetType(returnValue) == SYMBOL) &&       (GetValue(returnValue) == EnvFalseSymbol(theEnv)))     { return(FALSE); }   return(TRUE);  }

static struct expr *GenJNEq(  void *theEnv,  struct lhsParseNode *theField,  int isNand,  struct nandFrame *theNandFrames)  {   struct expr *top, *conversion;   /*==================================================*/   /* Replace variables with function calls to extract */   /* the appropriate value from the data entity.      */   /*==================================================*/   if (isNand)     { conversion = GetvarReplace(theEnv,theField->expression,TRUE,theNandFrames); }   else     { conversion = GetvarReplace(theEnv,theField->expression,FALSE,theNandFrames); }   /*============================================================*/   /* If the return value constraint is negated by a ~, then use */   /* the neq function to compare the value of the field to the  */   /* value returned by the function call. Otherwise, use eq to  */   /* compare the two values.                                    */   /*============================================================*/   if (theField->negated)     { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); }   else     { top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); }   if (isNand)     { top->argList = (*theField->patternType->genGetJNValueFunction)(theEnv,theField,NESTED_RHS); }   else     { top->argList = (*theField->patternType->genGetJNValueFunction)(theEnv,theField,RHS); }        top->argList->nextArg = conversion;   return(top);  }

/****************************************************  NAME         : GenObjectZeroLengthTest  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 GenObjectZeroLengthTest(  struct lhsParseNode *theNode)  {   struct ObjectMatchLength hack;   EXPRESSION *theTest;   ClearBitString((void *) &hack,(int) sizeof(struct ObjectMatchLength));   hack.exactly = 1;   hack.minLength = 0;   theTest = GenConstant(OBJ_SLOT_LENGTH,AddBitMap((void *) &hack,                                         (int) sizeof(struct ObjectMatchLength)));   theNode->networkTest = CombineExpressions(theTest,theNode->networkTest);  }

globle struct expr *ConvertValueToExpression(  DATA_OBJECT *theValue)  {   long i;   struct expr *head = NULL, *last = NULL, *newItem;   if (GetpType(theValue) != MULTIFIELD)     { return(GenConstant(GetpType(theValue),GetpValue(theValue))); }   for (i = GetpDOBegin(theValue); i <= GetpDOEnd(theValue); i++)     {      newItem = GenConstant(GetMFType(GetpValue(theValue),i),                        GetMFValue(GetpValue(theValue),i));      if (last == NULL) head = newItem;      else last->nextArg = newItem;      last = newItem;     }   if (head == NULL)     return(GenConstant(FCALL,(void *) FindFunction("create$")));   return(head);  }

globle struct expr *FactGenCheckLength(  struct lhsParseNode *theNode)  {   struct factCheckLengthPNCall hack;   /*===================================================*/   /* If the slot contains no single field constraints, */   /* then a length test is not necessary.              */   /*===================================================*/   if ((theNode->singleFieldsAfter == 0) &&       (theNode->type != SF_VARIABLE) &&       (theNode->type != SF_WILDCARD))     { return(NULL); }   /*=======================================*/   /* Initialize the length test arguments. */   /*=======================================*/   ClearBitString(&hack,sizeof(struct factCheckLengthPNCall));   hack.whichSlot = theNode->slotNumber - 1;   /*============================================*/   /* If the slot has no multifield constraints, */   /* then the length must match exactly.        */   /*============================================*/   if ((theNode->type != MF_VARIABLE) &&       (theNode->type != MF_WILDCARD) &&       (theNode->multiFieldsAfter == 0))     { hack.exactly = 1; }   else     { hack.exactly = 0; }   /*============================================*/   /* The minimum length is the number of single */   /* field constraints contained in the slot.   */   /*============================================*/   if ((theNode->type == SF_VARIABLE) || (theNode->type == SF_WILDCARD))     { hack.minLength = 1 + theNode->singleFieldsAfter; }   else     { hack.minLength = theNode->singleFieldsAfter; }   /*========================================================*/   /* Generate call to test the length of a multifield slot. */   /*========================================================*/   return(GenConstant(FACT_SLOT_LENGTH,AddBitMap(&hack,sizeof(struct factCheckLengthPNCall))));  }

globle struct constraintRecord *GetConstraintRecord(  void *theEnv,  EXEC_STATUS)  {   CONSTRAINT_RECORD *constraints;   unsigned i;   constraints = get_struct(theEnv,execStatus,constraintRecord);   for (i = 0 ; i < sizeof(CONSTRAINT_RECORD) ; i++)     { ((char *) constraints)[i] = '/0'; }   SetAnyAllowedFlags(constraints,TRUE);   constraints->multifieldsAllowed = FALSE;   constraints->singlefieldsAllowed = TRUE;   constraints->anyRestriction = FALSE;   constraints->symbolRestriction = FALSE;   constraints->stringRestriction = FALSE;   constraints->floatRestriction = FALSE;   constraints->integerRestriction = FALSE;   constraints->classRestriction = FALSE;   constraints->instanceNameRestriction = FALSE;   constraints->classList = NULL;   constraints->restrictionList = NULL;   constraints->minValue = GenConstant(theEnv,execStatus,SYMBOL,SymbolData(theEnv,execStatus)->NegativeInfinity);   constraints->maxValue = GenConstant(theEnv,execStatus,SYMBOL,SymbolData(theEnv,execStatus)->PositiveInfinity);   constraints->minFields = GenConstant(theEnv,execStatus,INTEGER,SymbolData(theEnv,execStatus)->Zero);   constraints->maxFields = GenConstant(theEnv,execStatus,SYMBOL,SymbolData(theEnv,execStatus)->PositiveInfinity);   constraints->bucket = -1;   constraints->count = 0;   constraints->multifield = NULL;   constraints->next = NULL;   return(constraints);  }

globle struct expr *CopyExpression(  struct expr *original)  {   struct expr *topLevel, *next, *last;   if (original == NULL) return(NULL);   topLevel = GenConstant(original->type,original->value);   topLevel->argList = CopyExpression(original->argList);   last = topLevel;   original = original->nextArg;   while (original != NULL)     {      next = GenConstant(original->type,original->value);      next->argList = CopyExpression(original->argList);      last->nextArg = next;      last = next;      original = original->nextArg;     }   return(topLevel);  }