/*******************************************************/ /* "C" Language Integrated Production System */ /* */ /* CLIPS Version 6.40 08/25/16 */ /* */ /* 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 */ /* */ /* 6.30: Added environment cleanup call function */ /* DeallocateSortFunctionData. */ /* */ /* 6.40: Pragma once and other inclusion changes. */ /* */ /* Added support for booleans with . */ /* */ /* Removed use of void pointers for specific */ /* data structures. */ /* */ /* UDF redesign. */ /* */ /*************************************************************/ #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(Environment *,UDFValue *,UDFValue *,size_t, size_t,size_t,size_t, bool (*)(Environment *,UDFValue *,UDFValue *)); static bool DefaultCompareSwapFunction(Environment *,UDFValue *,UDFValue *); static void DeallocateSortFunctionData(Environment *); /****************************************/ /* SortFunctionDefinitions: Initializes */ /* the sorting functions. */ /****************************************/ void SortFunctionDefinitions( Environment *theEnv) { AllocateEnvironmentData(theEnv,SORTFUN_DATA,sizeof(struct sortFunctionData),DeallocateSortFunctionData); #if ! RUN_TIME AddUDF(theEnv,"sort","bm",1,UNBOUNDED,"*;y",SortFunction,"SortFunction",NULL); #endif } /*******************************************************/ /* DeallocateSortFunctionData: Deallocates environment */ /* data for the sort function. */ /*******************************************************/ static void DeallocateSortFunctionData( Environment *theEnv) { ReturnExpression(theEnv,SortFunctionData(theEnv)->SortComparisonFunction); } /********************************/ /* DefaultCompareSwapFunction: */ /********************************/ static bool DefaultCompareSwapFunction( Environment *theEnv, UDFValue *item1, UDFValue *item2) { UDFValue returnValue; SortFunctionData(theEnv)->SortComparisonFunction->argList = GenConstant(theEnv,item1->header->type,item1->value); SortFunctionData(theEnv)->SortComparisonFunction->argList->nextArg = GenConstant(theEnv,item2->header->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 (returnValue.value == FalseSymbol(theEnv)) { return false; } return true; } /************************************/ /* SortFunction: H/L access routine */ /* for the rest$ function. */ /************************************/ void SortFunction( Environment *theEnv, UDFContext *context, UDFValue *returnValue) { unsigned argumentCount, i; unsigned long k = 0; size_t j; UDFValue *theArguments, *theArguments2; UDFValue theArg; Multifield *theMultifield, *tempMultifield; const char *functionName; struct expr *functionReference; size_t argumentSize = 0; struct functionDefinition *fptr; #if DEFFUNCTION_CONSTRUCT Deffunction *dptr; #endif /*==================================*/ /* Set up the default return value. */ /*==================================*/ returnValue->lexemeValue = FalseSymbol(theEnv); /*=============================================*/ /* Verify that the comparison function exists. */ /*=============================================*/ if (! UDFNthArgument(context,1,SYMBOL_BIT,&theArg)) { return; } functionName = theArg.lexemeValue->contents; 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 = functionReference->functionValue; 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. */ /*=====================================*/ argumentCount = UDFArgumentCount(context); if (argumentCount == 1) { SetMultifieldErrorValue(theEnv,returnValue); ReturnExpression(theEnv,functionReference); return; } /*=====================================*/ /* Retrieve the arguments to be sorted */ /* and determine how many there are. */ /*=====================================*/ theArguments = (UDFValue *) genalloc(theEnv,(argumentCount - 1) * sizeof(UDFValue)); for (i = 2; i <= argumentCount; i++) { UDFNthArgument(context,i,ANY_TYPE_BITS,&theArguments[i-2]); if (theArguments[i-2].header->type == MULTIFIELD_TYPE) { argumentSize += theArguments[i-2].range; } else { argumentSize++; } } if (argumentSize == 0) { genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(UDFValue)); /* Bug Fix */ SetMultifieldErrorValue(theEnv,returnValue); ReturnExpression(theEnv,functionReference); return; } /*====================================*/ /* Pack all of the items to be sorted */ /* into a data object array. */ /*====================================*/ theArguments2 = (UDFValue *) genalloc(theEnv,argumentSize * sizeof(UDFValue)); for (i = 2; i <= argumentCount; i++) { if (theArguments[i-2].header->type == MULTIFIELD_TYPE) { tempMultifield = theArguments[i-2].multifieldValue; for (j = theArguments[i-2].begin; j < (theArguments[i-2].begin + theArguments[i-2].range); j++, k++) { theArguments2[k].value = tempMultifield->contents[j].value; } } else { theArguments2[k].value = theArguments[i-2].value; k++; } } genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(UDFValue)); functionReference->nextArg = SortFunctionData(theEnv)->SortComparisonFunction; SortFunctionData(theEnv)->SortComparisonFunction = functionReference; for (i = 0; i < argumentSize; i++) { RetainUDFV(theEnv,&theArguments2[i]); } MergeSort(theEnv,argumentSize,theArguments2,DefaultCompareSwapFunction); for (i = 0; i < argumentSize; i++) { ReleaseUDFV(theEnv,&theArguments2[i]); } SortFunctionData(theEnv)->SortComparisonFunction = SortFunctionData(theEnv)->SortComparisonFunction->nextArg; functionReference->nextArg = NULL; ReturnExpression(theEnv,functionReference); theMultifield = CreateMultifield(theEnv,argumentSize); for (i = 0; i < argumentSize; i++) { theMultifield->contents[i].value = theArguments2[i].value; } genfree(theEnv,theArguments2,argumentSize * sizeof(UDFValue)); returnValue->begin = 0; returnValue->range = argumentSize; returnValue->value = theMultifield; } /*******************************************/ /* MergeSort: Sorts a list of fields */ /* according to user specified criteria. */ /*******************************************/ void MergeSort( Environment *theEnv, size_t listSize, UDFValue *theList, bool (*swapFunction)(Environment *,UDFValue *,UDFValue *)) { UDFValue *tempList; size_t middle; if (listSize <= 1) return; /*==============================*/ /* Create the temporary storage */ /* needed for the merge sort. */ /*==============================*/ tempList = (UDFValue *) genalloc(theEnv,listSize * sizeof(UDFValue)); /*=====================================*/ /* 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(UDFValue)); } /******************************************************/ /* DoMergeSort: Driver routine for performing a merge */ /* sort on an array of UDFValue structures. */ /******************************************************/ static void DoMergeSort( Environment *theEnv, UDFValue *theList, UDFValue *tempList, size_t s1, size_t e1, size_t s2, size_t e2, bool (*swapFunction)(Environment *,UDFValue *,UDFValue *)) { UDFValue temp; size_t middle, size; size_t 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]); } }