clipsruby 0.0.2

data/ext/clipsruby/cstrnops.c

@@ -0,0 +1,1176 @@
+   /*******************************************************/
+   /*      "C" Language Integrated Production System      */
+   /*                                                     */
+   /*            CLIPS Version 6.40  10/18/16             */
+   /*                                                     */
+   /*            CONSTRAINT OPERATIONS MODULE             */
+   /*******************************************************/
+
+/*************************************************************/
+/* Purpose: Provides functions for performing operations on  */
+/*   constraint records including computing the intersection */
+/*   and union of constraint records.                        */
+/*                                                           */
+/* Principal Programmer(s):                                  */
+/*      Gary D. Riley                                        */
+/*                                                           */
+/* Contributing Programmer(s):                               */
+/*                                                           */
+/* Revision History:                                         */
+/*                                                           */
+/*      6.24: Added allowed-classes slot facet.              */
+/*                                                           */
+/*      6.40: Pragma once and other inclusion changes.       */
+/*                                                           */
+/*            Added support for booleans with <stdbool.h>.   */
+/*                                                           */
+/*            Removed use of void pointers for specific      */
+/*            data structures.                               */
+/*                                                           */
+/*            Eval support for run time and bload only.      */
+/*                                                           */
+/*************************************************************/
+
+#include "setup.h"
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "constant.h"
+#include "constrnt.h"
+#include "cstrnchk.h"
+#include "cstrnutl.h"
+#include "envrnmnt.h"
+#include "extnfunc.h"
+#include "memalloc.h"
+#include "multifld.h"
+#include "router.h"
+#include "scanner.h"
+
+#include "cstrnops.h"
+
+/***************************************/
+/* LOCAL INTERNAL FUNCTION DEFINITIONS */
+/***************************************/
+
+   static void                     IntersectNumericExpressions(Environment *,
+                                                               CONSTRAINT_RECORD *,
+                                                               CONSTRAINT_RECORD *,
+                                                               CONSTRAINT_RECORD *,bool);
+   static void                     IntersectAllowedValueExpressions(Environment *,
+                                                                    CONSTRAINT_RECORD *,
+                                                                    CONSTRAINT_RECORD *,
+                                                                    CONSTRAINT_RECORD *);
+   static void                     IntersectAllowedClassExpressions(Environment *,
+                                                                    CONSTRAINT_RECORD *,
+                                                                    CONSTRAINT_RECORD *,
+                                                                    CONSTRAINT_RECORD *);
+   static bool                     FindItemInExpression(int,void *,bool,struct expr *);
+   static void                     UpdateRestrictionFlags(CONSTRAINT_RECORD *);
+   static void                     UnionRangeMinMaxValueWithList(Environment *,
+                                                                 struct expr *,
+                                                                 struct expr *,
+                                                                 struct expr **,
+                                                                 struct expr **);
+   static void                     UnionNumericExpressions(Environment *,
+                                                         CONSTRAINT_RECORD *,
+                                                         CONSTRAINT_RECORD *,
+                                                         CONSTRAINT_RECORD *,bool);
+   static struct expr             *AddToUnionList(Environment *,
+                                                  struct expr *,struct expr *,
+                                                  CONSTRAINT_RECORD *);
+   static void                     UnionAllowedValueExpressions(Environment *,
+                                                                CONSTRAINT_RECORD *,
+                                                                CONSTRAINT_RECORD *,
+                                                                CONSTRAINT_RECORD *);
+   static void                     UnionAllowedClassExpressions(Environment *,
+                                                                CONSTRAINT_RECORD *,
+                                                                CONSTRAINT_RECORD *,
+                                                                CONSTRAINT_RECORD *);
+   static bool                     RestrictionOnType(int,CONSTRAINT_RECORD *);
+
+/**************************************************************/
+/* IntersectConstraints: Creates a new constraint record that */
+/*   is the intersection of two other constraint records.     */
+/**************************************************************/
+struct constraintRecord *IntersectConstraints(
+  Environment *theEnv,
+  CONSTRAINT_RECORD *c1,
+  CONSTRAINT_RECORD *c2)
+  {
+   struct constraintRecord *rv;
+   bool c1Changed = false, c2Changed = false;
+
+   /*=================================================*/
+   /* If both constraint records are NULL,then create */
+   /* a constraint record that allows any value.      */
+   /*=================================================*/
+
+   if ((c1 == NULL) && (c2 == NULL))
+     {
+      rv = GetConstraintRecord(theEnv);
+      rv->multifieldsAllowed = true;
+      return(rv);
+     }
+
+   /*=================================================*/
+   /* If one of the constraint records is NULL, then  */
+   /* the intersection is the other constraint record */
+   /* (a NULL value means no constraints).            */
+   /*=================================================*/
+
+   if (c1 == NULL) return(CopyConstraintRecord(theEnv,c2));
+
+   if (c2 == NULL) return(CopyConstraintRecord(theEnv,c1));
+
+   /*=================================*/
+   /* Create a new constraint record. */
+   /*=================================*/
+
+   rv = GetConstraintRecord(theEnv);
+
+   /*==============================*/
+   /* Intersect the allowed types. */
+   /*==============================*/
+
+   if ((c1->multifieldsAllowed != c2->multifieldsAllowed) &&
+       (c1->singlefieldsAllowed != c2->singlefieldsAllowed))
+     {
+      rv->anyAllowed = false;
+      return(rv);
+     }
+
+   if (c1->multifieldsAllowed && c2->multifieldsAllowed)
+     { rv->multifieldsAllowed = true; }
+   else
+     { rv->multifieldsAllowed = false; }
+
+   if (c1->singlefieldsAllowed && c2->singlefieldsAllowed)
+     { rv->singlefieldsAllowed = true; }
+   else
+     { rv->singlefieldsAllowed = false; }
+
+   if (c1->anyAllowed && c2->anyAllowed) rv->anyAllowed = true;
+   else
+     {
+      if (c1->anyAllowed)
+        {
+         c1Changed = true;
+         SetAnyAllowedFlags(c1,false);
+        }
+      else if (c2->anyAllowed)
+        {
+         c2Changed = true;
+         SetAnyAllowedFlags(c2,false);
+        }
+
+      rv->anyAllowed = false;
+      rv->symbolsAllowed = (c1->symbolsAllowed && c2->symbolsAllowed);
+      rv->stringsAllowed = (c1->stringsAllowed && c2->stringsAllowed);
+      rv->floatsAllowed = (c1->floatsAllowed && c2->floatsAllowed);
+      rv->integersAllowed = (c1->integersAllowed && c2->integersAllowed);
+      rv->instanceNamesAllowed = (c1->instanceNamesAllowed && c2->instanceNamesAllowed);
+      rv->instanceAddressesAllowed = (c1->instanceAddressesAllowed && c2->instanceAddressesAllowed);
+      rv->externalAddressesAllowed = (c1->externalAddressesAllowed && c2->externalAddressesAllowed);
+      rv->voidAllowed = (c1->voidAllowed && c2->voidAllowed);
+      rv->multifieldsAllowed = (c1->multifieldsAllowed && c2->multifieldsAllowed);
+      rv->factAddressesAllowed = (c1->factAddressesAllowed && c2->factAddressesAllowed);
+
+      if (c1Changed) SetAnyAllowedFlags(c1,true);
+      if (c2Changed) SetAnyAllowedFlags(c2,true);
+     }
+
+   /*=====================================*/
+   /* Intersect the allowed-values flags. */
+   /*=====================================*/
+
+   if (c1->anyRestriction || c2->anyRestriction) rv->anyRestriction = true;
+   else
+     {
+      rv->anyRestriction = false;
+      rv->symbolRestriction = (c1->symbolRestriction || c2->symbolRestriction);
+      rv->stringRestriction = (c1->stringRestriction || c2->stringRestriction);
+      rv->floatRestriction = (c1->floatRestriction || c2->floatRestriction);
+      rv->integerRestriction = (c1->integerRestriction || c2->integerRestriction);
+      rv->classRestriction = (c1->classRestriction || c2->classRestriction);
+      rv->instanceNameRestriction = (c1->instanceNameRestriction || c2->instanceNameRestriction);
+     }
+
+   /*==================================================*/
+   /* Intersect the allowed values list, allowed class */
+   /* list, min and max values, and the range values.  */
+   /*==================================================*/
+
+   IntersectAllowedValueExpressions(theEnv,c1,c2,rv);
+   IntersectAllowedClassExpressions(theEnv,c1,c2,rv);
+   IntersectNumericExpressions(theEnv,c1,c2,rv,true);
+   IntersectNumericExpressions(theEnv,c1,c2,rv,false);
+
+   /*==========================================*/
+   /* Update the allowed-values flags based on */
+   /* the previous intersection for allowed,   */
+   /* min and max, and range values.           */
+   /*==========================================*/
+
+   UpdateRestrictionFlags(rv);
+
+   /*============================================*/
+   /* If multifields are allowed, then intersect */
+   /* the constraint record for them.            */
+   /*============================================*/
+
+   if (rv->multifieldsAllowed)
+     {
+      rv->multifield = IntersectConstraints(theEnv,c1->multifield,c2->multifield);
+      if (UnmatchableConstraint(rv->multifield))
+        { rv->multifieldsAllowed = false; }
+     }
+
+   /*========================*/
+   /* Return the intersected */
+   /* constraint record.     */
+   /*========================*/
+
+   return(rv);
+  }
+
+/*************************************************/
+/* IntersectAllowedValueExpressions: Creates the */
+/*   intersection of two allowed-values lists.   */
+/*************************************************/
+static void IntersectAllowedValueExpressions(
+  Environment *theEnv,
+  CONSTRAINT_RECORD *constraint1,
+  CONSTRAINT_RECORD *constraint2,
+  CONSTRAINT_RECORD *newConstraint)
+  {
+   struct expr *theList1, *theList2;
+   struct expr *theHead = NULL, *tmpExpr;
+
+   /*===========================================*/
+   /* Loop through each value in allowed-values */
+   /* list of the first constraint record. Add  */
+   /* each value to a list if it satisfies the  */
+   /* restrictions for both constraint records. */
+   /*===========================================*/
+
+   for (theList1 = constraint1->restrictionList;
+        theList1 != NULL;
+        theList1 = theList1->nextArg)
+     {
+      if (CheckAllowedValuesConstraint(theList1->type,theList1->value,constraint1) &&
+          CheckAllowedValuesConstraint(theList1->type,theList1->value,constraint2))
+        {
+         tmpExpr = GenConstant(theEnv,theList1->type,theList1->value);
+         tmpExpr->nextArg = theHead;
+         theHead = tmpExpr;
+        }
+     }
+
+   /*===========================================*/
+   /* Loop through each value in allowed-values */
+   /* list of the second constraint record. Add */
+   /* each value to a list if it satisfies the  */
+   /* restrictions for both constraint records. */
+   /*===========================================*/
+
+   for (theList2 = constraint2->restrictionList;
+        theList2 != NULL;
+        theList2 = theList2->nextArg)
+     {
+      if (FindItemInExpression(theList2->type,theList2->value,true,theHead))
+        { /* The value is already in the list--Do nothing */ }
+      else if (CheckAllowedValuesConstraint(theList2->type,theList2->value,constraint1) &&
+               CheckAllowedValuesConstraint(theList2->type,theList2->value,constraint2))
+        {
+         tmpExpr = GenConstant(theEnv,theList2->type,theList2->value);
+         tmpExpr->nextArg = theHead;
+         theHead = tmpExpr;
+        }
+     }
+
+   /*================================================*/
+   /* Set the allowed values list for the constraint */
+   /* record to the intersected values of the two    */
+   /* other constraint records.                      */
+   /*================================================*/
+
+   newConstraint->restrictionList = theHead;
+  }
+
+/*************************************************/
+/* IntersectAllowedClassExpressions: Creates the */
+/*   intersection of two allowed-classes lists.  */
+/*************************************************/
+static void IntersectAllowedClassExpressions(
+  Environment *theEnv,
+  CONSTRAINT_RECORD *constraint1,
+  CONSTRAINT_RECORD *constraint2,
+  CONSTRAINT_RECORD *newConstraint)
+  {
+   struct expr *theList1, *theList2;
+   struct expr *theHead = NULL, *tmpExpr;
+
+   /*============================================*/
+   /* Loop through each value in allowed-classes */
+   /* list of the first constraint record. Add   */
+   /* each value to a list if it satisfies the   */
+   /* restrictions for both constraint records.  */
+   /*============================================*/
+
+   for (theList1 = constraint1->classList;
+        theList1 != NULL;
+        theList1 = theList1->nextArg)
+     {
+      if (CheckAllowedClassesConstraint(theEnv,theList1->type,theList1->value,constraint1) &&
+          CheckAllowedClassesConstraint(theEnv,theList1->type,theList1->value,constraint2))
+        {
+         tmpExpr = GenConstant(theEnv,theList1->type,theList1->value);
+         tmpExpr->nextArg = theHead;
+         theHead = tmpExpr;
+        }
+     }
+
+   /*============================================*/
+   /* Loop through each value in allowed-classes */
+   /* list of the second constraint record. Add  */
+   /* each value to a list if it satisfies the   */
+   /* restrictions for both constraint records.  */
+   /*============================================*/
+
+   for (theList2 = constraint2->classList;
+        theList2 != NULL;
+        theList2 = theList2->nextArg)
+     {
+      if (FindItemInExpression(theList2->type,theList2->value,true,theHead))
+        { /* The value is already in the list--Do nothing */ }
+      else if (CheckAllowedClassesConstraint(theEnv,theList2->type,theList2->value,constraint1) &&
+               CheckAllowedClassesConstraint(theEnv,theList2->type,theList2->value,constraint2))
+        {
+         tmpExpr = GenConstant(theEnv,theList2->type,theList2->value);
+         tmpExpr->nextArg = theHead;
+         theHead = tmpExpr;
+        }
+     }
+
+   /*=================================================*/
+   /* Set the allowed classes list for the constraint */
+   /* record to the intersected values of the two     */
+   /* other constraint records.                       */
+   /*=================================================*/
+
+   newConstraint->classList = theHead;
+  }
+
+/*********************************************************/
+/* IntersectNumericExpressions: Creates the intersection */
+/*   of two range or two min/max-fields constraints.     */
+/*********************************************************/
+static void IntersectNumericExpressions(
+  Environment *theEnv,
+  CONSTRAINT_RECORD *constraint1,
+  CONSTRAINT_RECORD *constraint2,
+  CONSTRAINT_RECORD *newConstraint,
+  bool range)
+  {
+   struct expr *tmpmin1, *tmpmax1, *tmpmin2, *tmpmax2, *theMin, *theMax;
+   struct expr *theMinList, *theMaxList, *lastMin = NULL, *lastMax = NULL;
+   int cmaxmax, cminmin, cmaxmin, cminmax;
+
+   /*==========================================*/
+   /* Initialize the new range/min/max values  */
+   /* for the intersection of the constraints. */
+   /*==========================================*/
+
+   theMinList = NULL;
+   theMaxList = NULL;
+
+   /*=================================*/
+   /* Determine the min/max values of */
+   /* the first constraint record.    */
+   /*=================================*/
+
+   if (range)
+     {
+      tmpmin1 = constraint1->minValue;
+      tmpmax1 = constraint1->maxValue;
+     }
+   else
+     {
+      tmpmin1 = constraint1->minFields;
+      tmpmax1 = constraint1->maxFields;
+     }
+
+   /*===========================================*/
+   /* Loop through each of range/min/max values */
+   /* from the first constraint record.         */
+   /*===========================================*/
+
+   for (;
+        tmpmin1 != NULL;
+        tmpmin1 = tmpmin1->nextArg, tmpmax1 = tmpmax1->nextArg)
+     {
+      /*============================================*/
+      /* Get the appropriate values from the second */
+      /* constraint record for comparison.          */
+      /*============================================*/
+
+      if (range)
+        {
+         tmpmin2 = constraint2->minValue;
+         tmpmax2 = constraint2->maxValue;
+        }
+      else
+        {
+         tmpmin2 = constraint2->minFields;
+         tmpmax2 = constraint2->maxFields;
+        }
+
+      /*================================================*/
+      /* Loop through each of range/min/max values from */
+      /* the second constraint record comparing it to   */
+      /* the values from the first constraint record.   */
+      /*================================================*/
+
+      for (;
+           tmpmin2 != NULL;
+           tmpmin2 = tmpmin2->nextArg, tmpmax2 = tmpmax2->nextArg)
+        {
+         /*==============================================*/
+         /* Determine the relationship between the four  */
+         /* combinations of min/max values (>, <, or =). */
+         /*==============================================*/
+
+         cmaxmax = CompareNumbers(theEnv,tmpmax1->type,tmpmax1->value,
+                                  tmpmax2->type,tmpmax2->value);
+
+         cminmin = CompareNumbers(theEnv,tmpmin1->type,tmpmin1->value,
+                                  tmpmin2->type,tmpmin2->value);
+
+         cmaxmin = CompareNumbers(theEnv,tmpmax1->type,tmpmax1->value,
+                                  tmpmin2->type,tmpmin2->value);
+
+         cminmax = CompareNumbers(theEnv,tmpmin1->type,tmpmin1->value,
+                                  tmpmax2->type,tmpmax2->value);
+
+         /*============================================*/
+         /* If the range/min/max values don't overlap, */
+         /* then proceed to the next pair of numbers   */
+         /* to see if they overlap.                    */
+         /*============================================*/
+
+         if ((cmaxmin == LESS_THAN) || (cminmax == GREATER_THAN))
+           { continue; }
+
+         /*=======================================*/
+         /* Compute the new minimum value for the */
+         /* intersected range/min/max values.     */
+         /*=======================================*/
+
+         if (cminmin == GREATER_THAN)
+           { theMin = GenConstant(theEnv,tmpmin1->type,tmpmin1->value); }
+         else
+           { theMin = GenConstant(theEnv,tmpmin2->type,tmpmin2->value); }
+
+         /*=======================================*/
+         /* Compute the new maximum value for the */
+         /* intersected range/min/max values.     */
+         /*=======================================*/
+
+         if (cmaxmax == LESS_THAN)
+           { theMax = GenConstant(theEnv,tmpmax1->type,tmpmax1->value); }
+         else
+           { theMax = GenConstant(theEnv,tmpmax2->type,tmpmax2->value); }
+
+         /*==================================*/
+         /* Add the new range/min/max values */
+         /* to the intersection list.        */
+         /*==================================*/
+
+         if (lastMin == NULL)
+           {
+            theMinList = theMin;
+            theMaxList = theMax;
+           }
+         else
+           {
+            lastMin->nextArg = theMin;
+            lastMax->nextArg = theMax;
+           }
+
+         lastMin = theMin;
+         lastMax = theMax;
+        }
+     }
+
+   /*============================================================*/
+   /* If the intersection produced a pair of valid range/min/max */
+   /* values, then replace the previous values of the constraint */
+   /* record to the new intersected values.                      */
+   /*============================================================*/
+
+   if (theMinList != NULL)
+     {
+      if (range)
+        {
+         ReturnExpression(theEnv,newConstraint->minValue);
+         ReturnExpression(theEnv,newConstraint->maxValue);
+         newConstraint->minValue = theMinList;
+         newConstraint->maxValue = theMaxList;
+        }
+      else
+        {
+         ReturnExpression(theEnv,newConstraint->minFields);
+         ReturnExpression(theEnv,newConstraint->maxFields);
+         newConstraint->minFields = theMinList;
+         newConstraint->maxFields = theMaxList;
+        }
+     }
+
+   /*===============================================================*/
+   /* Otherwise, the intersection produced no valid range/min/max   */
+   /* values. For the range attribute, this means that no numbers   */
+   /* can satisfy the constraint. For the min/max fields attribute, */
+   /* it means that no value can satisfy the constraint.            */
+   /*===============================================================*/
+
+   else
+     {
+      if (range)
+        {
+         if (newConstraint->anyAllowed) SetAnyAllowedFlags(newConstraint,false);
+         newConstraint->integersAllowed = false;
+         newConstraint->floatsAllowed = false;
+        }
+      else
+        {
+         SetAnyAllowedFlags(newConstraint,true);
+         newConstraint->singlefieldsAllowed = false;
+         newConstraint->multifieldsAllowed = false;
+         newConstraint->anyAllowed = false;
+        }
+     }
+  }
+
+/************************************************************/
+/* UpdateRestrictionFlags: Updates the types allowed flags  */
+/*   based on the allowed values in a constraint record.    */
+/*   Intended to be called after the allowed values list    */
+/*   has been changed (for example after intersecting the   */
+/*   allowed-values list there may no be any values of a    */
+/*   particular type left even though the type is allowed). */
+/************************************************************/
+static void UpdateRestrictionFlags(
+  CONSTRAINT_RECORD *rv)
+  {
+   if ((rv->anyRestriction) && (rv->restrictionList == NULL))
+     {
+      SetAnyAllowedFlags(rv,true);
+      rv->anyAllowed = false;
+     }
+
+   if ((rv->symbolRestriction) && (rv->symbolsAllowed))
+     { rv->symbolsAllowed = FindItemInExpression(SYMBOL_TYPE,NULL,false,rv->restrictionList); }
+
+   if ((rv->stringRestriction)  && (rv->stringsAllowed))
+     { rv->stringsAllowed = FindItemInExpression(STRING_TYPE,NULL,false,rv->restrictionList); }
+
+   if ((rv->floatRestriction) && (rv->floatsAllowed))
+     { rv->floatsAllowed = FindItemInExpression(FLOAT_TYPE,NULL,false,rv->restrictionList); }
+
+   if ((rv->integerRestriction) && (rv->integersAllowed))
+     { rv->integersAllowed = FindItemInExpression(INTEGER_TYPE,NULL,false,rv->restrictionList); }
+
+   if ((rv->instanceNameRestriction) && (rv->instanceNamesAllowed))
+     { rv->instanceNamesAllowed = FindItemInExpression(INSTANCE_NAME_TYPE,NULL,false,rv->restrictionList); }
+  }
+
+/*************************************************************/
+/* FindItemInExpression: Determines if a particular constant */
+/*   (such as 27) or a class of constants (such as integers) */
+/*   can be found in a list of constants. Returns true if    */
+/*   such a constant can be found, otherwise false.          */
+/*************************************************************/
+static bool FindItemInExpression(
+  int theType,
+  void *theValue,
+  bool useValue,
+  struct expr *theList)
+  {
+   while (theList != NULL)
+     {
+      if (theList->type == theType)
+        {
+         if (! useValue) return true;
+         else if (theList->value == theValue) return true;
+        }
+
+      theList = theList->nextArg;
+     }
+
+   return false;
+  }
+
+/**************************************************/
+/* RestrictionOnType: Determines if a restriction */
+/*   is present for a specific type. Returns true */
+/*   if there is, otherwise false.                */
+/**************************************************/
+static bool RestrictionOnType(
+  int theType,
+  CONSTRAINT_RECORD *theConstraint)
+  {
+   if (theConstraint == NULL) return false;
+
+   if ((theConstraint->anyRestriction) ||
+       (theConstraint->symbolRestriction && (theType == SYMBOL_TYPE)) ||
+       (theConstraint->stringRestriction && (theType == STRING_TYPE)) ||
+       (theConstraint->floatRestriction && (theType == FLOAT_TYPE)) ||
+       (theConstraint->integerRestriction && (theType == INTEGER_TYPE)) ||
+       (theConstraint->classRestriction && ((theType == INSTANCE_ADDRESS_TYPE) ||
+                                            (theType == INSTANCE_NAME_TYPE))) ||
+       (theConstraint->instanceNameRestriction && (theType == INSTANCE_NAME_TYPE)))
+     { return true; }
+
+   return false;
+  }
+
+/**********************************************************/
+/* UnionConstraints: Creates a new constraint record that */
+/*   is the union of two other constraint records.        */
+/**********************************************************/
+struct constraintRecord *UnionConstraints(
+  Environment *theEnv,
+  CONSTRAINT_RECORD *c1,
+  CONSTRAINT_RECORD *c2)
+  {
+   struct constraintRecord *rv;
+   bool c1Changed = false, c2Changed = false;
+
+   /*=================================================*/
+   /* If both constraint records are NULL,then create */
+   /* a constraint record that allows any value.      */
+   /*=================================================*/
+
+   if ((c1 == NULL) && (c2 == NULL)) return(GetConstraintRecord(theEnv));
+
+   /*=====================================================*/
+   /* If one of the constraint records is NULL, then the  */
+   /* union is the other constraint record. Note that     */
+   /* this is different from the way that intersections   */
+   /* were handled (a NULL constraint record implied that */
+   /*  any value was legal which in turn would imply that */
+   /* the union would allow any value as well).           */
+   /*=====================================================*/
+
+   if (c1 == NULL) return(CopyConstraintRecord(theEnv,c2));
+
+   if (c2 == NULL) return(CopyConstraintRecord(theEnv,c1));
+
+   /*=================================*/
+   /* Create a new constraint record. */
+   /*=================================*/
+
+   rv = GetConstraintRecord(theEnv);
+
+   /*==========================*/
+   /* Union the allowed types. */
+   /*==========================*/
+
+   if (c1->multifieldsAllowed || c2->multifieldsAllowed)
+     { rv->multifieldsAllowed = true; }
+
+   if (c1->singlefieldsAllowed || c2->singlefieldsAllowed)
+     { rv->singlefieldsAllowed = true; }
+
+   if (c1->anyAllowed || c2->anyAllowed) rv->anyAllowed = true;
+   else
+     {
+      rv->anyAllowed = false;
+      rv->symbolsAllowed = (c1->symbolsAllowed || c2->symbolsAllowed);
+      rv->stringsAllowed = (c1->stringsAllowed || c2->stringsAllowed);
+      rv->floatsAllowed = (c1->floatsAllowed || c2->floatsAllowed);
+      rv->integersAllowed = (c1->integersAllowed || c2->integersAllowed);
+      rv->instanceNamesAllowed = (c1->instanceNamesAllowed || c2->instanceNamesAllowed);
+      rv->instanceAddressesAllowed = (c1->instanceAddressesAllowed || c2->instanceAddressesAllowed);
+      rv->externalAddressesAllowed = (c1->externalAddressesAllowed || c2->externalAddressesAllowed);
+      rv->voidAllowed = (c1->voidAllowed || c2->voidAllowed);
+      rv->factAddressesAllowed = (c1->factAddressesAllowed || c2->factAddressesAllowed);
+     }
+
+   /*=================================*/
+   /* Union the allowed-values flags. */
+   /*=================================*/
+
+   if (c1->anyRestriction && c2->anyRestriction) rv->anyRestriction = true;
+   else
+     {
+      if (c1->anyRestriction)
+        {
+         c1Changed = true;
+         SetAnyRestrictionFlags(c1,false);
+        }
+      else if (c2->anyRestriction)
+        {
+         c2Changed = true;
+         SetAnyRestrictionFlags(c2,false);
+        }
+
+      rv->anyRestriction = false;
+      rv->symbolRestriction = (c1->symbolRestriction && c2->symbolRestriction);
+      rv->stringRestriction = (c1->stringRestriction && c2->stringRestriction);
+      rv->floatRestriction = (c1->floatRestriction && c2->floatRestriction);
+      rv->integerRestriction = (c1->integerRestriction && c2->integerRestriction);
+      rv->classRestriction = (c1->classRestriction && c2->classRestriction);
+      rv->instanceNameRestriction = (c1->instanceNameRestriction && c2->instanceNameRestriction);
+
+      if (c1Changed) SetAnyRestrictionFlags(c1,false);
+      else if (c2Changed) SetAnyRestrictionFlags(c2,false);
+     }
+
+   /*========================================*/
+   /* Union the allowed values list, the min */
+   /* and max values, and the range values.  */
+   /*========================================*/
+
+   UnionAllowedValueExpressions(theEnv,c1,c2,rv);
+   UnionAllowedClassExpressions(theEnv,c1,c2,rv);
+   UnionNumericExpressions(theEnv,c1,c2,rv,true);
+   UnionNumericExpressions(theEnv,c1,c2,rv,false);
+
+   /*========================================*/
+   /* If multifields are allowed, then union */
+   /* the constraint record for them.        */
+   /*========================================*/
+
+   if (rv->multifieldsAllowed)
+     { rv->multifield = UnionConstraints(theEnv,c1->multifield,c2->multifield); }
+
+   /*====================*/
+   /* Return the unioned */
+   /* constraint record. */
+   /*====================*/
+
+   return(rv);
+  }
+
+/**************************************************/
+/* UnionNumericExpressions: Creates the union of  */
+/*   two range or two min/max-fields constraints. */
+/**************************************************/
+static void UnionNumericExpressions(
+  Environment *theEnv,
+  CONSTRAINT_RECORD *constraint1,
+  CONSTRAINT_RECORD *constraint2,
+  CONSTRAINT_RECORD *newConstraint,
+  bool range)
+  {
+   struct expr *tmpmin, *tmpmax;
+   struct expr *theMinList, *theMaxList;
+
+   /*=========================================*/
+   /* Initialize the new range/min/max values */
+   /* for the union of the constraints.       */
+   /*=========================================*/
+
+   theMinList = NULL;
+   theMaxList = NULL;
+
+   /*=================================*/
+   /* Determine the min/max values of */
+   /* the first constraint record.    */
+   /*=================================*/
+
+   if (range)
+     {
+      tmpmin = constraint1->minValue;
+      tmpmax = constraint1->maxValue;
+     }
+   else
+     {
+      tmpmin = constraint1->minFields;
+      tmpmax = constraint1->maxFields;
+     }
+
+   /*============================================*/
+   /* Add each range/min/max pair from the first */
+   /* constraint record to the union list.       */
+   /*============================================*/
+
+   for (;
+        tmpmin != NULL;
+        tmpmin = tmpmin->nextArg,tmpmax = tmpmax->nextArg)
+     { UnionRangeMinMaxValueWithList(theEnv,tmpmin,tmpmax,&theMinList,&theMaxList); }
+
+   /*=================================*/
+   /* Determine the min/max values of */
+   /* the second constraint record.   */
+   /*=================================*/
+
+   if (range)
+     {
+      tmpmin = constraint2->minValue;
+      tmpmax = constraint2->maxValue;
+     }
+   else
+     {
+      tmpmin = constraint2->minFields;
+      tmpmax = constraint2->maxFields;
+     }
+
+   /*=============================================*/
+   /* Add each range/min/max pair from the second */
+   /* constraint record to the union list.        */
+   /*=============================================*/
+
+   for (;
+        tmpmin != NULL;
+        tmpmin = tmpmin->nextArg,tmpmax = tmpmax->nextArg)
+     { UnionRangeMinMaxValueWithList(theEnv,tmpmin,tmpmax,&theMinList,&theMaxList); }
+
+   /*=====================================================*/
+   /* If the union produced a pair of valid range/min/max */
+   /* values, then replace the previous values of the     */
+   /* constraint record to the new unioned values.        */
+   /*=====================================================*/
+
+   if (theMinList != NULL)
+     {
+      if (range)
+        {
+         ReturnExpression(theEnv,newConstraint->minValue);
+         ReturnExpression(theEnv,newConstraint->maxValue);
+         newConstraint->minValue = theMinList;
+         newConstraint->maxValue = theMaxList;
+        }
+      else
+        {
+         ReturnExpression(theEnv,newConstraint->minFields);
+         ReturnExpression(theEnv,newConstraint->maxFields);
+         newConstraint->minFields = theMinList;
+         newConstraint->maxFields = theMaxList;
+        }
+     }
+
+   /*==============================================================*/
+   /* Otherwise, the union produced no valid range/min/max values. */
+   /* For the range attribute, this means that no numbers can      */
+   /* satisfy the constraint. For the min/max fields attribute, it */
+   /* means that no value can satisfy the constraint.              */
+   /*==============================================================*/
+
+   else
+     {
+      if (range)
+        {
+         if (newConstraint->anyAllowed) SetAnyAllowedFlags(newConstraint,false);
+         newConstraint->integersAllowed = false;
+         newConstraint->floatsAllowed = false;
+        }
+      else
+        {
+         SetAnyAllowedFlags(newConstraint,true);
+         newConstraint->anyAllowed = true;
+        }
+     }
+  }
+
+/*********************************************************/
+/* UnionRangeMinMaxValueWithList: Unions a range/min/max */
+/*   pair of values with a list of such values.          */
+/*********************************************************/
+static void UnionRangeMinMaxValueWithList(
+  Environment *theEnv,
+  struct expr *addmin,
+  struct expr *addmax,
+  struct expr **theMinList,
+  struct expr **theMaxList)
+  {
+   struct expr *tmpmin, *tmpmax, *lastmin, *lastmax;
+   struct expr *themin, *themax, *nextmin, *nextmax;
+   int cmaxmin, cmaxmax, cminmin, cminmax;
+
+   /*=========================================================*/
+   /* If no values are on the lists, then use the new values. */
+   /*=========================================================*/
+
+   if (*theMinList == NULL)
+     {
+      *theMinList = GenConstant(theEnv,addmin->type,addmin->value);
+      *theMaxList = GenConstant(theEnv,addmax->type,addmax->value);
+      return;
+     }
+
+   lastmin = NULL;
+   lastmax = NULL;
+   tmpmin = (*theMinList);
+   tmpmax = (*theMaxList);
+
+   while (tmpmin != NULL)
+     {
+      cmaxmax = CompareNumbers(theEnv,addmax->type,addmax->value,
+                               tmpmax->type,tmpmax->value);
+
+      cminmin = CompareNumbers(theEnv,addmin->type,addmin->value,
+                               tmpmin->type,tmpmin->value);
+
+      cmaxmin = CompareNumbers(theEnv,addmax->type,addmax->value,
+                               tmpmin->type,tmpmin->value);
+
+      cminmax = CompareNumbers(theEnv,addmin->type,addmin->value,
+                               tmpmax->type,tmpmax->value);
+
+      /*=================================*/
+      /* Check to see if the range is    */
+      /* contained within another range. */
+      /*=================================*/
+
+      if (((cmaxmax == LESS_THAN) || (cmaxmax == EQUAL)) &&
+          ((cminmin == GREATER_THAN) || (cminmin == EQUAL)))
+        { return; }
+
+      /*================================*/
+      /* Extend the greater than range. */
+      /*================================*/
+
+      if ((cmaxmax == GREATER_THAN) &&
+          ((cminmax == LESS_THAN) || (cminmax == EQUAL)))
+        {
+         tmpmax->type = addmax->type;
+         tmpmax->value = addmax->value;
+        }
+
+      /*=============================*/
+      /* Extend the less than range. */
+      /*=============================*/
+
+      if ((cminmin == LESS_THAN) &&
+          ((cmaxmin == GREATER_THAN) || (cmaxmin == EQUAL)))
+        {
+         tmpmin->type = addmin->type;
+         tmpmin->value = addmin->value;
+        }
+
+      /*====================*/
+      /* Handle insertions. */
+      /*====================*/
+
+      if (cmaxmin == LESS_THAN)
+        {
+         if (lastmax == NULL)
+           {
+            themin = GenConstant(theEnv,addmin->type,addmin->value);
+            themax = GenConstant(theEnv,addmax->type,addmax->value);
+            themin->nextArg = *theMinList;
+            themax->nextArg = *theMaxList;
+            *theMinList = themin;
+            *theMaxList = themax;
+            return;
+           }
+
+         if (CompareNumbers(theEnv,addmin->type,addmin->value,
+                            lastmax->type,lastmax->value) == GREATER_THAN)
+           {
+            themin = GenConstant(theEnv,addmin->type,addmin->value);
+            themax = GenConstant(theEnv,addmax->type,addmax->value);
+
+            themin->nextArg = lastmin->nextArg;
+            themax->nextArg = lastmax->nextArg;
+
+            lastmin->nextArg = themin;
+            lastmax->nextArg = themax;
+            return;
+           }
+        }
+
+      /*==========================*/
+      /* Move on to the next one. */
+      /*==========================*/
+
+      tmpmin = tmpmin->nextArg;
+      tmpmax = tmpmax->nextArg;
+     }
+
+   /*===========================*/
+   /* Merge overlapping ranges. */
+   /*===========================*/
+
+   tmpmin = (*theMinList);
+   tmpmax = (*theMaxList);
+
+   while (tmpmin != NULL)
+     {
+      nextmin = tmpmin->nextArg;
+      nextmax = tmpmax->nextArg;
+      if (nextmin != NULL)
+        {
+         cmaxmin = CompareNumbers(theEnv,tmpmax->type,tmpmax->value,
+                                  nextmin->type,nextmin->value);
+         if ((cmaxmin == GREATER_THAN) || (cmaxmin == EQUAL))
+           {
+            tmpmax->type = nextmax->type;
+            tmpmax->value = nextmax->value;
+            tmpmax->nextArg = nextmax->nextArg;
+            tmpmin->nextArg = nextmin->nextArg;
+
+            rtn_struct(theEnv,expr,nextmin);
+            rtn_struct(theEnv,expr,nextmax);
+           }
+         else
+           {
+            tmpmin = tmpmin->nextArg;
+            tmpmax = tmpmax->nextArg;
+           }
+        }
+      else
+        {
+         tmpmin = nextmin;
+         tmpmax = nextmax;
+        }
+     }
+  }
+
+/***************************************************/
+/* UnionAllowedClassExpressions: Creates the union */
+/*   of two sets of allowed-classes expressions.   */
+/***************************************************/
+static void UnionAllowedClassExpressions(
+  Environment *theEnv,
+  CONSTRAINT_RECORD *constraint1,
+  CONSTRAINT_RECORD *constraint2,
+  CONSTRAINT_RECORD *newConstraint)
+  {
+   struct expr *theHead = NULL;
+
+   theHead = AddToUnionList(theEnv,constraint1->classList,theHead,newConstraint);
+   theHead = AddToUnionList(theEnv,constraint2->classList,theHead,newConstraint);
+
+   newConstraint->classList = theHead;
+  }
+
+/***************************************************/
+/* UnionAllowedValueExpressions: Creates the union */
+/*   of two sets of allowed value expressions.     */
+/***************************************************/
+static void UnionAllowedValueExpressions(
+  Environment *theEnv,
+  CONSTRAINT_RECORD *constraint1,
+  CONSTRAINT_RECORD *constraint2,
+  CONSTRAINT_RECORD *newConstraint)
+  {
+   struct expr *theHead = NULL;
+
+   theHead = AddToUnionList(theEnv,constraint1->restrictionList,theHead,newConstraint);
+   theHead = AddToUnionList(theEnv,constraint2->restrictionList,theHead,newConstraint);
+
+   newConstraint->restrictionList = theHead;
+  }
+
+/************************************************************/
+/* AddToUnionList: Adds a list of values to a unioned list  */
+/*   making sure that duplicates are not added and that any */
+/*   value added satisfies the constraints for the list.    */
+/************************************************************/
+static struct expr *AddToUnionList(
+  Environment *theEnv,
+  struct expr *theList1,
+  struct expr *theHead,
+  CONSTRAINT_RECORD *theConstraint)
+  {
+   struct expr *theList2;
+   bool flag;
+
+   /*======================================*/
+   /* Loop through each value in the list  */
+   /* being added to the unioned set.      */
+   /*======================================*/
+
+   for (;theList1 != NULL; theList1 = theList1->nextArg)
+     {
+      /*===================================*/
+      /* Determine if the value is already */
+      /* in the unioned list.              */
+      /*===================================*/
+
+      flag = true;
+      for (theList2 = theHead;
+           theList2 != NULL;
+           theList2 = theList2->nextArg)
+        {
+         if ((theList1->type == theList2->type) &&
+             (theList1->value == theList2->value))
+           {
+            flag = false;
+            break;
+           }
+        }
+
+      /*=====================================================*/
+      /* If the value wasn't in the unioned list and doesn't */
+      /* violate any of the unioned list's constraints, then */
+      /* add it to the list.                                 */
+      /*=====================================================*/
+
+      if (flag)
+        {
+         if (RestrictionOnType(theList1->type,theConstraint))
+           {
+            theList2 = GenConstant(theEnv,theList1->type,theList1->value);
+            theList2->nextArg = theHead;
+            theHead = theList2;
+           }
+        }
+     }
+
+   /*==============================*/
+   /* Return the new unioned list. */
+   /*==============================*/
+
+   return(theHead);
+  }
+
+#if (! BLOAD_ONLY)
+
+/****************************************************/
+/* RemoveConstantFromConstraint: Removes a constant */
+/*   value (including any duplicates) from the      */
+/*   restriction list of a constraint record.       */
+/****************************************************/
+void RemoveConstantFromConstraint(
+  Environment *theEnv,
+  int theType,
+  void *theValue,
+  CONSTRAINT_RECORD *theConstraint)
+  {
+   struct expr *theList, *lastOne = NULL, *tmpList;
+
+   if (theConstraint == NULL) return;
+
+   theList = theConstraint->restrictionList;
+   theConstraint->restrictionList = NULL;
+
+   while (theList != NULL)
+     {
+      if ((theList->type != theType) || (theList->value != theValue))
+        {
+         if (lastOne == NULL)
+           { theConstraint->restrictionList = theList; }
+         else
+           { lastOne->nextArg = theList; }
+         lastOne = theList;
+         theList = theList->nextArg;
+         lastOne->nextArg = NULL;
+        }
+      else
+        {
+         tmpList = theList;
+         theList = theList->nextArg;
+         tmpList->nextArg = NULL;
+         ReturnExpression(theEnv,tmpList);
+        }
+     }
+
+   UpdateRestrictionFlags(theConstraint);
+  }
+
+#endif /* (! BLOAD_ONLY) */