factrete.c

NASA 开发使用的一个专家系统

   struct factCheckLengthPNCall *hack;
   struct multifield *segmentPtr;
   int extraOffset = 0; 
   struct multifieldMarker *tempMark;
     
   returnValue->type = SYMBOL;
   returnValue->value = CLIPSFalseSymbol;
   
   hack = (struct factCheckLengthPNCall *) ValueToBitMap(theValue);

   for (tempMark = CurrentPatternMarks;
        tempMark != NULL;
        tempMark = tempMark->next)
     { 
      if (tempMark->where.whichSlotNumber != hack->whichSlot) continue;
      extraOffset += ((tempMark->endPosition - tempMark->startPosition) + 1);
     }
      
   segmentPtr = (struct multifield *) CurrentPatternFact->theProposition.theFields[hack->whichSlot].value;

   if (segmentPtr->multifieldLength < (hack->minLength + extraOffset)) 
     { return(CLIPS_FALSE); }
   
   if (hack->exactly && (segmentPtr->multifieldLength > (hack->minLength + extraOffset)))
     { return(CLIPS_FALSE); }
     
   returnValue->value = CLIPSTrueSymbol;
   return(CLIPS_TRUE);
  }
  
/************************************************************/
/* FactJNCompVars1: Fact join network routine for comparing */
/*   the values of two single field slots.                  */
/************************************************************/
#if IBM_TBC
#pragma argsused
#endif
globle int FactJNCompVars1(theValue,theResult)
  VOID *theValue;
  DATA_OBJECT *theResult;
  {
#if MAC_MPW || MAC_MCW
#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 = GlobalJoin->depth - 1;
   p2 = ((int) hack->pattern2) - 1;
   
   fact1 = (struct fact *) GlobalRHSBinds->binds[0].gm.theMatch->matchingItem;
   if (p1 != p2)
     { fact2 = (struct fact *) GlobalLHSBinds->binds[p2].gm.theMatch->matchingItem; }
   else
     { fact2 = fact1; }

   /*=====================*/
   /* 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(theValue,theResult)
  VOID *theValue;
  DATA_OBJECT *theResult;
  {
#if MAC_MPW || MAC_MCW
#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 = GlobalJoin->depth - 1;
   p2 = ((int) hack->pattern2) - 1;
   s1 = (int) hack->slot1;
   s2 = (int) hack->slot2;
   
   fact1 = (struct fact *) GlobalRHSBinds->binds[0].gm.theMatch->matchingItem;
   if (p1 != p2)
     { fact2 = (struct fact *) GlobalLHSBinds->binds[p2].gm.theMatch->matchingItem; }
   else
     { fact2 = fact1; }

   /*======================*/
   /* 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(theValue,theResult)
  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 = &CurrentPatternFact->theProposition.theFields[hack->field1];
   fieldPtr2 = &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 = CLIPSTrueSymbol;
   else theResult->value = CLIPSFalseSymbol;
   
   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.                                                        */
/*************************************************************************/
globle int AdjustFieldPosition(markList,whichField,whichSlot,extent)
  struct multifieldMarker *markList;
  int whichField, whichSlot, *extent;
  {
   int actualIndex;

   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 += (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(theValue,theResult)
  VOID *theValue;
  DATA_OBJECT *theResult;
  {  
#if MAC_MPW || MAC_MCW
#pragma unused(theValue)
#endif
   StoreInMultifield(theResult,GetFirstArgument(),CLIPS_FALSE);
   return(CLIPS_TRUE);
  }
  
#endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */