factrete.c

clips源代码

   struct multifield *segmentPtr;
   long extraOffset = 0;
   struct multifieldMarker *tempMark;

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

   hack = (struct factCheckLengthPNCall *) ValueToBitMap(theValue);

   for (tempMark = FactData(theEnv)->CurrentPatternMarks;
        tempMark != NULL;
        tempMark = tempMark->next)
     {
      if (tempMark->where.whichSlotNumber != hack->whichSlot) continue;
      extraOffset += ((tempMark->endPosition - tempMark->startPosition) + 1);
     }

   segmentPtr = (struct multifield *) FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->whichSlot].value;

   if (segmentPtr->multifieldLength < (hack->minLength + extraOffset))
     { return(FALSE); }

   if (hack->exactly && (segmentPtr->multifieldLength > (hack->minLength + extraOffset)))
     { return(FALSE); }

   returnValue->value = EnvTrueSymbol(theEnv);
   return(TRUE);
  }

/************************************************************/
/* FactJNCompVars1: Fact join network routine for comparing */
/*   the values of two single field slots.                  */
/************************************************************/
#if IBM_TBC
#pragma argsused
#endif
globle int FactJNCompVars1(
  void *theEnv,
  void *theValue,
  DATA_OBJECT *theResult)
  {
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theResult)
#endif
   int p1, e1, p2, e2;
   struct fact *fact1, *fact2;
   struct factCompVarsJN1Call *hack;

   /*=========================================*/
   /* Retrieve the arguments to the function. */
   /*=========================================*/

   hack = (struct factCompVarsJN1Call *) ValueToBitMap(theValue);

   /*=================================================*/
   /* Extract the fact pointers for the two patterns. */
   /*=================================================*/

   p1 = (int) hack->pattern1;
   p2 = (int) hack->pattern2;

   fact1 = (struct fact *) EngineData(theEnv)->GlobalRHSBinds->binds[p1].gm.theMatch->matchingItem;

   if (hack->p2rhs)
     { fact2 = (struct fact *) EngineData(theEnv)->GlobalRHSBinds->binds[p2].gm.theMatch->matchingItem; }
   else 
     { fact2 = (struct fact *) EngineData(theEnv)->GlobalLHSBinds->binds[p2].gm.theMatch->matchingItem; }

   /*=====================*/
   /* Compare the values. */
   /*=====================*/

   e1 = (int) hack->slot1;
   e2 = (int) hack->slot2;

   if (fact1->theProposition.theFields[e1].type !=
       fact2->theProposition.theFields[e2].type)
     { return((int) hack->fail); }

   if (fact1->theProposition.theFields[e1].value !=
       fact2->theProposition.theFields[e2].value)
     { return((int) hack->fail); }

   return((int) hack->pass);
  }

/*****************************************************************/
/* FactJNCompVars2:  Fact join network routine for comparing the */
/*   two single field value that are found in the first slot     */
/*   (which must also be a multifield slot) of a deftemplate.    */
/*   This function is provided so that variable comparisons of   */
/*   implied deftemplates will be faster.                        */
/*****************************************************************/
#if IBM_TBC
#pragma argsused
#endif
globle int FactJNCompVars2(
  void *theEnv,
  void *theValue,
  DATA_OBJECT *theResult)
  {
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theResult)
#endif
   int p1, s1, p2, s2;
   struct fact *fact1, *fact2;
   struct factCompVarsJN2Call *hack;
   struct multifield *segment;
   struct field *fieldPtr1, *fieldPtr2;

   /*=========================================*/
   /* Retrieve the arguments to the function. */
   /*=========================================*/

   hack = (struct factCompVarsJN2Call *) ValueToBitMap(theValue);

   /*=================================================*/
   /* Extract the fact pointers for the two patterns. */
   /*=================================================*/

   p1 = (int) hack->pattern1;
   p2 = (int) hack->pattern2;
   s1 = (int) hack->slot1;
   s2 = (int) hack->slot2;

   fact1 = (struct fact *) EngineData(theEnv)->GlobalRHSBinds->binds[p1].gm.theMatch->matchingItem;
     
   if (hack->p2rhs)
     { fact2 = (struct fact *) EngineData(theEnv)->GlobalRHSBinds->binds[p2].gm.theMatch->matchingItem; }
   else 
     { fact2 = (struct fact *) EngineData(theEnv)->GlobalLHSBinds->binds[p2].gm.theMatch->matchingItem; }

   /*======================*/
   /* Retrieve the values. */
   /*======================*/

   if (fact1->theProposition.theFields[s1].type != MULTIFIELD)
     { fieldPtr1 = &fact1->theProposition.theFields[s1]; }
   else
     {
      segment = (struct multifield *) fact1->theProposition.theFields[s1].value;

      if (hack->fromBeginning1)
        { fieldPtr1 = &segment->theFields[hack->offset1]; }
      else
        { fieldPtr1 = &segment->theFields[segment->multifieldLength - (hack->offset1 + 1)]; }
     }

   if (fact2->theProposition.theFields[s2].type != MULTIFIELD)
     { fieldPtr2 = &fact2->theProposition.theFields[s2]; }
   else
     {
      segment = (struct multifield *) fact2->theProposition.theFields[s2].value;

      if (hack->fromBeginning2)
        { fieldPtr2 = &segment->theFields[hack->offset2]; }
      else
        { fieldPtr2 = &segment->theFields[segment->multifieldLength - (hack->offset2 + 1)]; }
     }

   /*=====================*/
   /* Compare the values. */
   /*=====================*/

   if (fieldPtr1->type != fieldPtr2->type)
     { return((int) hack->fail); }

   if (fieldPtr1->value != fieldPtr2->value)
     { return((int) hack->fail); }

   return((int) hack->pass);
  }

/*****************************************************/
/* FactPNCompVars1: Fact pattern network routine for */
/*   comparing the values of two single field slots. */
/*****************************************************/
globle int FactPNCompVars1(
  void *theEnv,
  void *theValue,
  DATA_OBJECT *theResult)
  {
   int rv;
   struct field *fieldPtr1, *fieldPtr2;
   struct factCompVarsPN1Call *hack;

   /*========================================*/
   /* Extract the arguments to the function. */
   /*========================================*/

   hack = (struct factCompVarsPN1Call *) ValueToBitMap(theValue);
   fieldPtr1 = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->field1];
   fieldPtr2 = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->field2];

   /*=====================*/
   /* Compare the values. */
   /*=====================*/

   if (fieldPtr1->type != fieldPtr2->type) rv = (int) hack->fail;
   else if (fieldPtr1->value != fieldPtr2->value) rv = (int) hack->fail;
   else rv = (int) hack->pass;

   theResult->type = SYMBOL;
   if (rv) theResult->value = EnvTrueSymbol(theEnv);
   else theResult->value = EnvFalseSymbol(theEnv);

   return(rv);
  }

/*************************************************************************/
/* AdjustFieldPosition: Given a list of multifield markers and the index */
/*   to a variable in a slot, this function computes the index to the    */
/*   field in the slot where the variable begins. In the case of         */
/*   multifield variables, it also computes the extent (or length) of    */
/*   the multifield. Note that the extent should be given a default      */
/*   value of either -1 or 1 for variables other than multifield         */
/*   variables before calling this routine.  An extent of -1 for these   */
/*   variables will distinguish their extent as being different when it  */
/*   is necessary to note their difference from a multifield variable    */
/*   with an extent of 1. For example, given the slot pattern            */
/*   (data $?x c $?y ?z) and the slot value (data a b c d e f x), the    */
/*   actual index in the fact for the 5th item in the pattern (the       */
/*   variable ?z) would be 8 since $?x binds to 2 fields and $?y binds   */
/*   to 3 fields.                                                        */
/*************************************************************************/
#if IBM_TBC
#pragma argsused
#endif
globle unsigned short AdjustFieldPosition(
  void *theEnv,
  struct multifieldMarker *markList,
  unsigned short whichField,
  unsigned short whichSlot,
  int *extent)
  {
   unsigned short actualIndex;
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#endif

   actualIndex = whichField;
   for (;
        markList != NULL;
        markList = markList->next)
     {
      /*===============================================*/
      /* Skip over multifield markers for other slots. */
      /*===============================================*/

      if (markList->where.whichSlotNumber != whichSlot) continue;

      /*=========================================================*/
      /* If the multifield marker occurs exactly at the field in */
      /* question, then the actual index needs to be adjusted    */
      /* and the extent needs to be computed since the value is  */
      /* a multifield value.                                     */
      /*=========================================================*/

      if (markList->whichField == whichField)
        {
         *extent = (markList->endPosition - markList->startPosition) + 1;
         return(actualIndex);
        }

      /*=====================================================*/
      /* Otherwise if the multifield marker occurs after the */
      /* field in question, then the actual index has been   */
      /* completely computed and can be returned.            */
      /*=====================================================*/

      else if (markList->whichField > whichField)
        { return(actualIndex); }

      /*==========================================================*/
      /* Adjust the actual index to the field based on the number */
      /* of fields taken up by the preceding multifield variable. */
      /*==========================================================*/

      actualIndex += (unsigned short) (markList->endPosition - markList->startPosition);
     }

   /*=======================================*/
   /* Return the actual index to the field. */
   /*=======================================*/

   return(actualIndex);
  }

/*****************************************************/
/* FactStoreMultifield: This primitive is used by a  */
/*   number of multifield functions for grouping a   */
/*   series of valuesinto a single multifield value. */
/*****************************************************/
#if IBM_TBC
#pragma argsused
#endif
globle int FactStoreMultifield(
  void *theEnv,
  void *theValue,
  DATA_OBJECT *theResult)
  {
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theValue)
#endif

   StoreInMultifield(theEnv,theResult,GetFirstArgument(),FALSE);
   return(TRUE);
  }

#endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */