/**********************************************
  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;
  }