insquery.c

NASA 开发使用的一个专家系统

                   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 class-expressions are evaluated once,
                   and the query boolean-expression is evaluated
                   once for every instance set.
  NOTES        : CLIPS Syntax : See ParseQueryNoAction()
 ******************************************************************************/
globle VOID QueryFindAllInstances(result)
  DATA_OBJECT *result;
  {
   QUERY_CLASS *qclasses;
   int rcnt;
   register int i,j;
   
   result->type = MULTIFIELD;
   result->begin = 0;
   result->end = -1;
   qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg,
                                      "find-all-instances",&rcnt);
   if (qclasses == NULL)
     {
      result->value = (VOID *) CreateMultifield(0L);
      return;
     }
   PushQueryCore();
   QueryCore = get_struct(query_core);
   QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
   QueryCore->query = GetFirstArgument();
   QueryCore->action = NULL;
   QueryCore->soln_set = NULL;
   QueryCore->soln_size = rcnt;
   QueryCore->soln_cnt = 0;
   TestEntireChain(qclasses,0);
   AbortQuery = CLIPS_FALSE;
   result->value = (VOID *) CreateMultifield(QueryCore->soln_cnt * rcnt);
   while (QueryCore->soln_set != NULL)
     {
      for (i = 0 , j = result->end + 2 ; i < rcnt ; i++ , j++)
        {
         SetMFType(result->value,j,INSTANCE_NAME);
         SetMFValue(result->value,j,GetFullInstanceName(QueryCore->soln_set->soln[i]));
        }
      result->end = j-2;
      PopQuerySoln();
     }
   rm((VOID *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
   rtn_struct(query_core,QueryCore);
   PopQueryCore();
   DeleteQueryClasses(qclasses);
  }
  
/******************************************************************************
  NAME         : QueryDoForInstance
  DESCRIPTION  : Finds the first set of instances which satisfy the query and
                   executes a user-action with that set
  INPUTS       : None
  RETURNS      : Caller's result buffer
  SIDE EFFECTS : The query class-expressions are evaluated once,
                   and the query boolean-expression is evaluated
                   zero or more times (depending on instance restrictions
                   and how early the expression evaulates to CLIPS_TRUE - if at all).
                   Also the action expression is executed zero or once.
                 Caller's result buffer holds result of user-action
  NOTES        : CLIPS Syntax : See ParseQueryAction()
 ******************************************************************************/
globle VOID QueryDoForInstance(result)
  DATA_OBJECT *result;
  {
   QUERY_CLASS *qclasses;
   int rcnt;

   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg->nextArg,
                                      "do-for-instance",&rcnt);
   if (qclasses == NULL)
     return;
   PushQueryCore();
   QueryCore = get_struct(query_core);
   QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
   QueryCore->query = GetFirstArgument();
   QueryCore->action = GetFirstArgument()->nextArg;
   if (TestForFirstInChain(qclasses,0) == CLIPS_TRUE)
     EvaluateExpression(QueryCore->action,result);
   AbortQuery = CLIPS_FALSE;
   BreakFlag = CLIPS_FALSE;
   rm((VOID *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
   rtn_struct(query_core,QueryCore);
   PopQueryCore();
   DeleteQueryClasses(qclasses);
  }
  
/******************************************************************************
  NAME         : QueryDoForAllInstances
  DESCRIPTION  : Finds all sets of instances 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 class-expressions are evaluated once,
                   and the query boolean-expression is evaluated
                   once for every instance set.  Also, the action is
                   executed for every instance set.
                 Caller's result buffer holds result of last action executed.
  NOTES        : CLIPS Syntax : See ParseQueryAction()
 ******************************************************************************/
globle VOID QueryDoForAllInstances(result)

  DATA_OBJECT *result;
  {
   QUERY_CLASS *qclasses;
   int rcnt;

   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg->nextArg,
                                      "do-for-all-instances",&rcnt);
   if (qclasses == NULL)
     return;
   PushQueryCore();
   QueryCore = get_struct(query_core);
   QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
   QueryCore->query = GetFirstArgument();
   QueryCore->action = GetFirstArgument()->nextArg;
   QueryCore->result = result;
   ValueInstall(QueryCore->result);
   TestEntireChain(qclasses,0);
   ValueDeinstall(QueryCore->result);
   PropagateReturnValue(QueryCore->result);
   AbortQuery = CLIPS_FALSE;
   BreakFlag = CLIPS_FALSE;
   rm((VOID *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
   rtn_struct(query_core,QueryCore);
   PopQueryCore();
   DeleteQueryClasses(qclasses);
  }
  
/******************************************************************************
  NAME         : DelayedQueryDoForAllInstances
  DESCRIPTION  : Finds all sets of instances which satisfy the query and
                   and exceutes a user-action for each set
                   
                 This function differs from QueryDoForAllInstances() 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 class-expressions are evaluated once,
                   and the query boolean-expression is evaluated
                   once for every instance set.  The action is executed
                   for evry query satisfaction.
                 Caller's result buffer holds result of last action executed.
  NOTES        : CLIPS Syntax : See ParseQueryNoAction()
 ******************************************************************************/
globle VOID DelayedQueryDoForAllInstances(result)
  DATA_OBJECT *result;
  {
   QUERY_CLASS *qclasses;
   int rcnt;
   register int i;
   
   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg->nextArg,
                                      "delayed-do-for-all-instances",&rcnt);
   if (qclasses == NULL)
     return;
   PushQueryCore();
   QueryCore = get_struct(query_core);
   QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
   QueryCore->query = GetFirstArgument();
   QueryCore->action = NULL;
   QueryCore->soln_set = NULL;
   QueryCore->soln_size = rcnt;
   QueryCore->soln_cnt = 0;
   TestEntireChain(qclasses,0);
   AbortQuery = CLIPS_FALSE;
   QueryCore->action = GetFirstArgument()->nextArg;
   while (QueryCore->soln_set != NULL)
     {
      for (i = 0 ; i < rcnt ; i++)
        QueryCore->solns[i] = QueryCore->soln_set->soln[i];
      PopQuerySoln();
      CurrentEvaluationDepth++;
      EvaluateExpression(QueryCore->action,result);
      CurrentEvaluationDepth--;
      if (ReturnFlag == TRUE)
        { PropagateReturnValue(result); }
      PeriodicCleanup(CLIPS_FALSE,CLIPS_TRUE);
      if (HaltExecution || BreakFlag || ReturnFlag)
        {
         while (QueryCore->soln_set != NULL)
           PopQuerySoln();
         break;
        }
     }
   BreakFlag = CLIPS_FALSE;
   rm((VOID *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
   rtn_struct(query_core,QueryCore);
   PopQueryCore();
   DeleteQueryClasses(qclasses);
  }
  
/* =========================================
   *****************************************
          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()
  {
   QUERY_STACK *qptr;
   
   qptr = get_struct(query_stack);
   qptr->core = QueryCore;
   qptr->nxt = QueryCoreStack;
   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()
  {
   QUERY_STACK *qptr;
   
   QueryCore = QueryCoreStack->core;
   qptr = QueryCoreStack;
   QueryCoreStack = QueryCoreStack->nxt;
   rtn_struct(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(depth)
  int depth;
  {
   QUERY_STACK *qptr;
   
   if (depth == 0)
     return(QueryCore);
   qptr = QueryCoreStack;
   while (depth > 1)
     {
      qptr = qptr->nxt;
      depth--;
     }
   return(qptr->core);
  }
  
/**********************************************************
  NAME         : DetermineQueryClasses
  DESCRIPTION  : Builds a list of classes to be used in
                   instance queries - uses parse form.
  INPUTS       : 1) The parse class 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 classes
  NOTES        : Each restriction is linked by nxt pointer,
                   multiple classes 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_CLASS *DetermineQueryClasses(classExp,func,rcnt)
  EXPRESSION *classExp;
  char *func;
  int *rcnt;
  {
   QUERY_CLASS *clist = NULL,*cnxt = NULL,*cchain = NULL,*tmp;
   int new_list = CLIPS_FALSE;
   DATA_OBJECT temp;
   
   *rcnt = 0;
   while (classExp != NULL)
     {
      if (EvaluateExpression(classExp,&temp))
        {
         DeleteQueryClasses(clist);
         return(NULL);
        }
      if ((temp.type == SYMBOL) && (temp.value == (VOID *) QUERY_DELIMETER_SYMBOL))
        {
         new_list = CLIPS_TRUE;
         (*rcnt)++;
        }
      else if ((tmp = FormChain(func,&temp)) != NULL)
        {
         if (clist == NULL)
           clist = cnxt = cchain = tmp;
         else if (new_list == CLIPS_TRUE)
           {
            new_list = CLIPS_FALSE;
            cnxt->nxt = tmp;
            cnxt = cchain = tmp;
           }
         else
           cchain->chain = tmp;
         while (cchain->chain != NULL)
           cchain = cchain->chain;
        }
      else
        {
         SyntaxErrorMessage("instance-set query class restrictions");
         DeleteQueryClasses(clist);
         SetEvaluationError(CLIPS_TRUE);
         return(NULL);
        }
      classExp = classExp->nextArg;
     }
   return(clist);
  }
  
/*************************************************************
  NAME         : FormChain
  DESCRIPTION  : Builds a list of classes to be used in
                   instance 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 classes
  RETURNS      : The query chain, or NULL on errors
  SIDE EFFECTS : Memory allocated for chain
                 Busy count incremented for all classes
  NOTES        : None
 *************************************************************/
static QUERY_CLASS *FormChain(func,val)
  char *func;
  DATA_OBJECT *val;
  {
   DEFCLASS *cls;
   QUERY_CLASS *head,*bot,*tmp;
   register long i,end; /* 6.04 Bug Fix */
   char *className;
   struct defmodule *currentModule;
   
   currentModule = ((struct defmodule *) GetCurrentModule());
   if (val->type == DEFCLASS_PTR)
     {
      IncrementDefclassBusyCount((VOID *) val->value);
      head = get_struct(query_class);
      head->cls = (DEFCLASS *) val->value;
      if (DefclassInScope(head->cls,currentModule))
        head->theModule = currentModule;
      else
        head->theModule = head->cls->header.whichModule->theModule;
      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,