text:    /*******************************************************/
     /*      "C" Language Integrated Production System      */
     /*                                                     */
     /*               CLIPS Version 6.24  07/01/05          */
     /*                                                     */
     /*                                                     */
     /*******************************************************/
  
  /*************************************************************/
  /* Purpose: Query Functions for Objects                      */
  /*                                                           */
  /* Principal Programmer(s):                                  */
  /*      Brian L. Dantes                                      */
  /*                                                           */
  /* Contributing Programmer(s):                               */
  /*      Gary D. Riley                                        */
  /*                                                           */
  /* Revision History:                                         */
  /*                                                           */
  /*      6.23: Added fact-set queries.                        */
  /*                                                           */
  /*      6.24: Corrected errors when compiling as a C++ file. */
  /*            DR0868                                         */
  /*                                                           */
  /*            Renamed BOOLEAN macro type to intBool.         */
  /*                                                           */
  /*************************************************************/
  
  /* =========================================
     *****************************************
                 EXTERNAL DEFINITIONS
     =========================================
     ***************************************** */
  #include "setup.h"
  
  #if FACT_SET_QUERIES
  
  #include "argacces.h"
  #include "envrnmnt.h"
  #include "memalloc.h"
  #include "exprnpsr.h"
  #include "modulutl.h"
  #include "tmpltutl.h"
  #include "insfun.h"
  #include "factqpsr.h"
  #include "prcdrfun.h"
  #include "router.h"
  #include "utility.h"
  
  #define _FACTQURY_SOURCE_
  #include "factqury.h"
  
  /* =========================================
     *****************************************
        INTERNALLY VISIBLE FUNCTION HEADERS
     =========================================
     ***************************************** */
  
  static void PushQueryCore(void *);
  static void PopQueryCore(void *);
  static QUERY_CORE *FindQueryCore(void *,int);
  static QUERY_TEMPLATE *DetermineQueryTemplates(void *,EXPRESSION *,char *,unsigned *);
  static QUERY_TEMPLATE *FormChain(void *,char *,DATA_OBJECT *);
  static void DeleteQueryTemplates(void *,QUERY_TEMPLATE *);
  static int TestForFirstInChain(void *,QUERY_TEMPLATE *,int);
  static int TestForFirstFactInTemplate(void *,struct deftemplate *,QUERY_TEMPLATE *,int);
  static void TestEntireChain(void *,QUERY_TEMPLATE *,int);
  static void TestEntireTemplate(void *,struct deftemplate *,QUERY_TEMPLATE *,int);
  static void AddSolution(void *);
  static void PopQuerySoln(void *);
  
  /****************************************************
    NAME         : SetupFactQuery
    DESCRIPTION  : Initializes fact query H/L
                     functions and parsers
    INPUTS       : None
    RETURNS      : Nothing useful
    SIDE EFFECTS : Sets up kernel functions and parsers
    NOTES        : None
   ****************************************************/
  globle void SetupFactQuery(
    void *theEnv)
    {
     AllocateEnvironmentData(theEnv,FACT_QUERY_DATA,sizeof(struct factQueryData),NULL);
  
  #if RUN_TIME                                                 
     FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMETER_STRING);
  #endif  
  
  #if ! RUN_TIME
     FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,QUERY_DELIMETER_STRING);
     IncrementSymbolCount(FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL);
  
     EnvDefineFunction2(theEnv,(char*)"(query-fact)",'u',
                    PTIEF GetQueryFact,(char*)"GetQueryFact",NULL);
  
     EnvDefineFunction2(theEnv,(char*)"(query-fact-slot)",'u',
                    PTIEF GetQueryFactSlot,(char*)"GetQueryFactSlot",NULL);
  
     EnvDefineFunction2(theEnv,(char*)"any-factp",'b',PTIEF AnyFacts,(char*)"AnyFacts",NULL);
     AddFunctionParser(theEnv,(char*)"any-factp",FactParseQueryNoAction);
  
     EnvDefineFunction2(theEnv,(char*)"find-fact",'m',
                    PTIEF QueryFindFact,(char*)"QueryFindFact",NULL);
     AddFunctionParser(theEnv,(char*)"find-fact",FactParseQueryNoAction);
  
     EnvDefineFunction2(theEnv,(char*)"find-all-facts",'m',
                    PTIEF QueryFindAllFacts,(char*)"QueryFindAllFacts",NULL);
     AddFunctionParser(theEnv,(char*)"find-all-facts",FactParseQueryNoAction);
  
     EnvDefineFunction2(theEnv,(char*)"do-for-fact",'u',
                    PTIEF QueryDoForFact,(char*)"QueryDoForFact",NULL);
     AddFunctionParser(theEnv,(char*)"do-for-fact",FactParseQueryAction);
  
     EnvDefineFunction2(theEnv,(char*)"do-for-all-facts",'u',
                    PTIEF QueryDoForAllFacts,(char*)"QueryDoForAllFacts",NULL);
     AddFunctionParser(theEnv,(char*)"do-for-all-facts",FactParseQueryAction);
  
     EnvDefineFunction2(theEnv,(char*)"delayed-do-for-all-facts",'u',
                    PTIEF DelayedQueryDoForAllFacts,
                    "DelayedQueryDoForAllFacts",NULL);
     AddFunctionParser(theEnv,(char*)"delayed-do-for-all-facts",FactParseQueryAction);
  #endif
    }
  
  /*************************************************************
    NAME         : GetQueryFact
    DESCRIPTION  : Internal function for referring to fact
                      array on fact-queries
    INPUTS       : None
    RETURNS      : The name of the specified fact-set member
    SIDE EFFECTS : None
    NOTES        : H/L Syntax : ((query-fact) <index>)
   *************************************************************/
  globle void GetQueryFact(
    void *theEnv,
    DATA_OBJECT *result)
    {
     register QUERY_CORE *core;
  
     core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument())));
     
     result->type = FACT_ADDRESS;
     result->value = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))];
    }
  
  /***************************************************************************
    NAME         : GetQueryFactSlot
    DESCRIPTION  : Internal function for referring to slots of fact in
                      fact array on fact-queries
    INPUTS       : The caller's result buffer
    RETURNS      : Nothing useful
    SIDE EFFECTS : Caller's result buffer set appropriately
    NOTES        : H/L Syntax : ((query-fact-slot) <index> <slot-name>)
   **************************************************************************/
  globle void GetQueryFactSlot(
    void *theEnv,
    DATA_OBJECT *result)
    {
     struct fact *theFact;
     DATA_OBJECT temp;
     QUERY_CORE *core;
     short position;
  
     result->type = SYMBOL;
     result->value = EnvFalseSymbol(theEnv);
  
     core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument())));
     theFact = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))];
     EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp);
     if (temp.type != SYMBOL)
       {
        ExpectedTypeError1(theEnv,(char*)"get",1,(char*)"symbol");
        SetEvaluationError(theEnv,TRUE);
        return;
       }
       
     /*==================================================*/
     /* Make sure the slot exists (the symbol implied is */
     /* used for the implied slot of an ordered fact).   */
     /*==================================================*/
  
     if (theFact->whichDeftemplate->implied)
       {
        if (strcmp(ValueToString(temp.value),(char*)"implied") != 0)
          {
           SlotExistError(theEnv,ValueToString(temp.value),(char*)"fact-set query");
           return;
          }
        position = 1;
       }
  
     else if (FindSlot((struct deftemplate *) theFact->whichDeftemplate,
                       (struct symbolHashNode *) temp.value,&position) == NULL)
       {
        SlotExistError(theEnv,ValueToString(temp.value),(char*)"fact-set query");
        return;
       }
       
     result->type = theFact->theProposition.theFields[position-1].type;
     result->value = theFact->theProposition.theFields[position-1].value;
     if (result->type == MULTIFIELD)
       {
        SetpDOBegin(result,1);
        SetpDOEnd(result,((struct multifield *) result->value)->multifieldLength);
       }
    }
  
  /* =============================================================================
     =============================================================================
     Following are the instance query functions :
  
       any-factp         : Determines if any facts satisfy the query
       find-fact         : Finds first (set of) fact(s) which satisfies
                                 the query and stores it in a multi-field
       find-all-facts    : Finds all (sets of) facts which satisfy the
                                 the query and stores them in a multi-field
       do-for-fact       : Executes a given action for the first (set of)
                                 fact(s) which satisfy the query
       do-for-all-facts  : Executes an action for all facts which satisfy
                                 the query as they are found
       delayed-do-for-all-facts : Same as above - except that the list of facts
                                 which satisfy the query is formed before any
                                 actions are executed
  
       Fact candidate search algorithm :
  
       All permutations of first restriction template facts with other
         restriction template facts (Rightmost are varied first)
  
       For any one template, fact are examined in the order they were defined
  
       Example :
       (deftemplate a (slot v))
       (deftemplate b (slot v))
       (deftemplate c (slot v))
       (assert (a (v a1)))
       (assert (a (v a2)))
       (assert (b (v b1)))
       (assert (b (v b2)))
       (assert (c (v c1)))
       (assert (c (v c2)))
       (assert (d (v d1)))
       (assert (d (v d2)))
  
       (any-factp ((?a a b) (?b c)) <query>)
  
       The permutations (?a ?b) would be examined in the following order :
  
       (a1 c1),(a1 c2),(a2 c1),(a2 c2),
       (b1 c1),(b1 c2),(b2 c1),(b2 c2)
  
     =============================================================================
     ============================================================================= */
  
  /******************************************************************************
    NAME         : AnyFacts
    DESCRIPTION  : Determines if there any existing facts which satisfy
                     the query
    INPUTS       : None
    RETURNS      : TRUE if the query is satisfied, FALSE otherwise
    SIDE EFFECTS : The query template-expressions are evaluated once,
                     and the query boolean-expression is evaluated
                     zero or more times (depending on fact restrictions
                     and how early the expression evaluates to TRUE - if at all).
    NOTES        : H/L Syntax : See FactParseQueryNoAction()
   ******************************************************************************/
  globle intBool AnyFacts(
    void *theEnv)
    {
     QUERY_TEMPLATE *qtemplates;
     unsigned rcnt;
     int TestResult;
  
     qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg,
                                        "any-factp",&rcnt);
     if (qtemplates == NULL)
       return(FALSE);
     PushQueryCore(theEnv);
     FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
     FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
     FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
     TestResult = TestForFirstInChain(theEnv,qtemplates,0);
     FactQueryData(theEnv)->AbortQuery = FALSE;
     rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
     rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
     PopQueryCore(theEnv);
     DeleteQueryTemplates(theEnv,qtemplates);
     return(TestResult);
    }
  
  /******************************************************************************
    NAME         : QueryFindFact
    DESCRIPTION  : Finds the first set of facts which satisfy the query and
                     stores their addresses in the user's multi-field variable
    INPUTS       : Caller's result buffer
    RETURNS      : TRUE if the query is satisfied, FALSE otherwise
    SIDE EFFECTS : The query template-expressions are evaluated once,
                     and the query boolean-expression is evaluated
                     zero or more times (depending on fact restrictions
                     and how early the expression evaulates to TRUE - if at all).
    NOTES        : H/L Syntax : See ParseQueryNoAction()
   ******************************************************************************/
  globle void QueryFindFact(
    void *theEnv,
    DATA_OBJECT *result)
    {
     QUERY_TEMPLATE *qtemplates;
     unsigned rcnt,i;
  
     result->type = MULTIFIELD;
     result->begin = 0;
     result->end = -1;
     qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg,
                                        "find-fact",&rcnt);
     if (qtemplates == NULL)
       {
        result->value = (void *) EnvCreateMultifield(theEnv,0L);
        return;
       }
     PushQueryCore(theEnv);
     FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
     FactQueryData(theEnv)->QueryCore->solns = (struct fact **)
                        gm2(theEnv,(sizeof(struct fact *) * rcnt));
     FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
     if (TestForFirstInChain(theEnv,qtemplates,0) == TRUE)
       {
        result->value = (void *) EnvCreateMultifield(theEnv,rcnt);
        SetpDOEnd(result,rcnt);
        for (i = 1 ; i <= rcnt ; i++)
          {
           SetMFType(result->value,i,FACT_ADDRESS);
           SetMFValue(result->value,i,FactQueryData(theEnv)->QueryCore->solns[i - 1]);
          }
       }
     else
        result->value = (void *) EnvCreateMultifield(theEnv,0L);
     FactQueryData(theEnv)->AbortQuery = FALSE;
     rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
     rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
     PopQueryCore(theEnv);
     DeleteQueryTemplates(theEnv,qtemplates);
    }
  
  /******************************************************************************
    NAME         : QueryFindAllFacts
    DESCRIPTION  : Finds all sets of facts which satisfy the query and
                     stores their names in the user's multi-field variable
  
                   The sets are stored sequentially :
  
                     Number of sets = (Multi-field length) / (Set length)
  
                   The first set is if the first (set length) atoms of the
                     multi-field variable, and so on.
    INPUTS       : Caller's result buffer
    RETURNS      : Nothing useful
    SIDE EFFECTS : The query template-expressions are evaluated once,
                     and the query boolean-expression is evaluated
                     once for every fact set.
    NOTES        : H/L Syntax : See ParseQueryNoAction()
   ******************************************************************************/
  globle void QueryFindAllFacts(
    void *theEnv,
    DATA_OBJECT *result)
    {
     QUERY_TEMPLATE *qtemplates;
     unsigned rcnt;
     register unsigned i,j;
  
     result->type = MULTIFIELD;
     result->begin = 0;
     result->end = -1;
     qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg,
                                        "find-all-facts",&rcnt);
     if (qtemplates == NULL)
       {
        result->value = (void *) EnvCreateMultifield(theEnv,0L);
        return;
       }
     PushQueryCore(theEnv);
     FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
     FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
     FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
     FactQueryData(theEnv)->QueryCore->action = NULL;
     FactQueryData(theEnv)->QueryCore->soln_set = NULL;
     FactQueryData(theEnv)->QueryCore->soln_size = rcnt;
     FactQueryData(theEnv)->QueryCore->soln_cnt = 0;
     TestEntireChain(theEnv,qtemplates,0);
     FactQueryData(theEnv)->AbortQuery = FALSE;
     result->value = (void *) EnvCreateMultifield(theEnv,FactQueryData(theEnv)->QueryCore->soln_cnt * rcnt);
     while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
       {
        for (i = 0 , j = (unsigned) (result->end + 2) ; i < rcnt ; i++ , j++)
          {
           SetMFType(result->value,j,FACT_ADDRESS);
           SetMFValue(result->value,j,FactQueryData(theEnv)->QueryCore->soln_set->soln[i]);
          }
        result->end = (long) j-2;
        PopQuerySoln(theEnv);
       }
     rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
     rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
     PopQueryCore(theEnv);
     DeleteQueryTemplates(theEnv,qtemplates);
    }
  
  /******************************************************************************
    NAME         : QueryDoForFact
    DESCRIPTION  : Finds the first set of facts which satisfy the query and
                     executes a user-action with that set
    INPUTS       : None
    RETURNS      : Caller's result buffer
    SIDE EFFECTS : The query template-expressions are evaluated once,
                     and the query boolean-expression is evaluated
                     zero or more times (depending on fact restrictions
                     and how early the expression evaulates to TRUE - if at all).
                     Also the action expression is executed zero or once.
                   Caller's result buffer holds result of user-action
    NOTES        : H/L Syntax : See ParseQueryAction()
   ******************************************************************************/
  globle void QueryDoForFact(
    void *theEnv,
    DATA_OBJECT *result)
    {
     QUERY_TEMPLATE *qtemplates;
     unsigned rcnt;
  
     result->type = SYMBOL;
     result->value = EnvFalseSymbol(theEnv);
     qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
                                        "do-for-fact",&rcnt);
     if (qtemplates == NULL)
       return;
     PushQueryCore(theEnv);
     FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
     FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
     FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
     FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
     if (TestForFirstInChain(theEnv,qtemplates,0) == TRUE)
       EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result);
     FactQueryData(theEnv)->AbortQuery = FALSE;
     ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
     rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
     rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
     PopQueryCore(theEnv);
     DeleteQueryTemplates(theEnv,qtemplates);
    }
  
  /******************************************************************************
    NAME         : QueryDoForAllFacts
    DESCRIPTION  : Finds all sets of facts which satisfy the query and
                     executes a user-function for each set as it is found
    INPUTS       : Caller's result buffer
    RETURNS      : Nothing useful
    SIDE EFFECTS : The query template-expressions are evaluated once,
                     and the query boolean-expression is evaluated
                     once for every fact set.  Also, the action is
                     executed for every fact set.
                   Caller's result buffer holds result of last action executed.
    NOTES        : H/L Syntax : See FactParseQueryAction()
   ******************************************************************************/
  globle void QueryDoForAllFacts(
    void *theEnv,
    DATA_OBJECT *result)
    {
     QUERY_TEMPLATE *qtemplates;
     unsigned rcnt;
  
     result->type = SYMBOL;
     result->value = EnvFalseSymbol(theEnv);
     qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
                                        "do-for-all-facts",&rcnt);
     if (qtemplates == NULL)
       return;
     PushQueryCore(theEnv);
     FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
     FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
     FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
     FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
     FactQueryData(theEnv)->QueryCore->result = result;
     ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
     TestEntireChain(theEnv,qtemplates,0);
     ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
     PropagateReturnValue(theEnv,FactQueryData(theEnv)->QueryCore->result);
     FactQueryData(theEnv)->AbortQuery = FALSE;
     ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
     rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
     rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
     PopQueryCore(theEnv);
     DeleteQueryTemplates(theEnv,qtemplates);
    }
  
  /******************************************************************************
    NAME         : DelayedQueryDoForAllFacts
    DESCRIPTION  : Finds all sets of facts which satisfy the query and
                     and exceutes a user-action for each set
  
                   This function differs from QueryDoForAllFacts() in
                     that it forms the complete list of query satisfactions
                     BEFORE executing any actions.
    INPUTS       : Caller's result buffer
    RETURNS      : Nothing useful
    SIDE EFFECTS : The query template-expressions are evaluated once,
                     and the query boolean-expression is evaluated
                     once for every fact set.  The action is executed
                     for evry query satisfaction.
                   Caller's result buffer holds result of last action executed.
    NOTES        : H/L Syntax : See FactParseQueryNoAction()
   ******************************************************************************/
  globle void DelayedQueryDoForAllFacts(
    void *theEnv,
    DATA_OBJECT *result)
    {
     QUERY_TEMPLATE *qtemplates;
     unsigned rcnt;
     register unsigned i;
  
     result->type = SYMBOL;
     result->value = EnvFalseSymbol(theEnv);
     qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
                                        "delayed-do-for-all-facts",&rcnt);
     if (qtemplates == NULL)
       return;
     PushQueryCore(theEnv);
     FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
     FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
     FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
     FactQueryData(theEnv)->QueryCore->action = NULL;
     FactQueryData(theEnv)->QueryCore->soln_set = NULL;
     FactQueryData(theEnv)->QueryCore->soln_size = rcnt;
     FactQueryData(theEnv)->QueryCore->soln_cnt = 0;
     TestEntireChain(theEnv,qtemplates,0);
     FactQueryData(theEnv)->AbortQuery = FALSE;
     FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
     while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
       {
        for (i = 0 ; i < rcnt ; i++)
          FactQueryData(theEnv)->QueryCore->solns[i] = FactQueryData(theEnv)->QueryCore->soln_set->soln[i];
        PopQuerySoln(theEnv);
        EvaluationData(theEnv)->CurrentEvaluationDepth++;
        EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result);
        EvaluationData(theEnv)->CurrentEvaluationDepth--;
        if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)
          { PropagateReturnValue(theEnv,result); }
        PeriodicCleanup(theEnv,FALSE,TRUE);
        if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
          {
           while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
             PopQuerySoln(theEnv);
           break;
          }
       }
     ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
     rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
     rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
     PopQueryCore(theEnv);
     DeleteQueryTemplates(theEnv,qtemplates);
    }
  
  /* =========================================
     *****************************************
            INTERNALLY VISIBLE FUNCTIONS
     =========================================
     ***************************************** */
  
  /*******************************************************
    NAME         : PushQueryCore
    DESCRIPTION  : Pushes the current QueryCore onto stack
    INPUTS       : None
    RETURNS      : Nothing useful
    SIDE EFFECTS : Allocates new stack node and changes
                     QueryCoreStack
    NOTES        : None
   *******************************************************/
  static void PushQueryCore(
    void *theEnv)
    {
     QUERY_STACK *qptr;
  
     qptr = get_struct(theEnv,query_stack);
     qptr->core = FactQueryData(theEnv)->QueryCore;
     qptr->nxt = FactQueryData(theEnv)->QueryCoreStack;
     FactQueryData(theEnv)->QueryCoreStack = qptr;
    }
  
  /******************************************************
    NAME         : PopQueryCore
    DESCRIPTION  : Pops top of QueryCore stack and
                     restores QueryCore to this core
    INPUTS       : None
    RETURNS      : Nothing useful
    SIDE EFFECTS : Stack node deallocated, QueryCoreStack
                     changed and QueryCore reset
    NOTES        : Assumes stack is not empty
   ******************************************************/
  static void PopQueryCore(
    void *theEnv)
    {
     QUERY_STACK *qptr;
  
     FactQueryData(theEnv)->QueryCore = FactQueryData(theEnv)->QueryCoreStack->core;
     qptr = FactQueryData(theEnv)->QueryCoreStack;
     FactQueryData(theEnv)->QueryCoreStack = FactQueryData(theEnv)->QueryCoreStack->nxt;
     rtn_struct(theEnv,query_stack,qptr);
    }
  
  /***************************************************
    NAME         : FindQueryCore
    DESCRIPTION  : Looks up a QueryCore Stack Frame
                      Depth 0 is current frame
                      1 is next deepest, etc.
    INPUTS       : Depth
    RETURNS      : Address of query core stack frame
    SIDE EFFECTS : None
    NOTES        : None
   ***************************************************/
  static QUERY_CORE *FindQueryCore(
    void *theEnv,
    int depth)
    {
     QUERY_STACK *qptr;
  
     if (depth == 0)
       return(FactQueryData(theEnv)->QueryCore);
     qptr = FactQueryData(theEnv)->QueryCoreStack;
     while (depth > 1)
       {
        qptr = qptr->nxt;
        depth--;
       }
     return(qptr->core);
    }
  
  /**********************************************************
    NAME         : DetermineQueryTemplates
    DESCRIPTION  : Builds a list of templates to be used in
                     fact queries - uses parse form.
    INPUTS       : 1) The parse template expression chain
                   2) The name of the function being executed
                   3) Caller's buffer for restriction count
                      (# of separate lists)
    RETURNS      : The query list, or NULL on errors
    SIDE EFFECTS : Memory allocated for list
                   Busy count incremented for all templates
    NOTES        : Each restriction is linked by nxt pointer,
                     multiple templates in a restriction are
                     linked by the chain pointer.
                   Rcnt caller's buffer is set to reflect the
                     total number of chains
                   Assumes classExp is not NULL and that each
                     restriction chain is terminated with
                     the QUERY_DELIMITER_SYMBOL "(QDS)"
   **********************************************************/
  static QUERY_TEMPLATE *DetermineQueryTemplates(
    void *theEnv,
    EXPRESSION *templateExp,
    char *func,
    unsigned *rcnt)
    {
     QUERY_TEMPLATE *clist = NULL,*cnxt = NULL,*cchain = NULL,*tmp;
     int new_list = FALSE;
     DATA_OBJECT temp;
  
     *rcnt = 0;
     while (templateExp != NULL)
       {
        if (EvaluateExpression(theEnv,templateExp,&temp))
          {
           DeleteQueryTemplates(theEnv,clist);
           return(NULL);
          }
        if ((temp.type == SYMBOL) && (temp.value == (void *) FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL))
          {
           new_list = TRUE;
           (*rcnt)++;
          }
        else if ((tmp = FormChain(theEnv,func,&temp)) != NULL)
          {
           if (clist == NULL)
             clist = cnxt = cchain = tmp;
           else if (new_list == TRUE)
             {
              new_list = FALSE;
              cnxt->nxt = tmp;
              cnxt = cchain = tmp;
             }
           else
             cchain->chain = tmp;
           while (cchain->chain != NULL)
             cchain = cchain->chain;
          }
        else
          {
           SyntaxErrorMessage(theEnv,(char*)"fact-set query class restrictions");
           DeleteQueryTemplates(theEnv,clist);
           SetEvaluationError(theEnv,TRUE);
           return(NULL);
          }
        templateExp = templateExp->nextArg;
       }
     return(clist);
    }
  
  /*************************************************************
    NAME         : FormChain
    DESCRIPTION  : Builds a list of classes to be used in
                     fact queries - uses parse form.
    INPUTS       : 1) Name of calling function for error msgs
                   2) Data object - must be a symbol or a
                        multifield value containing all symbols
                   The symbols must be names of existing templates
    RETURNS      : The query chain, or NULL on errors
    SIDE EFFECTS : Memory allocated for chain
                   Busy count incremented for all templates
    NOTES        : None
   *************************************************************/
  static QUERY_TEMPLATE *FormChain(
    void *theEnv,
    char *func,
    DATA_OBJECT *val)
    {
     struct deftemplate *templatePtr;
     QUERY_TEMPLATE *head,*bot,*tmp;
     register long i,end; /* 6.04 Bug Fix */
     char *templateName;
     int count;
  
     if (val->type == DEFTEMPLATE_PTR)
       {
        IncrementDeftemplateBusyCount(theEnv,(void *) val->value);
        head = get_struct(theEnv,query_template);
        head->templatePtr = (struct deftemplate *) val->value;
  
        head->chain = NULL;
        head->nxt = NULL;
        return(head);
       }
     if (val->type == SYMBOL)
       {
        /* ===============================================
           Allow instance-set query restrictions to have a
           module specifier as part of the class name,
           but search imported defclasses too if a
           module specifier is not given
           =============================================== */
           
        templatePtr = (struct deftemplate *)
                         FindImportedConstruct(theEnv,(char*)"deftemplate",NULL,DOPToString(val),
                                               &count,TRUE,NULL);
        if (templatePtr == NULL)
          {
           CantFindItemInFunctionErrorMessage(theEnv,(char*)"deftemplate",DOPToString(val),func);
           return(NULL);
          }
        IncrementDeftemplateBusyCount(theEnv,(void *) templatePtr);
        head = get_struct(theEnv,query_template);
        head->templatePtr = templatePtr;
  
        head->chain = NULL;
        head->nxt = NULL;
        return(head);
       }
     if (val->type == MULTIFIELD)
       {
        head = bot = NULL;
        end = GetpDOEnd(val);
        for (i = GetpDOBegin(val) ; i <= end ; i++)
          {
           if (GetMFType(val->value,i) == SYMBOL)
             {
              templateName = ValueToString(GetMFValue(val->value,i));
              
              templatePtr = (struct deftemplate *)
                         FindImportedConstruct(theEnv,(char*)"deftemplate",NULL,templateName,
                                               &count,TRUE,NULL);
  
              if (templatePtr == NULL)
                {
                 CantFindItemInFunctionErrorMessage(theEnv,(char*)"deftemplate",templateName,func);
                 DeleteQueryTemplates(theEnv,head);
                 return(NULL);
                }
             }
           else
             {
              DeleteQueryTemplates(theEnv,head);
              return(NULL);
             }
           IncrementDeftemplateBusyCount(theEnv,(void *) templatePtr);
           tmp = get_struct(theEnv,query_template);
           tmp->templatePtr = templatePtr;
  
           tmp->chain = NULL;
           tmp->nxt = NULL;
           if (head == NULL)
             head = tmp;
           else
             bot->chain = tmp;
           bot = tmp;
          }
        return(head);
       }
     return(NULL);
    }
  
  /******************************************************
    NAME         : DeleteQueryTemplates
    DESCRIPTION  : Deletes a query class-list
    INPUTS       : The query list address
    RETURNS      : Nothing useful
    SIDE EFFECTS : Nodes deallocated
                   Busy count decremented for all templates
    NOTES        : None
   ******************************************************/
  static void DeleteQueryTemplates(
    void *theEnv,
    QUERY_TEMPLATE *qlist)
    {
     QUERY_TEMPLATE *tmp;
  
     while (qlist != NULL)
       {
        while (qlist->chain != NULL)
          {
           tmp = qlist->chain;
           qlist->chain = qlist->chain->chain;
           DecrementDeftemplateBusyCount(theEnv,(void *) tmp->templatePtr);
           rtn_struct(theEnv,query_template,tmp);
          }
        tmp = qlist;
        qlist = qlist->nxt;
        DecrementDeftemplateBusyCount(theEnv,(void *) tmp->templatePtr);
        rtn_struct(theEnv,query_template,tmp);
       }
    }
  
  /************************************************************
    NAME         : TestForFirstInChain
    DESCRIPTION  : Processes all templates in a restriction chain
                     until success or done
    INPUTS       : 1) The current chain
                   2) The index of the chain restriction
                       (e.g. the 4th query-variable)
    RETURNS      : TRUE if query succeeds, FALSE otherwise
    SIDE EFFECTS : Sets current restriction class
                   Fact variable values set
    NOTES        : None
   ************************************************************/
  static int TestForFirstInChain(
    void *theEnv,
    QUERY_TEMPLATE *qchain,
    int indx)
    {
     QUERY_TEMPLATE *qptr;
  
     FactQueryData(theEnv)->AbortQuery = TRUE;
     for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain)
       {
        FactQueryData(theEnv)->AbortQuery = FALSE;
  
        if (TestForFirstFactInTemplate(theEnv,qptr->templatePtr,qchain,indx))
          { return(TRUE); }
          
        if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
          return(FALSE);
       }
     return(FALSE);
    }
  
  /*****************************************************************
    NAME         : TestForFirstFactInTemplate
    DESCRIPTION  : Processes all facts in a template
    INPUTS       : 1) Visitation traversal id
                   2) The template
                   3) The current template restriction chain
                   4) The index of the current restriction
    RETURNS      : TRUE if query succeeds, FALSE otherwise
    SIDE EFFECTS : Fact variable values set
    NOTES        : None
   *****************************************************************/
  static int TestForFirstFactInTemplate(
    void *theEnv,
    struct deftemplate *templatePtr,
    QUERY_TEMPLATE *qchain,
    int indx)
    {
     struct fact *theFact;
     DATA_OBJECT temp;
  
     theFact = templatePtr->factList;
     while (theFact != NULL)
       {
        FactQueryData(theEnv)->QueryCore->solns[indx] = theFact;
        if (qchain->nxt != NULL)
          {
           theFact->factHeader.busyCount++;
           if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == TRUE)
             {
              theFact->factHeader.busyCount--;
              break;
             }
           theFact->factHeader.busyCount--;
           if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
             break;
          }
        else
          {
           theFact->factHeader.busyCount++;
           EvaluationData(theEnv)->CurrentEvaluationDepth++;
           EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp);
           EvaluationData(theEnv)->CurrentEvaluationDepth--;
           PeriodicCleanup(theEnv,FALSE,TRUE);
           theFact->factHeader.busyCount--;
           if (EvaluationData(theEnv)->HaltExecution == TRUE)
             break;
           if ((temp.type != SYMBOL) ? TRUE :
               (temp.value != EnvFalseSymbol(theEnv)))
             break;
          }
        theFact = theFact->nextTemplateFact;
        while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE)
          theFact = theFact->nextTemplateFact;
       }
  
     if (theFact != NULL)
       return(((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
               ? FALSE : TRUE);
  
     return(FALSE);
    }
  
  /************************************************************
    NAME         : TestEntireChain
    DESCRIPTION  : Processes all templates in a restriction chain
                     until done
    INPUTS       : 1) The current chain
                   2) The index of the chain restriction
                       (i.e. the 4th query-variable)
    RETURNS      : Nothing useful
    SIDE EFFECTS : Sets current restriction template
                   Query fact variables set
                   Solution sets stored in global list
    NOTES        : None
   ************************************************************/
  static void TestEntireChain(
    void *theEnv,
    QUERY_TEMPLATE *qchain,
    int indx)
    {
     QUERY_TEMPLATE *qptr;
  
     FactQueryData(theEnv)->AbortQuery = TRUE;
     for (qptr = qchain ; qptr != NULL ; qptr = qptr->chain)
       {
        FactQueryData(theEnv)->AbortQuery = FALSE;
  
        TestEntireTemplate(theEnv,qptr->templatePtr,qchain,indx);
  
        if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
          return;
       }
    }
  
  /*****************************************************************
    NAME         : TestEntireTemplate
    DESCRIPTION  : Processes all facts in a template
    INPUTS       : 1) The module for which templates tested must be
                      in scope
                   3) The template
                   4) The current template restriction chain
                   5) The index of the current restriction
    RETURNS      : Nothing useful
    SIDE EFFECTS : Instance variable values set
                   Solution sets stored in global list
    NOTES        : None
   *****************************************************************/
  static void TestEntireTemplate(
    void *theEnv,
    struct deftemplate *templatePtr,
    QUERY_TEMPLATE *qchain,
    int indx)
    {
     struct fact *theFact;
     DATA_OBJECT temp;
  
     theFact = templatePtr->factList;
     while (theFact != NULL)
       {
        FactQueryData(theEnv)->QueryCore->solns[indx] = theFact;
        if (qchain->nxt != NULL)
          {
           theFact->factHeader.busyCount++;
           TestEntireChain(theEnv,qchain->nxt,indx+1);
           theFact->factHeader.busyCount--;
           if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (FactQueryData(theEnv)->AbortQuery == TRUE))
             break;
          }
        else
          { 
           theFact->factHeader.busyCount++;
           EvaluationData(theEnv)->CurrentEvaluationDepth++;
           EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->query,&temp);
           EvaluationData(theEnv)->CurrentEvaluationDepth--;
           PeriodicCleanup(theEnv,FALSE,TRUE);
           theFact->factHeader.busyCount--;
           if (EvaluationData(theEnv)->HaltExecution == TRUE)
             break;
           if ((temp.type != SYMBOL) ? TRUE :
               (temp.value != EnvFalseSymbol(theEnv)))
             {
              if (FactQueryData(theEnv)->QueryCore->action != NULL)
                {
                 theFact->factHeader.busyCount++;
                 EvaluationData(theEnv)->CurrentEvaluationDepth++;
                 ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
                 EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,FactQueryData(theEnv)->QueryCore->result);
                 ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
                 EvaluationData(theEnv)->CurrentEvaluationDepth--;
                 PeriodicCleanup(theEnv,FALSE,TRUE);
                 theFact->factHeader.busyCount--;
                 if (ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
                   {
                    FactQueryData(theEnv)->AbortQuery = TRUE;
                    break;
                   }
                 if (EvaluationData(theEnv)->HaltExecution == TRUE)
                   break;
                }
              else
                AddSolution(theEnv);
             }
          }
          
        theFact = theFact->nextTemplateFact;
        while ((theFact != NULL) ? (theFact->garbage == 1) : FALSE)
          theFact = theFact->nextTemplateFact;
       }
    }
  
  /***************************************************************************
    NAME         : AddSolution
    DESCRIPTION  : Adds the current fact set to a global list of
                     solutions
    INPUTS       : None
    RETURNS      : Nothing useful
    SIDE EFFECTS : Global list and count updated
    NOTES        : Solutions are stored as sequential arrays of struct fact *
   ***************************************************************************/
  static void AddSolution(
    void *theEnv)
    {
     QUERY_SOLN *new_soln;
     register unsigned i;
  
     new_soln = (QUERY_SOLN *) gm2(theEnv,(int) sizeof(QUERY_SOLN));
     new_soln->soln = (struct fact **)
                      gm2(theEnv,(sizeof(struct fact *) * (FactQueryData(theEnv)->QueryCore->soln_size)));
     for (i = 0 ; i < FactQueryData(theEnv)->QueryCore->soln_size ; i++)
       new_soln->soln[i] = FactQueryData(theEnv)->QueryCore->solns[i];
     new_soln->nxt = NULL;
     if (FactQueryData(theEnv)->QueryCore->soln_set == NULL)
       FactQueryData(theEnv)->QueryCore->soln_set = new_soln;
     else
       FactQueryData(theEnv)->QueryCore->soln_bottom->nxt = new_soln;
     FactQueryData(theEnv)->QueryCore->soln_bottom = new_soln;
     FactQueryData(theEnv)->QueryCore->soln_cnt++;
    }
  
  /***************************************************
    NAME         : PopQuerySoln
    DESCRIPTION  : Deallocates the topmost solution
                     set for an fact-set query
    INPUTS       : None
    RETURNS      : Nothing useful
    SIDE EFFECTS : Solution set deallocated
    NOTES        : Assumes QueryCore->soln_set != 0
   ***************************************************/
  static void PopQuerySoln(
    void *theEnv)
    {
     FactQueryData(theEnv)->QueryCore->soln_bottom = FactQueryData(theEnv)->QueryCore->soln_set;
     FactQueryData(theEnv)->QueryCore->soln_set = FactQueryData(theEnv)->QueryCore->soln_set->nxt;
     rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->soln_bottom->soln,
        (sizeof(struct fact *) * FactQueryData(theEnv)->QueryCore->soln_size));
     rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->soln_bottom,sizeof(QUERY_SOLN));
    }
    
  #endif
  
  
  