示例#1
0
  void get_argument(void* env, int argposition, Values& values) {
    DATA_OBJECT arg;
    if (EnvArgTypeCheck(env, (char *)"clipsmm get_argument",
                        argposition, MULTIFIELD, &arg) == 0)   return;

    values.clear();

    int end = EnvGetDOEnd(env, arg);
    void *mfp = EnvGetValue(env, arg);
    for (int i = EnvGetDOBegin(env, arg); i <= end; ++i) {
      switch (GetMFType(mfp, i)) {
      case SYMBOL:
      case STRING:
      case INSTANCE_NAME:
        values.push_back(Value(ValueToString(GetMFValue(mfp, i))));
        break;
      case FLOAT:
        values.push_back(Value(ValueToDouble(GetMFValue(mfp, i))));
        break;
      case INTEGER:
        values.push_back(Value(ValueToInteger(GetMFValue(mfp, i))));
        break;
      default:
        continue;
        break;
      }
    }
  }
示例#2
0
  std::vector<std::string> data_object_to_strings( dataObject& clipsdo ) {
    void* mfptr;
    long int end, i;
    std::string s;
    std::vector<std::string> strings;

    switch ( GetType(clipsdo) ) {
      case SYMBOL:
      case INSTANCE_NAME:
      case STRING:
        strings.push_back( DOToString( clipsdo ) );
        break;
      case MULTIFIELD:
        end = GetDOEnd( clipsdo );
        mfptr = GetValue( clipsdo );
        for ( i = GetDOBegin( clipsdo ); i <= end; i++ ) {
          switch ( GetMFType( mfptr, i ) ) {
            case SYMBOL:
            case STRING:
            case INSTANCE_NAME:
              strings.push_back( ValueToString( GetMFValue( mfptr, i ) ) );
              break;
            default:
              break;
          }
        }
      default:
        break;
    }

    return strings;
  }
示例#3
0
/***************************************************
  NAME         : EnvGetNextInstanceInClassAndSubclasses
  DESCRIPTION  : Finds next instance of class
                 (or first instance of class) and
                 all of its subclasses
  INPUTS       : 1) Class address (DIRECT POINTER!)
                 2) Instance address
                    (NULL to get first instance)
  RETURNS      : The next or first class instance
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle void *EnvGetNextInstanceInClassAndSubclasses_PY(
  void *theEnv,
  void *cptr,   /* this has changed */
  void *iptr,
  DATA_OBJECT *iterationInfo)
  {
   INSTANCE_TYPE *nextInstance;
   DEFCLASS *theClass;

   theClass = (DEFCLASS *)cptr;

   if (iptr == NULL)
     {
      ClassSubclassAddresses(theEnv,theClass,iterationInfo,TRUE);
      nextInstance = theClass->instanceList;
     }
   else if (((INSTANCE_TYPE *) iptr)->garbage == 1)
     { nextInstance = NULL; }
   else
     { nextInstance = ((INSTANCE_TYPE *) iptr)->nxtClass; }

   while ((nextInstance == NULL) &&
          (GetpDOBegin(iterationInfo) <= GetpDOEnd(iterationInfo)))
     {
      theClass = (struct defclass *) GetMFValue(DOPToPointer(iterationInfo),
                                                GetpDOBegin(iterationInfo));
      SetpDOBegin(iterationInfo,GetpDOBegin(iterationInfo) + 1);
      nextInstance = theClass->instanceList;
     }

   return(nextInstance);
  }
示例#4
0
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);
  }
示例#5
0
/*************************************************************
  NAME         : FormChain
  DESCRIPTION  : Builds a list of classes to be used in
                   fact queries - uses parse form.
  INPUTS       : 1) Name of calling function for error msgs
                 2) Data object - must be a symbol or a
                      multifield value containing all symbols
                 The symbols must be names of existing templates
  RETURNS      : The query chain, or NULL on errors
  SIDE EFFECTS : Memory allocated for chain
                 Busy count incremented for all templates
  NOTES        : None
 *************************************************************/
static QUERY_TEMPLATE *FormChain(
  void *theEnv,
  char *func,
  DATA_OBJECT *val)
  {
   struct deftemplate *templatePtr;
   QUERY_TEMPLATE *head,*bot,*tmp;
   register long i,end; /* 6.04 Bug Fix */
   char *templateName;
   int count;

   if (val->type == DEFTEMPLATE_PTR)
     {
      IncrementDeftemplateBusyCount(theEnv,(void *) val->value);
      head = get_struct(theEnv,query_template);
      head->templatePtr = (struct deftemplate *) val->value;

      head->chain = NULL;
      head->nxt = NULL;
      return(head);
     }
   if (val->type == SYMBOL)
     {
      /* ===============================================
         Allow instance-set query restrictions to have a
         module specifier as part of the class name,
         but search imported defclasses too if a
         module specifier is not given
         =============================================== */
         
      templatePtr = (struct deftemplate *)
                       FindImportedConstruct(theEnv,"deftemplate",NULL,DOPToString(val),
                                             &count,TRUE,NULL);
      if (templatePtr == NULL)
        {
         CantFindItemInFunctionErrorMessage(theEnv,"deftemplate",DOPToString(val),func);
         return(NULL);
        }
      IncrementDeftemplateBusyCount(theEnv,(void *) templatePtr);
      head = get_struct(theEnv,query_template);
      head->templatePtr = templatePtr;

      head->chain = NULL;
      head->nxt = NULL;
      return(head);
     }
   if (val->type == MULTIFIELD)
     {
      head = bot = NULL;
      end = GetpDOEnd(val);
      for (i = GetpDOBegin(val) ; i <= end ; i++)
        {
         if (GetMFType(val->value,i) == SYMBOL)
           {
            templateName = ValueToString(GetMFValue(val->value,i));
            
            templatePtr = (struct deftemplate *)
                       FindImportedConstruct(theEnv,"deftemplate",NULL,templateName,
                                             &count,TRUE,NULL);

            if (templatePtr == NULL)
              {
               CantFindItemInFunctionErrorMessage(theEnv,"deftemplate",templateName,func);
               DeleteQueryTemplates(theEnv,head);
               return(NULL);
              }
           }
         else
           {
            DeleteQueryTemplates(theEnv,head);
            return(NULL);
           }
         IncrementDeftemplateBusyCount(theEnv,(void *) templatePtr);
         tmp = get_struct(theEnv,query_template);
         tmp->templatePtr = templatePtr;

         tmp->chain = NULL;
         tmp->nxt = NULL;
         if (head == NULL)
           head = tmp;
         else
           bot->chain = tmp;
         bot = tmp;
        }
      return(head);
     }
   return(NULL);
  }
示例#6
0
/***************************************************
  NAME         : GetObjectValueGeneral
  DESCRIPTION  : Access function for getting
                 pattern variable values within the
                 object pattern and join networks
  INPUTS       : 1) The result data object buffer
                 2) The instance to access
                 3) The list of multifield markers
                    for the pattern
                 4) Data for variable reference
  RETURNS      : Nothing useful
  SIDE EFFECTS : Data object is filled with the
                 values of the pattern variable
  NOTES        : None
 ***************************************************/
static void GetObjectValueGeneral(
    void *theEnv,
    DATA_OBJECT *result,
    INSTANCE_TYPE *theInstance,
    struct multifieldMarker *theMarks,
    struct ObjectMatchVar1 *matchVar)
{
    long field, extent; /* 6.04 Bug Fix */
    INSTANCE_SLOT **insSlot,*basisSlot;

    if (matchVar->objectAddress)
    {
        result->type = INSTANCE_ADDRESS;
        result->value = (void *) theInstance;
        return;
    }
    if (matchVar->whichSlot == ISA_ID)
    {
        result->type = SYMBOL;
        result->value = (void *) GetDefclassNamePointer((void *) theInstance->cls);
        return;
    }
    if (matchVar->whichSlot == NAME_ID)
    {
        result->type = INSTANCE_NAME;
        result->value = (void *) theInstance->name;
        return;
    }
    insSlot =
        &theInstance->slotAddresses
        [theInstance->cls->slotNameMap[matchVar->whichSlot] - 1];

    /* =========================================
       We need to reference the basis slots if
       the slot of this object has changed while
       the RHS was executing

       However, if the reference is being done
       by the LHS of a rule (as a consequence of
       an RHS action), give the pattern matcher
       the real value of the slot
       ========================================= */
    if ((theInstance->basisSlots != NULL) &&
            (! EngineData(theEnv)->JoinOperationInProgress))
    {
        basisSlot = theInstance->basisSlots + (insSlot - theInstance->slotAddresses);
        if (basisSlot->value != NULL)
            insSlot = &basisSlot;
    }

    /* ==================================================
       If we know we are accessing the entire slot,
       the don't bother with searching multifield markers
       or calculating offsets
       ================================================== */
    if (matchVar->allFields)
    {
        result->type = (unsigned short) (*insSlot)->type;
        result->value = (*insSlot)->value;
        if (result->type == MULTIFIELD)
        {
            result->begin = 0;
            SetpDOEnd(result,GetMFLength((*insSlot)->value));
        }
        return;
    }

    /* =============================================
       Access a general field in a slot pattern with
       two or more multifield variables
       ============================================= */
    field = CalculateSlotField(theMarks,*insSlot,matchVar->whichField,&extent);
    if (extent == -1)
    {
        if ((*insSlot)->desc->multiple)
        {
            result->type = GetMFType((*insSlot)->value,field);
            result->value = GetMFValue((*insSlot)->value,field);
        }
        else
        {
            result->type = (unsigned short) (*insSlot)->type;
            result->value = (*insSlot)->value;
        }
    }
    else
    {
        result->type = MULTIFIELD;
        result->value = (*insSlot)->value;
        result->begin = field - 1;
        result->end = field + extent - 2;
    }
}
示例#7
0
globle void *ImplodeMultifield(
  void *theEnv,
  DATA_OBJECT *value)
  {
   size_t strsize = 0;
   long i, j;
   const char *tmp_str;
   char *ret_str;
   void *rv;
   struct multifield *theMultifield;
   DATA_OBJECT tempDO;

   /*===================================================*/
   /* Determine the size of the string to be allocated. */
   /*===================================================*/

   theMultifield = (struct multifield *) GetpValue(value);
   for (i = GetpDOBegin(value) ; i <= GetpDOEnd(value) ; i++)
     {
      if (GetMFType(theMultifield,i) == FLOAT)
        {
         tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i)));
         strsize += strlen(tmp_str) + 1;
        }
      else if (GetMFType(theMultifield,i) == INTEGER)
        {
         tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i)));
         strsize += strlen(tmp_str) + 1;
        }
      else if (GetMFType(theMultifield,i) == STRING)
        {
         strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3;
         tmp_str = ValueToString(GetMFValue(theMultifield,i));
         while(*tmp_str)
           {
            if (*tmp_str == '"')
              { strsize++; }
            else if (*tmp_str == '\\') /* GDR 111599 #835 */
              { strsize++; }           /* GDR 111599 #835 */
            tmp_str++;
           }
        }
#if OBJECT_SYSTEM
      else if (GetMFType(theMultifield,i) == INSTANCE_NAME)
        { strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3; }
      else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS)
        { strsize += strlen(ValueToString(((INSTANCE_TYPE *)
                            GetMFValue(theMultifield,i))->name)) + 3; }
#endif

      else
        { 
         SetType(tempDO,GetMFType(theMultifield,i));
         SetValue(tempDO,GetMFValue(theMultifield,i));
         strsize += strlen(DataObjectToString(theEnv,&tempDO)) + 1; 
        }
     }

   /*=============================================*/
   /* Allocate the string and copy all components */
   /* of the MULTIFIELD variable to it.           */
   /*=============================================*/

   if (strsize == 0) return(EnvAddSymbol(theEnv,""));
   ret_str = (char *) gm2(theEnv,strsize);
   for(j=0, i=GetpDOBegin(value); i <= GetpDOEnd(value) ; i++)
     {
      /*============================*/
      /* Convert numbers to strings */
      /*============================*/

      if (GetMFType(theMultifield,i) == FLOAT)
        {
         tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i)));
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
        }
      else if (GetMFType(theMultifield,i) == INTEGER)
        {
         tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i)));
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
        }

      /*=======================================*/
      /* Enclose strings in quotes and preceed */
      /* imbedded quotes with a backslash      */
      /*=======================================*/

      else if (GetMFType(theMultifield,i) == STRING)
        {
         tmp_str = ValueToString(GetMFValue(theMultifield,i));
         *(ret_str+j) = '"';
         j++;
         while(*tmp_str)
           {
            if (*tmp_str == '"')
              {
               *(ret_str+j) = '\\';
               j++;
              }
            else if (*tmp_str == '\\') /* GDR 111599 #835 */
              {                        /* GDR 111599 #835 */
               *(ret_str+j) = '\\';    /* GDR 111599 #835 */
               j++;                    /* GDR 111599 #835 */
              }                        /* GDR 111599 #835 */
              
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
         *(ret_str+j) = '"';
         j++;
        }
#if OBJECT_SYSTEM
      else if (GetMFType(theMultifield,i) == INSTANCE_NAME)
        {
         tmp_str = ValueToString(GetMFValue(theMultifield,i));
         *(ret_str + j++) = '[';
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
         *(ret_str + j++) = ']';
        }
      else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS)
        {
         tmp_str = ValueToString(((INSTANCE_TYPE *) GetMFValue(theMultifield,i))->name);
         *(ret_str + j++) = '[';
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
         *(ret_str + j++) = ']';
        }
#endif
      else
        {
         SetType(tempDO,GetMFType(theMultifield,i));
         SetValue(tempDO,GetMFValue(theMultifield,i));
         tmp_str = DataObjectToString(theEnv,&tempDO);
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
         }
      *(ret_str+j) = ' ';
      j++;
     }
   *(ret_str+j-1) = '\0';

   /*====================*/
   /* Return the string. */
   /*====================*/

   rv = EnvAddSymbol(theEnv,ret_str);
   rm(theEnv,ret_str,strsize);
   return(rv);
  }
示例#8
0
globle void SortFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   long argumentCount, i, j, k = 0;
   DATA_OBJECT *theArguments, *theArguments2;
   DATA_OBJECT theArg;
   struct multifield *theMultifield, *tempMultifield;
   char *functionName;
   struct expr *functionReference;
   int argumentSize = 0;
   struct FunctionDefinition *fptr;
#if DEFFUNCTION_CONSTRUCT
   DEFFUNCTION *dptr;
#endif

   /*==================================*/
   /* Set up the default return value. */
   /*==================================*/

   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,EnvFalseSymbol(theEnv));

   /*=============================================*/
   /* The function expects at least one argument. */
   /*=============================================*/

   if ((argumentCount = EnvArgCountCheck(theEnv,"sort",AT_LEAST,1)) == -1)
     { return; }

   /*=============================================*/
   /* Verify that the comparison function exists. */
   /*=============================================*/

   if (EnvArgTypeCheck(theEnv,"sort",1,SYMBOL,&theArg) == FALSE)
     { return; }

   functionName = DOToString(theArg);
   functionReference = FunctionReferenceExpression(theEnv,functionName);
   if (functionReference == NULL)
     {
      ExpectedTypeError1(theEnv,"sort",1,"function name, deffunction name, or defgeneric name");
      return;
     }

   /*======================================*/
   /* For an external function, verify the */
   /* correct number of arguments.         */
   /*======================================*/
   
   if (functionReference->type == FCALL)
     {
      fptr = (struct FunctionDefinition *) functionReference->value;
      if ((GetMinimumArgs(fptr) > 2) ||
          (GetMaximumArgs(fptr) == 0) ||
          (GetMaximumArgs(fptr) == 1))
        {
         ExpectedTypeError1(theEnv,"sort",1,"function name expecting two arguments");
         ReturnExpression(theEnv,functionReference);
         return;
        }
     }
     
   /*=======================================*/
   /* For a deffunction, verify the correct */
   /* number of arguments.                  */
   /*=======================================*/
  
#if DEFFUNCTION_CONSTRUCT
   if (functionReference->type == PCALL)
     {
      dptr = (DEFFUNCTION *) functionReference->value;
      if ((dptr->minNumberOfParameters > 2) ||
          (dptr->maxNumberOfParameters == 0) ||
          (dptr->maxNumberOfParameters == 1))
        {
         ExpectedTypeError1(theEnv,"sort",1,"deffunction name expecting two arguments");
         ReturnExpression(theEnv,functionReference);
         return;
        }
     }
#endif

   /*=====================================*/
   /* If there are no items to be sorted, */
   /* then return an empty multifield.    */
   /*=====================================*/

   if (argumentCount == 1)
     {
      EnvSetMultifieldErrorValue(theEnv,returnValue);
      ReturnExpression(theEnv,functionReference);
      return;
     }
     
   /*=====================================*/
   /* Retrieve the arguments to be sorted */
   /* and determine how many there are.   */
   /*=====================================*/

   theArguments = (DATA_OBJECT *) genalloc(theEnv,(argumentCount - 1) * sizeof(DATA_OBJECT));

   for (i = 2; i <= argumentCount; i++)
     {
      EnvRtnUnknown(theEnv,i,&theArguments[i-2]);
      if (GetType(theArguments[i-2]) == MULTIFIELD)
        { argumentSize += GetpDOLength(&theArguments[i-2]); }
      else
        { argumentSize++; }
     }
     
   if (argumentSize == 0)
     {   
      genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT)); /* Bug Fix */
      EnvSetMultifieldErrorValue(theEnv,returnValue);
      ReturnExpression(theEnv,functionReference);
      return;
     }
   
   /*====================================*/
   /* Pack all of the items to be sorted */
   /* into a data object array.          */
   /*====================================*/
   
   theArguments2 = (DATA_OBJECT *) genalloc(theEnv,argumentSize * sizeof(DATA_OBJECT));

   for (i = 2; i <= argumentCount; i++)
     {
      if (GetType(theArguments[i-2]) == MULTIFIELD)
        {
         tempMultifield = (struct multifield *) GetValue(theArguments[i-2]);
         for (j = GetDOBegin(theArguments[i-2]); j <= GetDOEnd(theArguments[i-2]); j++, k++)
           {
            SetType(theArguments2[k],GetMFType(tempMultifield,j));
            SetValue(theArguments2[k],GetMFValue(tempMultifield,j));
           }
        }
      else
        {
         SetType(theArguments2[k],GetType(theArguments[i-2]));
         SetValue(theArguments2[k],GetValue(theArguments[i-2]));
         k++;
        }
     }
     
   genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT));

   functionReference->nextArg = SortFunctionData(theEnv)->SortComparisonFunction;
   SortFunctionData(theEnv)->SortComparisonFunction = functionReference;

   for (i = 0; i < argumentSize; i++)
     { ValueInstall(theEnv,&theArguments2[i]); }

   MergeSort(theEnv,(unsigned long) argumentSize,theArguments2,DefaultCompareSwapFunction);
  
   for (i = 0; i < argumentSize; i++)
     { ValueDeinstall(theEnv,&theArguments2[i]); }

   SortFunctionData(theEnv)->SortComparisonFunction = SortFunctionData(theEnv)->SortComparisonFunction->nextArg;
   functionReference->nextArg = NULL;
   ReturnExpression(theEnv,functionReference);

   theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,(unsigned long) argumentSize);

   for (i = 0; i < argumentSize; i++)
     {
      SetMFType(theMultifield,i+1,GetType(theArguments2[i]));
      SetMFValue(theMultifield,i+1,GetValue(theArguments2[i]));
     }
     
   genfree(theEnv,theArguments2,argumentSize * sizeof(DATA_OBJECT));

   SetpType(returnValue,MULTIFIELD);
   SetpDOBegin(returnValue,1);
   SetpDOEnd(returnValue,argumentSize);
   SetpValue(returnValue,(void *) theMultifield);
  }
示例#9
0
globle void StoreInMultifield(
  void *theEnv,
  DATA_OBJECT *returnValue,
  EXPRESSION *expptr,
  int garbageSegment)
  {
   DATA_OBJECT val_ptr;
   DATA_OBJECT *val_arr;
   struct multifield *theMultifield;
   struct multifield *orig_ptr;
   long start, end, i,j, k, argCount;
   unsigned long seg_size;

   argCount = CountArguments(expptr);

   /*=========================================*/
   /* If no arguments are given return a NULL */
   /* multifield of length zero.              */
   /*=========================================*/

   if (argCount == 0)
     {
      SetpType(returnValue,MULTIFIELD);
      SetpDOBegin(returnValue,1);
      SetpDOEnd(returnValue,0);
      if (garbageSegment) theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L);
      else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L);
      SetpValue(returnValue,(void *) theMultifield);
      return;
     }
   else
     {
      /*========================================*/
      /* Get a new segment with length equal to */
      /* the total length of all the arguments. */
      /*========================================*/

      val_arr = (DATA_OBJECT *) gm3(theEnv,(long) sizeof(DATA_OBJECT) * argCount);
      seg_size = 0;
      
      for (i = 1; i <= argCount; i++, expptr = expptr->nextArg)
        {
         EvaluateExpression(theEnv,expptr,&val_ptr);
         if (EvaluationData(theEnv)->EvaluationError)
           {
            SetpType(returnValue,MULTIFIELD);
            SetpDOBegin(returnValue,1);
            SetpDOEnd(returnValue,0);
            if (garbageSegment)
              { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); }
            else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L);
            SetpValue(returnValue,(void *) theMultifield);
            rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount);
            return;
           }
         SetpType(val_arr+i-1,GetType(val_ptr));
         if (GetType(val_ptr) == MULTIFIELD)
           {
            SetpValue(val_arr+i-1,GetpValue(&val_ptr));
            start = GetDOBegin(val_ptr);
            end = GetDOEnd(val_ptr);
           }
         else if (GetType(val_ptr) == RVOID)
           {
            SetpValue(val_arr+i-1,GetValue(val_ptr));
            start = 1;
            end = 0;
           }
         else
           {
            SetpValue(val_arr+i-1,GetValue(val_ptr));
            start = end = -1;
           }

         seg_size += (unsigned long) (end - start + 1);
         SetpDOBegin(val_arr+i-1,start);
         SetpDOEnd(val_arr+i-1,end);
        }

      if (garbageSegment)
        { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,seg_size); }
      else theMultifield = (struct multifield *) CreateMultifield2(theEnv,seg_size);

      /*========================================*/
      /* Copy each argument into new segment.  */
      /*========================================*/

      for (k = 0, j = 1; k < argCount; k++)
        {
         if (GetpType(val_arr+k) == MULTIFIELD)
           {
            start = GetpDOBegin(val_arr+k);
            end = GetpDOEnd(val_arr+k);
            orig_ptr = (struct multifield *) GetpValue(val_arr+k);
            for (i = start; i < end + 1; i++, j++)
              {
               SetMFType(theMultifield,j,(GetMFType(orig_ptr,i)));
               SetMFValue(theMultifield,j,(GetMFValue(orig_ptr,i)));
              }
           }
         else if (GetpType(val_arr+k) != RVOID)
           {
            SetMFType(theMultifield,j,(short) (GetpType(val_arr+k)));
            SetMFValue(theMultifield,j,(GetpValue(val_arr+k)));
            j++;
           }
        }

      /*=========================*/
      /* Return the new segment. */
      /*=========================*/

      SetpType(returnValue,MULTIFIELD);
      SetpDOBegin(returnValue,1);
      SetpDOEnd(returnValue,(long) seg_size);
      SetpValue(returnValue,(void *) theMultifield);
      rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount);
      return;
     }
  }
示例#10
0
/***********************************************************************
  NAME         : ExpandFuncMultifield
  DESCRIPTION  : Recursively examines an expression and replaces
                   PROC_EXPAND_MULTIFIELD expressions with the expanded
                   evaluation expression of its argument
  INPUTS       : 1) A data object result buffer
                 2) The expression to modify
                 3) The address of the expression, in case it is
                    deleted entirely
                 4) The address of the H/L function expand$
  RETURNS      : Nothing useful
  SIDE EFFECTS : Expressions allocated/deallocated as necessary
                 Evaluations performed
                 On errors, argument expression set to call a function
                   which causes an evaluation error when evaluated
                   a second time by actual caller.
  NOTES        : THIS ROUTINE MODIFIES EXPRESSIONS AT RUNTIME!!  MAKE
                 SURE THAT THE EXPRESSION PASSED IS SAFE TO CHANGE!!
 **********************************************************************/
static void ExpandFuncMultifield(
    void *theEnv,
    DATA_OBJECT *result,
    EXPRESSION *theExp,
    EXPRESSION **sto,
    void *expmult)
{
    EXPRESSION *newexp,*top,*bot;
    register long i; /* 6.04 Bug Fix */

    while (theExp != NULL)
    {
        if (theExp->value == expmult)
        {
            EvaluateExpression(theEnv,theExp->argList,result);
            ReturnExpression(theEnv,theExp->argList);
            if ((EvaluationData(theEnv)->EvaluationError) || (result->type != MULTIFIELD))
            {
                theExp->argList = NULL;
                if ((EvaluationData(theEnv)->EvaluationError == FALSE) && (result->type != MULTIFIELD))
                    ExpectedTypeError2(theEnv,"expand$",1);
                theExp->value = (void *) FindFunction(theEnv,"(set-evaluation-error)");
                EvaluationData(theEnv)->EvaluationError = FALSE;
                EvaluationData(theEnv)->HaltExecution = FALSE;
                return;
            }
            top = bot = NULL;
            for (i = GetpDOBegin(result) ; i <= GetpDOEnd(result) ; i++)
            {
                newexp = get_struct(theEnv,expr);
                newexp->type = GetMFType(result->value,i);
                newexp->value = GetMFValue(result->value,i);
                newexp->argList = NULL;
                newexp->nextArg = NULL;
                if (top == NULL)
                    top = newexp;
                else
                    bot->nextArg = newexp;
                bot = newexp;
            }
            if (top == NULL)
            {
                *sto = theExp->nextArg;
                rtn_struct(theEnv,expr,theExp);
                theExp = *sto;
            }
            else
            {
                bot->nextArg = theExp->nextArg;
                *sto = top;
                rtn_struct(theEnv,expr,theExp);
                sto = &bot->nextArg;
                theExp = bot->nextArg;
            }
        }
        else
        {
            if (theExp->argList != NULL)
                ExpandFuncMultifield(theEnv,result,theExp->argList,&theExp->argList,expmult);
            sto = &theExp->nextArg;
            theExp = theExp->nextArg;
        }
    }
}
示例#11
0
globle void FuncallFunction(
    void *theEnv,
    DATA_OBJECT *returnValue)
{
    int argCount, i, j;
    DATA_OBJECT theValue;
    FUNCTION_REFERENCE theReference;
    char *name;
    struct multifield *theMultifield;
    struct expr *lastAdd = NULL, *nextAdd, *multiAdd;

    /*==================================*/
    /* Set up the default return value. */
    /*==================================*/

    SetpType(returnValue,SYMBOL);
    SetpValue(returnValue,EnvFalseSymbol(theEnv));

    /*=================================================*/
    /* The funcall function has at least one argument: */
    /* the name of the function being called.          */
    /*=================================================*/

    if ((argCount = EnvArgCountCheck(theEnv,"funcall",AT_LEAST,1)) == -1) return;

    /*============================================*/
    /* Get the name of the function to be called. */
    /*============================================*/

    if (EnvArgTypeCheck(theEnv,"funcall",1,SYMBOL_OR_STRING,&theValue) == FALSE)
    {
        return;
    }

    /*====================*/
    /* Find the function. */
    /*====================*/

    name = DOToString(theValue);
    if (! GetFunctionReference(theEnv,name,&theReference))
    {
        ExpectedTypeError1(theEnv,"funcall",1,"function, deffunction, or generic function name");
        return;
    }

    ExpressionInstall(theEnv,&theReference);

    /*======================================*/
    /* Add the arguments to the expression. */
    /*======================================*/

    for (i = 2; i <= argCount; i++)
    {
        EnvRtnUnknown(theEnv,i,&theValue);
        if (GetEvaluationError(theEnv))
        {
            ExpressionDeinstall(theEnv,&theReference);
            return;
        }

        switch(GetType(theValue))
        {
        case MULTIFIELD:
            nextAdd = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$"));

            if (lastAdd == NULL)
            {
                theReference.argList = nextAdd;
            }
            else
            {
                lastAdd->nextArg = nextAdd;
            }
            lastAdd = nextAdd;

            multiAdd = NULL;
            theMultifield = (struct multifield *) GetValue(theValue);
            for (j = GetDOBegin(theValue); j <= GetDOEnd(theValue); j++)
            {
                nextAdd = GenConstant(theEnv,GetMFType(theMultifield,j),GetMFValue(theMultifield,j));
                if (multiAdd == NULL)
                {
                    lastAdd->argList = nextAdd;
                }
                else
                {
                    multiAdd->nextArg = nextAdd;
                }
                multiAdd = nextAdd;
            }

            ExpressionInstall(theEnv,lastAdd);
            break;

        default:
            nextAdd = GenConstant(theEnv,GetType(theValue),GetValue(theValue));
            if (lastAdd == NULL)
            {
                theReference.argList = nextAdd;
            }
            else
            {
                lastAdd->nextArg = nextAdd;
            }
            lastAdd = nextAdd;
            ExpressionInstall(theEnv,lastAdd);
            break;
        }
    }

    /*===========================================================*/
    /* Verify a deffunction has the correct number of arguments. */
    /*===========================================================*/

#if DEFFUNCTION_CONSTRUCT
    if (theReference.type == PCALL)
    {
        if (CheckDeffunctionCall(theEnv,theReference.value,CountArguments(theReference.argList)) == FALSE)
        {
            PrintErrorID(theEnv,"MISCFUN",4,FALSE);
            EnvPrintRouter(theEnv,WERROR,"Function funcall called with the wrong number of arguments for deffunction ");
            EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,theReference.value));
            EnvPrintRouter(theEnv,WERROR,"\n");
            ExpressionDeinstall(theEnv,&theReference);
            ReturnExpression(theEnv,theReference.argList);
            return;
        }
    }
#endif

    /*======================*/
    /* Call the expression. */
    /*======================*/

    EvaluateExpression(theEnv,&theReference,returnValue);

    /*========================================*/
    /* Return the expression data structures. */
    /*========================================*/

    ExpressionDeinstall(theEnv,&theReference);
    ReturnExpression(theEnv,theReference.argList);
}
示例#12
0
文件: insquery.c 项目: atrniv/CLIPS
/*************************************************************
  NAME         : FormChain
  DESCRIPTION  : Builds a list of classes to be used in
                   instance queries - uses parse form.
  INPUTS       : 1) Name of calling function for error msgs
                 2) Data object - must be a symbol or a
                      multifield value containing all symbols
                 The symbols must be names of existing classes
  RETURNS      : The query chain, or NULL on errors
  SIDE EFFECTS : Memory allocated for chain
                 Busy count incremented for all classes
  NOTES        : None
 *************************************************************/
static QUERY_CLASS *FormChain(
  void *theEnv,
  EXEC_STATUS,
  char *func,
  DATA_OBJECT *val)
  {
   DEFCLASS *cls;
   QUERY_CLASS *head,*bot,*tmp;
   register long i,end; /* 6.04 Bug Fix */
   char *className;
   struct defmodule *currentModule;

   currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv,execStatus));
   if (val->type == DEFCLASS_PTR)
     {
      IncrementDefclassBusyCount(theEnv,execStatus,(void *) val->value);
      head = get_struct(theEnv,execStatus,query_class);
      head->cls = (DEFCLASS *) val->value;
      if (DefclassInScope(theEnv,execStatus,head->cls,currentModule))
        head->theModule = currentModule;
      else
        head->theModule = head->cls->header.whichModule->theModule;
      head->chain = NULL;
      head->nxt = NULL;
      return(head);
     }
   if (val->type == SYMBOL)
     {
      /* ===============================================
         Allow instance-set query restrictions to have a
         module specifier as part of the class name,
         but search imported defclasses too if a
         module specifier is not given
         =============================================== */
      cls = LookupDefclassByMdlOrScope(theEnv,execStatus,DOPToString(val));
      if (cls == NULL)
        {
         ClassExistError(theEnv,execStatus,func,DOPToString(val));
         return(NULL);
        }
      IncrementDefclassBusyCount(theEnv,execStatus,(void *) cls);
      head = get_struct(theEnv,execStatus,query_class);
      head->cls = cls;
      if (DefclassInScope(theEnv,execStatus,head->cls,currentModule))
        head->theModule = currentModule;
      else
        head->theModule = head->cls->header.whichModule->theModule;
      head->chain = NULL;
      head->nxt = NULL;
      return(head);
     }
   if (val->type == MULTIFIELD)
     {
      head = bot = NULL;
      end = GetpDOEnd(val);
      for (i = GetpDOBegin(val) ; i <= end ; i++)
        {
         if (GetMFType(val->value,i) == SYMBOL)
           {
            className = ValueToString(GetMFValue(val->value,i));
            cls = LookupDefclassByMdlOrScope(theEnv,execStatus,className);
            if (cls == NULL)
              {
               ClassExistError(theEnv,execStatus,func,className);
               DeleteQueryClasses(theEnv,execStatus,head);
               return(NULL);
              }
           }
         else
           {
            DeleteQueryClasses(theEnv,execStatus,head);
            return(NULL);
           }
         IncrementDefclassBusyCount(theEnv,execStatus,(void *) cls);
         tmp = get_struct(theEnv,execStatus,query_class);
         tmp->cls = cls;
         if (DefclassInScope(theEnv,execStatus,tmp->cls,currentModule))
           tmp->theModule = currentModule;
         else
           tmp->theModule = tmp->cls->header.whichModule->theModule;
         tmp->chain = NULL;
         tmp->nxt = NULL;
         if (head == NULL)
           head = tmp;
         else
           bot->chain = tmp;
         bot = tmp;
        }
      return(head);
     }
   return(NULL);
  }
示例#13
0
void ClipsRuleMgr::getTemplateFields()
{
		void *templatePtr;
		DATA_OBJECT theValue;
		void *theMultifield;
		
		DATA_OBJECT theValueOfType;
		void *theMultifieldOfType;
		int cnt1 = 0;
		int i = 1;
		int fieldType;
		void *fieldValue;
		m_templateItor = m_templateNames.begin();
		while(m_templateItor!=m_templateNames.end())
		{	
			cout<<"Rule Engine IntializeStream::m_templateNames:" <<*m_templateItor<<endl;
			templatePtr = EnvFindDeftemplate(m_theEnv,(*m_templateItor).c_str());
			EnvDeftemplateSlotNames(m_theEnv, templatePtr, &theValue);
			
			if (GetpType(&theValue) == MULTIFIELD)
			{
				cnt1 = GetpDOLength(&theValue);
				//theMultifield = theValue.value;
				theMultifield=GetValue(theValue);
				vector<Field> fields;
				for (i=1; i<=cnt1; i++)
				{
					
					fieldType = GetMFType(theMultifield,i);
					if (fieldType == SYMBOL)
					{
						Field tmp;
						fieldValue = (void*)ValueToString(GetMFValue(theMultifield,i));
						tmp.name = string((char*)fieldValue);
						tmp.type = 2;
						EnvDeftemplateSlotTypes(m_theEnv,templatePtr,(char *)fieldValue, &theValueOfType);
						if (GetpType(&theValueOfType) == MULTIFIELD)
						{
							GetpDOLength(&theValueOfType);
							theMultifieldOfType = theValueOfType.value;
							
							
							///default contraict to first one
							fieldType = GetMFType(theMultifieldOfType,1);	
						
							if (fieldType == SYMBOL)
							{
									fieldValue = GetMFValue(theMultifieldOfType,1);
									if (string(ValueToString(fieldValue)) == string("FLOAT"))
									{
										tmp.type = 0;
									}
									else if (string(ValueToString(fieldValue)) == string("INTEGER"))
									{
										tmp.type = 1;
									}
									else
									{
										tmp.type = 2;
									}
							}
							else
							{
									cout<<"Rule Engine IntializeStream::EnvDeftemplateSlotTypes get unknown field type when get slot type:" <<fieldType<<endl;
							}
						}
						
						fields.push_back(tmp);
					}
					else
					{
						cout<<"Rule Engine IntializeStream::get unknown field type when get slot name:" <<fieldType<<endl;
					}
				}
				tableSchema.insert(pair<string, vector<Field> >(*m_templateItor, fields));	
			}
			else
			{
					cout<<"Rule Engine IntializeStream:::EnvDeftemplateSlotNames return not multifiled" <<endl;
			}
		
			m_templateItor++;
		}
		
		
		//call streaming interface to set tableSchema here
		
}
示例#14
0
  Values data_object_to_values( dataObject& clipsdo ) {
    Values values;

    std::string s;
    double d;
    long int i;
    void* p;

    void* mfptr;
    long int end;

    switch ( GetType( clipsdo ) ) {
      case RVOID:
        return values;
      case STRING:
        s = DOToString( clipsdo );
        values.push_back( Value( s, TYPE_STRING ) );
        return values;
      case INSTANCE_NAME:
        s = DOToString( clipsdo );
        values.push_back( Value( s, TYPE_INSTANCE_NAME ) );
        return values;
      case SYMBOL:
        s = DOToString( clipsdo );
        values.push_back( Value( s, TYPE_SYMBOL ) );
        return values;
      case FLOAT:
        d = DOToDouble( clipsdo );
        values.push_back( Value( d ) );
        return values;
      case INTEGER:
        i = DOToLong( clipsdo );
        values.push_back( Value( i ) );
        return values;
      case INSTANCE_ADDRESS:
        p = DOToPointer( clipsdo );
        values.push_back( Value( p, TYPE_INSTANCE_ADDRESS ) );
        return values;
      case EXTERNAL_ADDRESS:
        p = (((struct externalAddressHashNode *) (clipsdo.value))->externalAddress);
        values.push_back( Value( p, TYPE_EXTERNAL_ADDRESS ) );
        return values;
      case MULTIFIELD:
        end = GetDOEnd( clipsdo );
        mfptr = GetValue( clipsdo );
        for ( int iter = GetDOBegin( clipsdo ); iter <= end; iter++ ) {
          switch ( GetMFType( mfptr, iter ) ) {
            case STRING:
              s = ValueToString( GetMFValue( mfptr, iter ) );
              values.push_back( Value( s, TYPE_STRING ) );
              break;
            case SYMBOL:
              s = ValueToString( GetMFValue( mfptr, iter ) );
              values.push_back( Value( s, TYPE_SYMBOL ) );
              break;
            case FLOAT:
              d = ValueToDouble( GetMFValue( mfptr, iter ) );
              values.push_back( Value( d ) );
              break;
            case INTEGER:
              i = ValueToLong( GetMFValue( mfptr, iter ) );
              values.push_back( Value( i ) );
              break;
	  case EXTERNAL_ADDRESS:
	    p = ValueToExternalAddress( GetMFValue( mfptr, iter ) );
	    values.push_back( Value( p, TYPE_EXTERNAL_ADDRESS ) );
	    break;
            default:
              throw std::logic_error( "clipsmm::data_object_to_values: Unhandled multifield type" );
          }
        }
        return values;
      default:
        //std::cout << std::endl << "Type: " << GetType(clipsdo) << std::endl;
        throw std::logic_error( "clipsmm::data_object_to_values: Unhandled data object type" );
    }
  }