src/clipsrules/core/sortfun.c

Go to the documentation of this file.

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*             CLIPS Version 6.24  07/01/05            */
   /*                                                     */
   /*                SORT FUNCTIONS MODULE                */
   /*******************************************************/

/*************************************************************/
/* Purpose: Contains the code for sorting functions.         */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Gary D. Riley                                        */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
/*                                                           */
/*      6.24: The sort function leaks memory when called     */
/*            with a multifield value of length zero.        */
/*            DR0864                                         */
/*                                                           */
/*************************************************************/

#define _SORTFUN_SOURCE_

#include "setup.h"

#include "argacces.h"
#include "dffnxfun.h"
#include "envrnmnt.h"
#include "evaluatn.h"
#include "extnfunc.h"
#include "memalloc.h"
#include "multifld.h"
#include "sysdep.h"

#include "sortfun.h"

#define SORTFUN_DATA 7

struct sortFunctionData
  { 
   struct expr *SortComparisonFunction;
  };

#define SortFunctionData(theEnv) ((struct sortFunctionData *) GetEnvironmentData(theEnv,SORTFUN_DATA))

/***************************************/
/* LOCAL INTERNAL FUNCTION DEFINITIONS */
/***************************************/

   static void                    DoMergeSort(void *,DATA_OBJECT *,DATA_OBJECT *,unsigned long,
                                              unsigned long,unsigned long,unsigned long,
                                              int (*)(void *,DATA_OBJECT *,DATA_OBJECT *));
   static int                     DefaultCompareSwapFunction(void *,DATA_OBJECT *,DATA_OBJECT *);
   static void                    DeallocateSortFunctionData(void *);
   
/****************************************/
/* SortFunctionDefinitions: Initializes */
/*   the sorting functions.             */
/****************************************/
globle void SortFunctionDefinitions(
  void *theEnv)
  {
   AllocateEnvironmentData(theEnv,SORTFUN_DATA,sizeof(struct sortFunctionData),DeallocateSortFunctionData);
#if ! RUN_TIME
   EnvDefineFunction2(theEnv,"sort",'u', PTIEF SortFunction,"SortFunction","1**w");
#endif
  }

/*******************************************************/
/* DeallocateSortFunctionData: Deallocates environment */
/*    data for the sort function.                      */
/*******************************************************/
static void DeallocateSortFunctionData(
  void *theEnv)
  {
   ReturnExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction);
  }

/**************************************/
/* DefaultCompareSwapFunction:  */
/**************************************/
static int DefaultCompareSwapFunction(
  void *theEnv,
  DATA_OBJECT *item1,
  DATA_OBJECT *item2)
  {
   DATA_OBJECT returnValue;

   SortFunctionData(theEnv)->SortComparisonFunction->argList = GenConstant(theEnv,item1->type,item1->value);
   SortFunctionData(theEnv)->SortComparisonFunction->argList->nextArg = GenConstant(theEnv,item2->type,item2->value);
   ExpressionInstall(theEnv,SortFunctionData(theEnv)->SortComparisonFunction);
   EvaluateExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction,&returnValue);
   ExpressionDeinstall(theEnv,SortFunctionData(theEnv)->SortComparisonFunction);
   ReturnExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction->argList);
   SortFunctionData(theEnv)->SortComparisonFunction->argList = NULL;

   if ((GetType(returnValue) == SYMBOL) &&
       (GetValue(returnValue) == EnvFalseSymbol(theEnv)))
     { return(FALSE); }

   return(TRUE);
  }

/**************************************/
/* SortFunction: H/L access routine   */
/*   for the rest$ function.          */
/**************************************/
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);
  }


/*******************************************/
/* MergeSort: Sorts a list of fields       */
/*   according to user specified criteria. */
/*******************************************/
void MergeSort(
  void *theEnv,
  unsigned long listSize,
  DATA_OBJECT *theList,
  int (*swapFunction)(void *,DATA_OBJECT *,DATA_OBJECT  *))
  {
   DATA_OBJECT *tempList;
   unsigned long middle;

   if (listSize <= 1) return;

   /*==============================*/
   /* Create the temporary storage */
   /* needed for the merge sort.   */
   /*==============================*/

   tempList = (DATA_OBJECT *) genalloc(theEnv,listSize * sizeof(DATA_OBJECT));

   /*=====================================*/
   /* Call the merge sort driver routine. */
   /*=====================================*/

   middle = (listSize + 1) / 2;
   DoMergeSort(theEnv,theList,tempList,0,middle-1,middle,listSize - 1,swapFunction);

   /*==================================*/
   /* Deallocate the temporary storage */
   /* needed by the merge sort.        */
   /*==================================*/

   genfree(theEnv,tempList,listSize * sizeof(DATA_OBJECT));
  }


/******************************************************/
/* DoMergeSort: Driver routine for performing a merge */
/*   sort on an array of DATA_OBJECT structures.      */
/******************************************************/
static void DoMergeSort(
  void *theEnv,
  DATA_OBJECT *theList,
  DATA_OBJECT *tempList,
  unsigned long s1,
  unsigned long e1,
  unsigned long s2,
  unsigned long e2,
  int (*swapFunction)(void *,DATA_OBJECT *,DATA_OBJECT *))
  {
   DATA_OBJECT temp;
   unsigned long middle, size;
   unsigned long c1, c2, mergePoint;

   /* Sort the two subareas before merging them. */

   if (s1 == e1)
     { /* List doesn't need to be merged. */ }
   else if ((s1 + 1) == e1)
     {
      if ((*swapFunction)(theEnv,&theList[s1],&theList[e1]))
        {
         TransferDataObjectValues(&temp,&theList[s1]);
         TransferDataObjectValues(&theList[s1],&theList[e1]);
         TransferDataObjectValues(&theList[e1],&temp);
        }
     }
   else
     {
      size = ((e1 - s1) + 1);
      middle = s1 + ((size + 1) / 2);
      DoMergeSort(theEnv,theList,tempList,s1,middle-1,middle,e1,swapFunction);
     }

   if (s2 == e2)
     { /* List doesn't need to be merged. */ }
   else if ((s2 + 1) == e2)
     {
      if ((*swapFunction)(theEnv,&theList[s2],&theList[e2]))
        {
         TransferDataObjectValues(&temp,&theList[s2]);
         TransferDataObjectValues(&theList[s2],&theList[e2]);
         TransferDataObjectValues(&theList[e2],&temp);
        }
     }
   else
     {
      size = ((e2 - s2) + 1);
      middle = s2 + ((size + 1) / 2);
      DoMergeSort(theEnv,theList,tempList,s2,middle-1,middle,e2,swapFunction);
     }

   /*======================*/
   /* Merge the two areas. */
   /*======================*/

   mergePoint = s1;
   c1 = s1;
   c2 = s2;

   while (mergePoint <= e2)
     {
      if (c1 > e1)
        {
         TransferDataObjectValues(&tempList[mergePoint],&theList[c2]);
         c2++;
         mergePoint++;
        }
      else if (c2 > e2)
        {
         TransferDataObjectValues(&tempList[mergePoint],&theList[c1]);
         c1++;
         mergePoint++;
        }
      else if ((*swapFunction)(theEnv,&theList[c1],&theList[c2]))
        {
         TransferDataObjectValues(&tempList[mergePoint],&theList[c2]);
         c2++;
         mergePoint++;
        }
      else
        {
         TransferDataObjectValues(&tempList[mergePoint],&theList[c1]);
         c1++;
         mergePoint++;
        }
     }

   /*=======================================*/
   /* Copy them back to the original array. */
   /*=======================================*/

   for (c1 = s1; c1 <= e2; c1++)
     { TransferDataObjectValues(&theList[c1],&tempList[c1]); }
  }

---