text:    /*******************************************************/
     /*      "C" Language Integrated Production System      */
     /*                                                     */
     /*            CLIPS Version 6.40  07/30/16             */
     /*                                                     */
     /*                   FACT BUILD MODULE                 */
     /*******************************************************/
  
  /*************************************************************/
  /* Purpose: Given a new fact pattern, adds the pattern to    */
  /*   the pattern network of the associated deftemplate. Also */
  /*   contains routines for deleting a pattern from the fact  */
  /*   pattern network.                                        */
  /*                                                           */
  /* Principal Programmer(s):                                  */
  /*      Gary D. Riley                                        */
  /*                                                           */
  /* Contributing Programmer(s):                               */
  /*                                                           */
  /* Revision History:                                         */
  /*                                                           */
  /*      6.24: Removed INCREMENTAL_RESET compilation flag.    */
  /*                                                           */
  /*      6.30: Added support for hashed alpha memories.       */
  /*                                                           */
  /*            Added support for hashed comparisons to        */
  /*            constants.                                     */
  /*                                                           */
  /*      6.40: Pragma once and other inclusion changes.       */
  /*                                                           */
  /*            Added support for booleans with <stdbool.h>.   */
  /*                                                           */
  /*            Removed use of void pointers for specific      */
  /*            data structures.                               */
  /*                                                           */
  /*            Removed initial-fact support.                  */
  /*                                                           */
  /*************************************************************/
  
  #include "setup.h"
  
  #if DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT
  
  #include <stdio.h>
  
  #include "argacces.h"
  #include "envrnmnt.h"
  #include "factcmp.h"
  #include "factgen.h"
  #include "factlhs.h"
  #include "factmch.h"
  #include "factmngr.h"
  #include "memalloc.h"
  #include "modulutl.h"
  #include "reorder.h"
  #include "reteutil.h"
  #include "router.h"
  #include "tmpltdef.h"
  
  #include "factbld.h"
  
  /***************************************/
  /* LOCAL INTERNAL FUNCTION DEFINITIONS */
  /***************************************/
  
  #if (! RUN_TIME) && (! BLOAD_ONLY)
     static struct factPatternNode    *FindPatternNode(struct factPatternNode *,struct lhsParseNode *,
                                                    struct factPatternNode **,bool,bool);
     static struct factPatternNode    *CreateNewPatternNode(Environment *,struct lhsParseNode *,struct factPatternNode *,
                                                         struct factPatternNode *,bool,bool);
     static void                       ClearPatternMatches(Environment *,struct factPatternNode *);
     static void                       DetachFactPattern(Environment *,struct patternNodeHeader *);
     static struct patternNodeHeader  *PlaceFactPattern(Environment *,struct lhsParseNode *);
     static struct lhsParseNode       *RemoveUnneededSlots(Environment *,struct lhsParseNode *);
     static void                       FindAndSetDeftemplatePatternNetwork(Environment *,struct factPatternNode *,struct factPatternNode *);
  #endif
  
  /*********************************************************/
  /* InitializeFactPatterns: Adds fact patterns to the set */
  /*   of patterns recognized by the rule pattern parsing  */
  /*   and pattern/join network integration routines.      */
  /*********************************************************/
  void InitializeFactPatterns(
    Environment *theEnv)
    {
  #if DEFRULE_CONSTRUCT
     struct patternParser *newPtr;
  
     InitializeFactReteFunctions(theEnv);
  
     newPtr = get_struct(theEnv,patternParser);
  
     newPtr->name = "facts";
     newPtr->priority = 0;
     newPtr->entityType = &FactData(theEnv)->FactInfo;
  
  #if (! RUN_TIME) && (! BLOAD_ONLY)
     newPtr->recognizeFunction = FactPatternParserFind;
     newPtr->parseFunction = FactPatternParse;
     newPtr->postAnalysisFunction = NULL;
     newPtr->addPatternFunction = PlaceFactPattern;
     newPtr->removePatternFunction = DetachFactPattern;
     newPtr->genJNConstantFunction = NULL;
     newPtr->replaceGetJNValueFunction = FactReplaceGetvar;
     newPtr->genGetJNValueFunction = FactGenGetvar;
     newPtr->genCompareJNValuesFunction = FactJNVariableComparison;
     newPtr->genPNConstantFunction = FactGenPNConstant;
     newPtr->replaceGetPNValueFunction = FactReplaceGetfield;
     newPtr->genGetPNValueFunction = FactGenGetfield;
     newPtr->genComparePNValuesFunction = FactPNVariableComparison;
     newPtr->returnUserDataFunction = NULL;
     newPtr->copyUserDataFunction = NULL;
  #else
     newPtr->recognizeFunction = NULL;
     newPtr->parseFunction = NULL;
     newPtr->postAnalysisFunction = NULL;
     newPtr->addPatternFunction = NULL;
     newPtr->removePatternFunction = NULL;
     newPtr->genJNConstantFunction = NULL;
     newPtr->replaceGetJNValueFunction = NULL;
     newPtr->genGetJNValueFunction = NULL;
     newPtr->genCompareJNValuesFunction = NULL;
     newPtr->genPNConstantFunction = NULL;
     newPtr->replaceGetPNValueFunction = NULL;
     newPtr->genGetPNValueFunction = NULL;
     newPtr->genComparePNValuesFunction = NULL;
     newPtr->returnUserDataFunction = NULL;
     newPtr->copyUserDataFunction = NULL;
  #endif
  
     newPtr->markIRPatternFunction = MarkFactPatternForIncrementalReset;
     newPtr->incrementalResetFunction = FactsIncrementalReset;
  
  #if (! RUN_TIME) && (! BLOAD_ONLY)
  #if CONSTRUCT_COMPILER
     newPtr->codeReferenceFunction = FactPatternNodeReference;
  #else
     newPtr->codeReferenceFunction = NULL;
  #endif
  #else
     newPtr->codeReferenceFunction = NULL;
  #endif
  
     AddPatternParser(theEnv,newPtr);
  #endif
    }
  
  #if (! RUN_TIME) && (! BLOAD_ONLY)
  
  /******************************************************************************/
  /* PlaceFactPattern: Integrates a fact pattern into the fact pattern network. */
  /******************************************************************************/
  static struct patternNodeHeader *PlaceFactPattern(
    Environment *theEnv,
    struct lhsParseNode *thePattern)
    {
     struct lhsParseNode *tempPattern;
     struct factPatternNode *currentLevel, *lastLevel;
     struct factPatternNode *nodeBeforeMatch, *newNode = NULL;
     bool endSlot;
     int count;
     const char *deftemplateName;
  
     /*======================================================================*/
     /* Get the name of the deftemplate associated with the pattern being    */
     /* added (recall that the first field of any pattern must be a symbol). */
     /*======================================================================*/
  
     deftemplateName = thePattern->right->bottom->lexemeValue->contents;
  
     /*=====================================================*/
     /* Remove any slot tests that test only for existance. */
     /*=====================================================*/
  
     thePattern->right = RemoveUnneededSlots(theEnv,thePattern->right);
  
     /*========================================================*/
     /* If the constant test for the relation name is the only */
     /* pattern network test and there are no other network    */
     /* tests, then remove the test, but keep the node since   */
     /* there must be a link from the fact pattern network to  */
     /* the join network. Otherwise, remove the test for the   */
     /* relation name since this test has already been done    */
     /* before entering the pattern network (since each        */
     /* deftemplate has its own pattern network).              */
     /*========================================================*/
  
     if (thePattern->right->right == NULL)
       {
        ReturnExpression(theEnv,thePattern->right->networkTest);
        ReturnExpression(theEnv,thePattern->right->constantSelector);
        ReturnExpression(theEnv,thePattern->right->constantValue);
        thePattern->right->networkTest = NULL;
        thePattern->right->constantSelector = NULL;
        thePattern->right->constantValue = NULL;
       }
     else
       {
        tempPattern = thePattern->right;
        thePattern->right = thePattern->right->right;
        tempPattern->right = NULL;
  	  ReturnLHSParseNodes(theEnv,tempPattern);
       }
  
     /*====================================================*/
     /* Get the expression for hashing in the alpha memory */
     /* and attach it to the last node of the pattern.     */
     /*====================================================*/
  
     tempPattern = thePattern->right;
     while (tempPattern->right != NULL)
       { tempPattern = tempPattern->right; }
  
     if ((tempPattern->multifieldSlot) && (tempPattern->bottom != NULL))
       {
        tempPattern = tempPattern->bottom;
  
        while (tempPattern->right != NULL)
          { tempPattern = tempPattern->right; }
       }
  
     tempPattern->rightHash = thePattern->rightHash;
     thePattern->rightHash = NULL;
  
     tempPattern = NULL;
  
     /*============================================================*/
     /* Get a pointer to the deftemplate data structure associated */
     /* with the pattern (use the deftemplate name extracted from  */
     /* the first field of the pattern).                           */
     /*============================================================*/
  
     FactData(theEnv)->CurrentDeftemplate = (Deftemplate *)
                          FindImportedConstruct(theEnv,"deftemplate",NULL,
                                                deftemplateName,&count,
                                                true,NULL);
  
     /*================================================*/
     /* Initialize some pointers to indicate where the */
     /* pattern is being added to the pattern network. */
     /*================================================*/
  
     currentLevel = FactData(theEnv)->CurrentDeftemplate->patternNetwork;
     lastLevel = NULL;
     thePattern = thePattern->right;
  
     /*===========================================*/
     /* Loop until all fields in the pattern have */
     /* been added to the pattern network.        */
     /*===========================================*/
  
     while (thePattern != NULL)
       {
        /*===========================================================*/
        /* If a multifield slot is being processed, then process the */
        /* pattern nodes attached to the multifield pattern node.    */
        /*===========================================================*/
  
        if (thePattern->multifieldSlot)
          {
           tempPattern = thePattern;
           thePattern = thePattern->bottom;
          }
  
        /*============================================*/
        /* Determine if the last pattern field within */
        /* a multifield slot is being processed.      */
        /*============================================*/
  
        if ((thePattern->right == NULL) && (tempPattern != NULL))
          { endSlot = true; }
        else
          { endSlot = false; }
  
        /*========================================*/
        /* Is there a node in the pattern network */
        /* that can be reused (shared)?           */
        /*========================================*/
  
        newNode = FindPatternNode(currentLevel,thePattern,&nodeBeforeMatch,endSlot,false);
  
        /*================================================*/
        /* If the pattern node cannot be shared, then add */
        /* a new pattern node to the pattern network.     */
        /*================================================*/
  
        if (newNode == NULL)
          { newNode = CreateNewPatternNode(theEnv,thePattern,nodeBeforeMatch,lastLevel,endSlot,false); }
  
        if (thePattern->constantSelector != NULL)
          {
           currentLevel = newNode->nextLevel;
           lastLevel = newNode;
           newNode = FindPatternNode(currentLevel,thePattern,&nodeBeforeMatch,endSlot,true);
  
           if (newNode == NULL)
             { newNode = CreateNewPatternNode(theEnv,thePattern,nodeBeforeMatch,lastLevel,endSlot,true); }
          }
  
        /*===========================================================*/
        /* Move on to the next field in the new pattern to be added. */
        /*===========================================================*/
  
        if ((thePattern->right == NULL) && (tempPattern != NULL))
          {
           thePattern = tempPattern;
           tempPattern = NULL;
          }
  
        thePattern = thePattern->right;
  
        /*==========================================================*/
        /* If there are no more pattern nodes to be added to the    */
        /* pattern network, then mark the last pattern node added   */
        /* as a stop node (i.e. if you get to this node and the     */
        /* network test succeeds, then a pattern has been matched). */
        /*==========================================================*/
  
        if (thePattern == NULL) newNode->header.stopNode = true;
  
        /*================================================*/
        /* Update the pointers which indicate where we're */
        /* trying to add the new pattern to the currently */
        /* existing pattern network.                      */
        /*================================================*/
  
        lastLevel = newNode;
        currentLevel = newNode->nextLevel;
       }
  
     /*==================================================*/
     /* Return the leaf node of the newly added pattern. */
     /*==================================================*/
  
     return((struct patternNodeHeader *) newNode);
    }
  
  /*************************************************************/
  /* FindPatternNode: Looks for a pattern node at a specified  */
  /*  level in the pattern network that can be reused (shared) */
  /*  with a pattern field being added to the pattern network. */
  /*************************************************************/
  static struct factPatternNode *FindPatternNode(
    struct factPatternNode *listOfNodes,
    struct lhsParseNode *thePattern,
    struct factPatternNode **nodeBeforeMatch,
    bool endSlot,
    bool constantSelector)
    {
     struct expr *compareTest;
     *nodeBeforeMatch = NULL;
  
     if (constantSelector)
       { compareTest = thePattern->constantValue; }
     else if (thePattern->constantSelector != NULL)
       { compareTest = thePattern->constantSelector; }
     else
       { compareTest = thePattern->networkTest; }
  
     /*==========================================================*/
     /* Loop through the nodes at the given level in the pattern */
     /* network looking for a node that can be reused (shared)?  */
     /*==========================================================*/
  
     while (listOfNodes != NULL)
       {
        /*==========================================================*/
        /* If the type of the pattern node and the expression being */
        /* tested by the pattern node are the same as the type and  */
        /* expression for the pattern field being added, then       */
        /* return the pattern node because it can be shared with    */
        /* the pattern field being added.                           */
        /*==========================================================*/
  
        if ((thePattern->pnType == SF_WILDCARD_NODE) || (thePattern->pnType == SF_VARIABLE_NODE))
          {
           if ((listOfNodes->header.singlefieldNode) &&
               (listOfNodes->header.endSlot == endSlot) &&
               (listOfNodes->whichField == thePattern->index) &&
               (listOfNodes->whichSlot == (thePattern->slotNumber - 1)) &&
               IdenticalExpression(listOfNodes->networkTest,compareTest) &&
               IdenticalExpression(listOfNodes->header.rightHash,thePattern->rightHash))
             { return(listOfNodes); }
          }
        else if ((thePattern->pnType == MF_WILDCARD_NODE) || (thePattern->pnType == MF_VARIABLE_NODE))
          {
           if ((listOfNodes->header.multifieldNode) &&
               (listOfNodes->header.endSlot == endSlot) &&
               (listOfNodes->leaveFields == thePattern->singleFieldsAfter) &&
               (listOfNodes->whichField == thePattern->index) &&
               (listOfNodes->whichSlot == (thePattern->slotNumber - 1)) &&
               IdenticalExpression(listOfNodes->networkTest,compareTest) &&
               IdenticalExpression(listOfNodes->header.rightHash,thePattern->rightHash))
             { return(listOfNodes); }
          }
  
        /*==================================*/
        /* Move on to the next node at this */
        /* level in the pattern network.    */
        /*==================================*/
  
        *nodeBeforeMatch = listOfNodes;
        listOfNodes = listOfNodes->rightNode;
       }
  
     /*==============================================*/
     /* A shareable pattern node could not be found. */
     /*==============================================*/
  
     return NULL;
    }
  
  /*************************************************************/
  /* RemoveUnneededSlots: Removes fact pattern nodes that have */
  /*   no effect on pattern matching. For example, given the   */
  /*   following deftemplate and a pattern using it,           */
  /*                                                           */
  /*   (deftemplate foo (slot x) (slot y))                     */
  /*                                                           */
  /*   (foo (x ?x) (y ?y))                                     */
  /*                                                           */
  /*   The x and y slot pattern nodes can be discarded since   */
  /*   all foo facts will have these two slots in the fact     */
  /*   data structure used to store them.                      */
  /*************************************************************/
  static struct lhsParseNode *RemoveUnneededSlots(
    Environment *theEnv,
    struct lhsParseNode *thePattern)
    {
     struct lhsParseNode *tempPattern = thePattern;
     struct lhsParseNode *lastPattern = NULL, *head = thePattern;
     struct expr *theTest;
  
     while (tempPattern != NULL)
       {
        /*=============================================================*/
        /* A single field slot that has no pattern network expression  */
        /* associated with it can be removed (i.e. any value contained */
        /* in this slot will satisfy the pattern being matched).       */
        /*=============================================================*/
  
        if (((tempPattern->pnType == SF_WILDCARD_NODE) || (tempPattern->pnType == SF_VARIABLE_NODE)) &&
            (tempPattern->networkTest == NULL))
          {
           if (lastPattern != NULL) lastPattern->right = tempPattern->right;
           else head = tempPattern->right;
  
           tempPattern->right = NULL;
           ReturnLHSParseNodes(theEnv,tempPattern);
  
           if (lastPattern != NULL) tempPattern = lastPattern->right;
           else tempPattern = head;
          }
  
        /*=======================================================*/
        /* A multifield variable or wildcard within a multifield */
        /* slot can be removed if there are no other multifield  */
        /* variables or wildcards contained in the same slot     */
        /* (and the multifield has no expressions which must be  */
        /* evaluated in the fact pattern network).               */
        /*=======================================================*/
  
        else if (((tempPattern->pnType == MF_WILDCARD_NODE) || (tempPattern->pnType == MF_VARIABLE_NODE)) &&
                 (tempPattern->multifieldSlot == false) &&
                 (tempPattern->networkTest == NULL) &&
                 (tempPattern->multiFieldsBefore == 0) &&
                 (tempPattern->multiFieldsAfter == 0))
          {
           if (lastPattern != NULL) lastPattern->right = tempPattern->right;
           else head = tempPattern->right;
  
           tempPattern->right = NULL;
           ReturnLHSParseNodes(theEnv,tempPattern);
  
           if (lastPattern != NULL) tempPattern = lastPattern->right;
           else tempPattern = head;
          }
  
        /*==================================================================*/
        /* A multifield wildcard or variable contained in a multifield slot */
        /* that contains no other multifield wildcards or variables, but    */
        /* does have an expression that must be evaluated, can be changed   */
        /* to a single field pattern node with the same expression.         */
        /*==================================================================*/
  
        else if (((tempPattern->pnType == MF_WILDCARD_NODE) || (tempPattern->pnType == MF_VARIABLE_NODE)) &&
                 (tempPattern->multifieldSlot == false) &&
                 (tempPattern->networkTest != NULL) &&
                 (tempPattern->multiFieldsBefore == 0) &&
                 (tempPattern->multiFieldsAfter == 0))
          {
           tempPattern->pnType = SF_WILDCARD_NODE;
           lastPattern = tempPattern;
           tempPattern = tempPattern->right;
          }
  
        /*=========================================================*/
        /* If we're dealing with a multifield slot with no slot    */
        /* restrictions, then treat the multfield slot as a single */
        /* field slot, but attach a test which verifies that the   */
        /* slot contains a zero length multifield value.           */
        /*=========================================================*/
  
        else if ((tempPattern->pnType == MF_WILDCARD_NODE) &&
                 (tempPattern->multifieldSlot == true) &&
                 (tempPattern->bottom == NULL))
          {
           tempPattern->pnType = SF_WILDCARD_NODE;
           tempPattern->networkTest = FactGenCheckZeroLength(theEnv,tempPattern->slotNumber);
           tempPattern->multifieldSlot = false;
           lastPattern = tempPattern;
           tempPattern = tempPattern->right;
          }
  
        /*===================================================*/
        /* Recursively call RemoveUnneededSlots for the slot */
        /* restrictions contained within a multifield slot.  */
        /*===================================================*/
  
        else if ((tempPattern->pnType == MF_WILDCARD_NODE) &&
                 (tempPattern->multifieldSlot == true))
          {
           /*=======================================================*/
           /* Add an expression to the first pattern restriction in */
           /* the multifield slot that determines whether or not    */
           /* the fact's slot value contains the minimum number of  */
           /* required fields to satisfy the pattern restrictions   */
           /* for this slot. The length check is place before any   */
           /* other tests, so that preceeding checks do not have to */
           /* determine if there are enough fields in the slot to   */
           /* safely retrieve a value.                              */
           /*=======================================================*/
  
           theTest = FactGenCheckLength(theEnv,tempPattern->bottom);
           if (tempPattern->bottom->constantSelector != NULL)
             { tempPattern->bottom->constantSelector->nextArg = CopyExpression(theEnv,theTest); }
           theTest = CombineExpressions(theEnv,theTest,tempPattern->bottom->networkTest);
           tempPattern->bottom->networkTest = theTest;
  
           /*=========================================================*/
           /* Remove any unneeded pattern restrictions from the slot. */
           /*=========================================================*/
  
           tempPattern->bottom = RemoveUnneededSlots(theEnv,tempPattern->bottom);
  
           /*===========================================================*/
           /* If the slot no longer contains any restrictions, then the */
           /* multifield slot can be completely removed. In any case,   */
           /* move on to the next slot to be examined for removal.      */
           /*===========================================================*/
  
           if (tempPattern->bottom == NULL)
             {
              if (lastPattern != NULL) lastPattern->right = tempPattern->right;
              else head = tempPattern->right;
  
              tempPattern->right = NULL;
              ReturnLHSParseNodes(theEnv,tempPattern);
  
              if (lastPattern != NULL) tempPattern = lastPattern->right;
              else tempPattern = head;
             }
           else
             {
              lastPattern = tempPattern;
              tempPattern = tempPattern->right;
             }
          }
  
        /*=======================================================*/
        /* If none of the other tests for removing slots or slot */
        /* restrictions apply, then move on to the next slot or  */
        /* slot restriction to be tested.                        */
        /*=======================================================*/
  
        else
          {
           lastPattern = tempPattern;
           tempPattern = tempPattern->right;
          }
       }
  
     /*======================================*/
     /* Return the pattern with unused slots */
     /* and slot restrictions removed.       */
     /*======================================*/
  
     return(head);
    }
  
  /****************************************************/
  /* CreateNewPatternNode: Creates a new pattern node */
  /*   and initializes all of its values.             */
  /****************************************************/
  static struct factPatternNode *CreateNewPatternNode(
    Environment *theEnv,
    struct lhsParseNode *thePattern,
    struct factPatternNode *nodeBeforeMatch,
    struct factPatternNode *upperLevel,
    bool endSlot,
    bool constantSelector)
    {
     struct factPatternNode *newNode;
  
     /*========================================*/
     /* Create the pattern node and initialize */
     /* its slots to the default values.       */
     /*========================================*/
  
     newNode = get_struct(theEnv,factPatternNode);
     newNode->nextLevel = NULL;
     newNode->rightNode = NULL;
     newNode->leftNode = NULL;
     newNode->leaveFields = thePattern->singleFieldsAfter;
     InitializePatternHeader(theEnv,(struct patternNodeHeader *) &newNode->header);
  
     if (thePattern->index > 0)
       { newNode->whichField = (unsigned short) thePattern->index; }
     else newNode->whichField = 0;
  
     if (thePattern->slotNumber >= 0)
       { newNode->whichSlot = (unsigned short) (thePattern->slotNumber - 1); }
     else
       { newNode->whichSlot = newNode->whichField; }
  
     if ((thePattern->constantSelector != NULL) && (! constantSelector))
       { newNode->header.selector = true; }
  
     /*=============================================================*/
     /* Set the slot values which indicate whether the pattern node */
     /* is a single-field, multifield, or end-of-pattern node.      */
     /*=============================================================*/
  
     if ((thePattern->pnType == SF_WILDCARD_NODE) || (thePattern->pnType == SF_VARIABLE_NODE))
       { newNode->header.singlefieldNode = true; }
     else if ((thePattern->pnType == MF_WILDCARD_NODE) || (thePattern->pnType == MF_VARIABLE_NODE))
       { newNode->header.multifieldNode = true; }
     newNode->header.endSlot = endSlot;
  
     /*===========================================================*/
     /* Install the expression associated with this pattern node. */
     /*===========================================================*/
  
     if (constantSelector)
       { newNode->networkTest = AddHashedExpression(theEnv,thePattern->constantValue); }
     else if (thePattern->constantSelector != NULL)
       { newNode->networkTest = AddHashedExpression(theEnv,thePattern->constantSelector); }
     else
       { newNode->networkTest = AddHashedExpression(theEnv,thePattern->networkTest); }
  
     /*==========================================*/
     /* Add the expression used for adding alpha */
     /* matches to the alpha memory.             */
     /*==========================================*/
  
     newNode->header.rightHash = AddHashedExpression(theEnv,thePattern->rightHash);
  
     /*===============================================*/
     /* Set the upper level pointer for the new node. */
     /*===============================================*/
  
     newNode->lastLevel = upperLevel;
  
     if ((upperLevel != NULL) && (upperLevel->header.selector))
       { AddHashedPatternNode(theEnv,upperLevel,newNode,newNode->networkTest->type,newNode->networkTest->value); }
  
     /*======================================================*/
     /* If there are no nodes on this level, then attach the */
     /* new node to the child pointer of the upper level.    */
     /*======================================================*/
  
     if (nodeBeforeMatch == NULL)
       {
        if (upperLevel == NULL) FactData(theEnv)->CurrentDeftemplate->patternNetwork = newNode;
        else upperLevel->nextLevel = newNode;
        return(newNode);
       }
  
     /*=====================================================*/
     /* If there is an upper level above the new node, then */
     /* place the new node as the first child in the upper  */
     /* level's nextLevel (child) link.                     */
     /*=====================================================*/
  
     if (upperLevel != NULL)
       {
        newNode->rightNode = upperLevel->nextLevel;
        if (upperLevel->nextLevel != NULL)
          { upperLevel->nextLevel->leftNode = newNode; }
        upperLevel->nextLevel = newNode;
        return(newNode);
       }
  
     /*=====================================================*/
     /* Since there is no upper level above the new node,   */
     /* (i.e. the new node is being added to the highest    */
     /* level in the pattern network), the new node becomes */
     /* the first node visited in the pattern network.      */
     /*=====================================================*/
  
     newNode->rightNode = FactData(theEnv)->CurrentDeftemplate->patternNetwork;
     if (FactData(theEnv)->CurrentDeftemplate->patternNetwork != NULL)
       { FactData(theEnv)->CurrentDeftemplate->patternNetwork->leftNode = newNode; }
  
     FactData(theEnv)->CurrentDeftemplate->patternNetwork = newNode;
     return(newNode);
    }
  
  /*************************************************************/
  /* DetachFactPattern: Removes a pattern node and all of its  */
  /*   parent nodes from the pattern network. Nodes are only   */
  /*   removed if they are no longer shared (i.e. a pattern    */
  /*   node that has more than one child node is shared). A    */
  /*   pattern from a rule is typically removed by removing    */
  /*   the bottom most pattern node used by the pattern and    */
  /*   then removing any parent nodes which are not shared by  */
  /*   other patterns.                                         */
  /*                                                           */
  /*   Example:                                                */
  /*     Patterns (a b c d) and (a b e f) would be represented */
  /*     by the pattern net shown on the left.  If (a b c d)   */
  /*     was detached, the resultant pattern net would be the  */
  /*     one shown on the right.                               */
  /*                                                           */
  /*           a                  a                            */
  /*           |                  |                            */
  /*           b                  b                            */
  /*           |                  |                            */
  /*           c--e               e                            */
  /*           |  |               |                            */
  /*           d  f               f                            */
  /*                                                           */
  /*************************************************************/
  static void DetachFactPattern(
    Environment *theEnv,
    struct patternNodeHeader *thePattern)
    {
     struct factPatternNode *patternPtr;
     struct factPatternNode *upperLevel;
  
     /*=====================================================*/
     /* Get rid of any matches stored in the alpha memory.  */
     /*=====================================================*/
  
     patternPtr = (struct factPatternNode *) thePattern;
     ClearPatternMatches(theEnv,patternPtr);
  
     /*=======================================================*/
     /* If there are no joins entered from this pattern, then */
     /* the pattern node is no longer a stop node. Also if    */
     /* the pattern has a next level pointer, then it can     */
     /* not be removed since other patterns make use of it.   */
     /*=======================================================*/
  
     if (patternPtr->header.entryJoin == NULL) patternPtr->header.stopNode = false;
     if (patternPtr->nextLevel != NULL) return;
  
     /*==============================================================*/
     /* Loop until all appropriate pattern nodes have been detached. */
     /*==============================================================*/
  
     upperLevel = patternPtr;
     while (upperLevel != NULL)
       {
        if ((upperLevel->leftNode == NULL) &&
            (upperLevel->rightNode == NULL))
          {
           /*===============================================*/
           /* Pattern node is the only node on this level.  */
           /* Remove it and continue detaching other nodes  */
           /* above this one, because no other patterns are */
           /* dependent upon this node.                     */
           /*===============================================*/
  
           patternPtr = upperLevel;
           upperLevel = patternPtr->lastLevel;
  
           if (upperLevel == NULL)
             { FindAndSetDeftemplatePatternNetwork(theEnv,patternPtr,NULL); }
           else
             {
              if (upperLevel->header.selector)
                { RemoveHashedPatternNode(theEnv,upperLevel,patternPtr,patternPtr->networkTest->type,patternPtr->networkTest->value); }
  
              upperLevel->nextLevel = NULL;
              if (upperLevel->header.stopNode) upperLevel = NULL;
             }
  
           RemoveHashedExpression(theEnv,patternPtr->networkTest);
           RemoveHashedExpression(theEnv,patternPtr->header.rightHash);
           rtn_struct(theEnv,factPatternNode,patternPtr);
          }
        else if (upperLevel->leftNode != NULL)
          {
           /*====================================================*/
           /* Pattern node has another pattern node which must   */
           /* be checked preceding it.  Remove the pattern node, */
           /* but do not detach any nodes above this one.        */
           /*====================================================*/
  
           patternPtr = upperLevel;
  
           if ((patternPtr->lastLevel != NULL) &&
               (patternPtr->lastLevel->header.selector))
             { RemoveHashedPatternNode(theEnv,patternPtr->lastLevel,patternPtr,patternPtr->networkTest->type,patternPtr->networkTest->value); }
  
           upperLevel->leftNode->rightNode = upperLevel->rightNode;
           if (upperLevel->rightNode != NULL)
             { upperLevel->rightNode->leftNode = upperLevel->leftNode; }
  
           RemoveHashedExpression(theEnv,patternPtr->networkTest);
           RemoveHashedExpression(theEnv,patternPtr->header.rightHash);
           rtn_struct(theEnv,factPatternNode,patternPtr);
           upperLevel = NULL;
          }
        else
          {
           /*====================================================*/
           /* Pattern node has no pattern node preceding it, but */
           /* does have one succeeding it. Remove the pattern    */
           /* node, but do not detach any nodes above this one.  */
           /*====================================================*/
  
           patternPtr = upperLevel;
           upperLevel = upperLevel->lastLevel;
           if (upperLevel == NULL)
             { FindAndSetDeftemplatePatternNetwork(theEnv,patternPtr,patternPtr->rightNode); }
           else
             {
             if (upperLevel->header.selector)
                { RemoveHashedPatternNode(theEnv,upperLevel,patternPtr,patternPtr->networkTest->type,patternPtr->networkTest->value); }
  
              upperLevel->nextLevel = patternPtr->rightNode;
             }
           patternPtr->rightNode->leftNode = NULL;
  
           RemoveHashedExpression(theEnv,patternPtr->networkTest);
           RemoveHashedExpression(theEnv,patternPtr->header.rightHash);
           rtn_struct(theEnv,factPatternNode,patternPtr);
           upperLevel = NULL;
          }
       }
    }
  
  #endif
  
  /**************************************************************/
  /* DestroyFactPatternNetwork: Deallocates the data structures */
  /*   associated with a fact pattern network.                  */
  /**************************************************************/
  void DestroyFactPatternNetwork(
    Environment *theEnv,
    struct factPatternNode *thePattern)
    {
     struct factPatternNode *patternPtr;
  
     if (thePattern == NULL) return;
  
     while (thePattern != NULL)
       {
        patternPtr = thePattern->rightNode;
  
        DestroyFactPatternNetwork(theEnv,thePattern->nextLevel);
  
        DestroyAlphaMemory(theEnv,&thePattern->header,false);
  
        if ((thePattern->lastLevel != NULL) &&
            (thePattern->lastLevel->header.selector))
          { RemoveHashedPatternNode(theEnv,thePattern->lastLevel,thePattern,thePattern->networkTest->type,thePattern->networkTest->value); }
  
  #if (! BLOAD_ONLY) && (! RUN_TIME)
        rtn_struct(theEnv,factPatternNode,thePattern);
  #endif
  
        thePattern = patternPtr;
       }
    }
  
  #if (! RUN_TIME) && (! BLOAD_ONLY)
  
  /***********************************************************/
  /* FindAndSetDeftemplatePatternNetwork: When a deftemplate */
  /*   pattern is detached from the fact pattern network, it */
  /*   is not possible to directly detach the link from the  */
  /*   deftemplate to the pattern network (it is a one way   */
  /*   link). Therefore if the top most pointer to a         */
  /*   deftemplates pattern network must be changed, it is   */
  /*   necessary to search the list of deftemplates to find  */
  /*   the appropriate one to modify.                        */
  /***********************************************************/
  static void FindAndSetDeftemplatePatternNetwork(
    Environment *theEnv,
    struct factPatternNode *rootNode,
    struct factPatternNode *newRootNode)
    {
     Deftemplate *theDeftemplate;
     Defmodule *theModule;
  
     /*=======================================================*/
     /* Save the current module since we will be changing it. */
     /*=======================================================*/
  
     SaveCurrentModule(theEnv);
  
     /*=======================================================*/
     /* Loop through every module looking for the deftemplate */
     /* associated with the specified root node.              */
     /*=======================================================*/
  
     for (theModule = GetNextDefmodule(theEnv,NULL);
          theModule != NULL;
          theModule = GetNextDefmodule(theEnv,theModule))
       {
        /*======================================================*/
        /* Set the current module to the module being examined. */
        /*======================================================*/
  
        SetCurrentModule(theEnv,theModule);
  
        /*======================================================*/
        /* Loop through every deftemplate in the current module */
        /* searching for the deftemplate associated with the    */
        /* specified root node.                                 */
        /*======================================================*/
  
        for (theDeftemplate = GetNextDeftemplate(theEnv,NULL);
             theDeftemplate != NULL;
             theDeftemplate = GetNextDeftemplate(theEnv,theDeftemplate))
          {
           /*===========================================================*/
           /* When the associated deftemplate is found, change its root */
           /* node from the current value to the new value. Restore the */
           /* current module before leaving this routine.               */
           /*===========================================================*/
  
           if (theDeftemplate->patternNetwork == rootNode)
             {
              RestoreCurrentModule(theEnv);
              theDeftemplate->patternNetwork = newRootNode;
              return;
             }
          }
       }
  
     /*========================================================*/
     /* If the deftemplate wasn't found, then we're presumably */
     /* we're in the the middle of a clear and the deftemplate */
     /* has already been deleted so there's no need to update  */
     /* the links to the fact pattern network.                 */
     /*========================================================*/
  
     RestoreCurrentModule(theEnv);
    }
  
  /***************************************************************/
  /* ClearPatternMatches: Clears the fact list of all pointers   */
  /*   which point to a specific pattern.  The pointers are used */
  /*   to remember which patterns were matched by a fact to      */
  /*   make retraction easier.  When a rule is excised, the      */
  /*   pointers need to be removed.                              */
  /***************************************************************/
  static void ClearPatternMatches(
    Environment *theEnv,
    struct factPatternNode *patternPtr)
    {
     Fact *theFact;
     struct patternMatch *lastMatch, *theMatch;
  
     /*===========================================*/
     /* Loop through every fact in the fact list. */
     /*===========================================*/
  
     for (theFact = GetNextFact(theEnv,NULL);
          theFact != NULL;
          theFact = GetNextFact(theEnv,theFact))
       {
        /*========================================*/
        /* Loop through every match for the fact. */
        /*========================================*/
  
        lastMatch = NULL;
        theMatch = (struct patternMatch *) theFact->list;
  
        while (theMatch != NULL)
          {
           /*================================================*/
           /* If the match is for the pattern being deleted, */
           /* then remove the match.                         */
           /*================================================*/
  
           if (theMatch->matchingPattern == (struct patternNodeHeader *) patternPtr)
             {
              if (lastMatch == NULL)
                {
                 /*=====================================*/
                 /* Remove the first match of the fact. */
                 /*=====================================*/
  
                 theFact->list = theMatch->next;
                 rtn_struct(theEnv,patternMatch,theMatch);
                 theMatch = (struct patternMatch *) theFact->list;
                }
              else
               {
                 /*===================================*/
                 /* Remove a match for the fact which */
                 /* follows the first match.          */
                 /*===================================*/
  
                lastMatch->next = theMatch->next;
                rtn_struct(theEnv,patternMatch,theMatch);
                theMatch = lastMatch->next;
               }
             }
  
           /*====================================================*/
           /* If the match is not for the pattern being deleted, */
           /* then move on to the next match for the fact.       */
           /*====================================================*/
  
           else
            {
             lastMatch = theMatch;
             theMatch = theMatch->next;
            }
         }
      }
    }
  
  #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */
  
  #endif /* DEFTEMPLATE_CONSTRUCT && DEFRULE_CONSTRUCT */
  
  
  
  