clipsruby 0.0.2

data/ext/clipsruby/sortfun.c

@@ -0,0 +1,433 @@
+   /*******************************************************/
+   /*      "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 <stdbool.h>.   */
+/*                                                           */
+/*            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]); }
+  }
+
+
+

data/ext/clipsruby/sortfun.h

@@ -0,0 +1,55 @@
+   /*******************************************************/
+   /*      "C" Language Integrated Production System      */
+   /*                                                     */
+   /*             CLIPS Version 6.40  08/25/16            */
+   /*                                                     */
+   /*            SORT FUNCTIONS HEADER 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: Removed LOCALE definition.                     */
+/*                                                           */
+/*            Pragma once and other inclusion changes.       */
+/*                                                           */
+/*            Added support for booleans with <stdbool.h>.   */
+/*                                                           */
+/*            Removed use of void pointers for specific      */
+/*            data structures.                               */
+/*                                                           */
+/*            UDF redesign.                                  */
+/*                                                           */
+/*************************************************************/
+
+#ifndef _H_sortfun
+
+#pragma once
+
+#define _H_sortfun
+
+   void                           SortFunctionDefinitions(Environment *);
+   void                           MergeSort(Environment *,size_t,UDFValue *,
+                                            bool (*)(Environment *,UDFValue *,UDFValue *));
+   void                           SortFunction(Environment *,UDFContext *,UDFValue *);
+
+#endif /* _H_sortfun */
+
+
+